From c5f380e5e94ead65ae2dc018e6342ccd3959649b Mon Sep 17 00:00:00 2001 From: Ralf Vogler Date: Thu, 24 Aug 2017 15:50:36 +0200 Subject: [PATCH 001/518] fix region's leq, join, meet? --- src/cdomains/regionDomain.ml | 7 ++++--- src/domains/partitionDomain.ml | 2 ++ 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index c4f86f9460..bdd871fe3a 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -49,13 +49,14 @@ struct let leq x y = match x,y with | `Right (), `Right () -> true - | `Right (), _ | _, `Right () -> false | `Left x, `Left y -> VF.leq x y + | `Left _, _ -> false + | _, `Left _ -> true let join (x:t) (y:t) :t = match x,y with - | `Right (), _ -> `Right () - | _, `Right () -> `Right () + | `Right (), _ -> y + | _, `Right () -> x | `Left x, `Left y -> `Left (VF.join x y) let lift f y = match y with diff --git a/src/domains/partitionDomain.ml b/src/domains/partitionDomain.ml index 2b5f2028fe..eb8539344f 100644 --- a/src/domains/partitionDomain.ml +++ b/src/domains/partitionDomain.ml @@ -31,6 +31,8 @@ struct let (s1', res) = fold f s2 (s1, empty ()) in union s1' res + let meet a b = a (* inter is unsound *) + let collapse (s1:t) (s2:t): bool = let f vf2 res = res || exists (fun vf1 -> S.collapse vf1 vf2) s1 From f33f4b067df8e5ac4a1313113b5a9a471ad91b8b Mon Sep 17 00:00:00 2001 From: Ralf Vogler Date: Thu, 24 Aug 2017 15:51:40 +0200 Subject: [PATCH 002/518] simplified failing test for wpoint solver --- .../09-regions/23-evilcollapse_rc.c | 66 +++++-------------- 1 file changed, 16 insertions(+), 50 deletions(-) diff --git a/tests/regression/09-regions/23-evilcollapse_rc.c b/tests/regression/09-regions/23-evilcollapse_rc.c index cf1277aa79..2de457f9e8 100644 --- a/tests/regression/09-regions/23-evilcollapse_rc.c +++ b/tests/regression/09-regions/23-evilcollapse_rc.c @@ -1,5 +1,4 @@ -// PARAM: --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --set ana.activated[+] "'region'" --set exp.region-offsets true -#include +// PARAM: --set ana.activated[+] "'symb_locks'" --set ana.activated[+] "'region'" --set exp.region-offsets true --sets solver wpoint #include struct list_head { @@ -7,31 +6,20 @@ struct list_head { struct list_head *prev ; }; -struct s { - int datum ; - struct list_head list ; -}; - -struct cache { - struct list_head slot[10] ; - pthread_mutex_t slots_mutex[10] ; -}; - -struct cache c ; +struct list_head c[10] ; -static inline void INIT_LIST_HEAD(struct list_head *list) { +static void INIT_LIST_HEAD(struct list_head *list) { list->next = list; list->prev = list; } -struct s *new(int x) { - struct s *p = malloc(sizeof(struct s)); - p->datum = x; - INIT_LIST_HEAD(&p->list); +struct list_head *new(int x) { + struct list_head *p = malloc(sizeof(struct list_head)); + INIT_LIST_HEAD(p); return p; } -static inline void list_add(struct list_head *new, struct list_head *head) { +static void list_add(struct list_head *new, struct list_head *head) { struct list_head *next = head->next; next->prev = new; new->next = next; @@ -39,49 +27,27 @@ static inline void list_add(struct list_head *new, struct list_head *head) { head->next = new; } -inline static struct list_head *lookup (int d) { +static struct list_head *lookup (int d) { int hvalue; struct list_head *p; - p = c.slot[hvalue].next; + p = c[hvalue].next; return p; } -void *f(void *arg) { - struct s *pos ; - int j; - struct list_head const *p ; - struct list_head const *q ; - - while (j < 10) { - pthread_mutex_lock(&c.slots_mutex[j]); - p = c.slot[j].next; - pos = (struct s *)((char *)p - (size_t)(& ((struct s *)0)->list)); - - while (& pos->list != & c.slot[j]) { - pos->datum++; // RACE! - q = pos->list.next; - pos = (struct s *)((char *)q - (size_t)(& ((struct s *)0)->list)); - } - - pthread_mutex_unlock(&c.slots_mutex[j]); - j ++; - } - return 0; -} - int main() { struct list_head *p1, *p2; - pthread_t t1, t2; for (int i = 0; i < 10; i++) { - INIT_LIST_HEAD(&c.slot[i]); - pthread_mutex_init(&c.slots_mutex[i], NULL); - for (int j = 0; j < 30; j++) list_add(&new(j*i)->list, &c.slot[i]); + INIT_LIST_HEAD(&c[i]); + for (int j = 0; j < 3; j++) { + struct list_head *arg1, *arg2; + arg1 = new(j*i); + arg2 = &c[i]; + list_add(arg1, arg2); + } } p1 = lookup(1); p2 = lookup(2); p1->next = p2->next; // per-element scheme no longer safe. - pthread_create(&t1, NULL, f, NULL); - pthread_create(&t2, NULL, f, NULL); return 0; } From c562f7b425ce9eb9f3b6b29011087f9e9c4bd851 Mon Sep 17 00:00:00 2001 From: Vesal Vojdani Date: Mon, 28 Aug 2017 18:14:17 +0300 Subject: [PATCH 003/518] Simplifying tests & code further. I'm not sure about the actual cause, but I doubt the "deref" flag is correctly doing what I believe it is trying to do. --- src/cdomains/regionDomain.ml | 21 ++------- .../09-regions/23-evilcollapse_rc.c | 44 ++++--------------- 2 files changed, 12 insertions(+), 53 deletions(-) diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index bdd871fe3a..e23f5e3a5a 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -141,15 +141,6 @@ struct type eval_t = (bool * elt * F.t) option let eval_exp exp: eval_t = let offsornot offs = if (get_bool "exp.region-offsets") then F.listify offs else [] in - let rec do_offs deref def = function - | Field (fd, offs) -> begin - match Goblintutil.is_blessed (TComp (fd.fcomp, [])) with - | Some v -> do_offs deref (Some (deref, (v, offsornot (Field (fd, offs))), [])) offs - | None -> do_offs deref def offs - end - | Index (_, offs) -> do_offs deref def offs - | NoOffset -> def - in let rec eval_rval deref rval = match rval with | Lval lval -> eval_lval deref lval @@ -161,17 +152,11 @@ struct | _ -> None and eval_lval deref lval = match lval with - | (Var x, NoOffset) when Goblintutil.is_blessed x.vtype <> None -> - begin match Goblintutil.is_blessed x.vtype with - | Some v -> Some (deref, (v,[]), []) - | _ when x.vglob -> Some (deref, (x, []), []) - | _ -> None - end - | (Var x, offs) -> do_offs deref (Some (deref, (x, offsornot offs), [])) offs + | (Var x, offs) -> Some (deref, (x, offsornot offs), []) | (Mem exp,offs) -> match eval_rval true exp with - | Some (deref, v, _) -> do_offs deref (Some (deref, v, offsornot offs)) offs - | x -> do_offs deref x offs + | Some (deref, v, _) -> Some (deref, v, offsornot offs) + | x -> x in eval_rval false exp diff --git a/tests/regression/09-regions/23-evilcollapse_rc.c b/tests/regression/09-regions/23-evilcollapse_rc.c index 2de457f9e8..d73e53fd45 100644 --- a/tests/regression/09-regions/23-evilcollapse_rc.c +++ b/tests/regression/09-regions/23-evilcollapse_rc.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] "'symb_locks'" --set ana.activated[+] "'region'" --set exp.region-offsets true --sets solver wpoint +// PARAM: --set ana.activated[+] "'region'" --set exp.region-offsets true --sets solver wpoint #include struct list_head { @@ -9,45 +9,19 @@ struct list_head { struct list_head c[10] ; static void INIT_LIST_HEAD(struct list_head *list) { - list->next = list; - list->prev = list; + return; } -struct list_head *new(int x) { - struct list_head *p = malloc(sizeof(struct list_head)); - INIT_LIST_HEAD(p); - return p; -} - -static void list_add(struct list_head *new, struct list_head *head) { - struct list_head *next = head->next; - next->prev = new; - new->next = next; - new->prev = head; - head->next = new; -} - -static struct list_head *lookup (int d) { - int hvalue; - struct list_head *p; - p = c[hvalue].next; - return p; +static struct list_head *lookup () { + int i = 0; + return c[i].next; } int main() { struct list_head *p1, *p2; - for (int i = 0; i < 10; i++) { - INIT_LIST_HEAD(&c[i]); - for (int j = 0; j < 3; j++) { - struct list_head *arg1, *arg2; - arg1 = new(j*i); - arg2 = &c[i]; - list_add(arg1, arg2); - } - } - p1 = lookup(1); - p2 = lookup(2); - p1->next = p2->next; - // per-element scheme no longer safe. + INIT_LIST_HEAD(&c[0]); + for ( ; 0; ) { } + p1 = lookup(); + p1->next = p2; return 0; } From 42564280244a7de4b69f16f4de0796faf12784ef Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Thu, 17 Mar 2022 14:53:35 +0100 Subject: [PATCH 004/518] Added basic test cases for changed variable names. --- tests/incremental/04-var-rename/00-unused_rename.c | 4 ++++ tests/incremental/04-var-rename/00-unused_rename.json | 3 +++ tests/incremental/04-var-rename/00-unused_rename.patch | 8 ++++++++ tests/incremental/04-var-rename/01-nothing.c | 4 ++++ tests/incremental/04-var-rename/01-nothing.json | 3 +++ tests/incremental/04-var-rename/01-nothing.patch | 8 ++++++++ tests/incremental/04-var-rename/diffs/00-unused_rename.c | 4 ++++ tests/incremental/04-var-rename/diffs/01-nothing.c | 5 +++++ 8 files changed, 39 insertions(+) create mode 100644 tests/incremental/04-var-rename/00-unused_rename.c create mode 100644 tests/incremental/04-var-rename/00-unused_rename.json create mode 100644 tests/incremental/04-var-rename/00-unused_rename.patch create mode 100644 tests/incremental/04-var-rename/01-nothing.c create mode 100644 tests/incremental/04-var-rename/01-nothing.json create mode 100644 tests/incremental/04-var-rename/01-nothing.patch create mode 100644 tests/incremental/04-var-rename/diffs/00-unused_rename.c create mode 100644 tests/incremental/04-var-rename/diffs/01-nothing.c diff --git a/tests/incremental/04-var-rename/00-unused_rename.c b/tests/incremental/04-var-rename/00-unused_rename.c new file mode 100644 index 0000000000..31eacd5bf9 --- /dev/null +++ b/tests/incremental/04-var-rename/00-unused_rename.c @@ -0,0 +1,4 @@ +int main() { + int a = 0; + return 0; +} diff --git a/tests/incremental/04-var-rename/00-unused_rename.json b/tests/incremental/04-var-rename/00-unused_rename.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/00-unused_rename.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/00-unused_rename.patch b/tests/incremental/04-var-rename/00-unused_rename.patch new file mode 100644 index 0000000000..d3d15e3bc7 --- /dev/null +++ b/tests/incremental/04-var-rename/00-unused_rename.patch @@ -0,0 +1,8 @@ +--- tests/incremental/04-var-rename/00-unused_rename.c ++++ tests/incremental/04-var-rename/00-unused_rename.c +@@ -1,4 +1,4 @@ + int main() { +- int a = 0; ++ int b = 0; + return 0; + } diff --git a/tests/incremental/04-var-rename/01-nothing.c b/tests/incremental/04-var-rename/01-nothing.c new file mode 100644 index 0000000000..3dc9c8f6e6 --- /dev/null +++ b/tests/incremental/04-var-rename/01-nothing.c @@ -0,0 +1,4 @@ +int main() { + int x = 0; + return 0; +} diff --git a/tests/incremental/04-var-rename/01-nothing.json b/tests/incremental/04-var-rename/01-nothing.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/01-nothing.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/01-nothing.patch b/tests/incremental/04-var-rename/01-nothing.patch new file mode 100644 index 0000000000..663c19abfc --- /dev/null +++ b/tests/incremental/04-var-rename/01-nothing.patch @@ -0,0 +1,8 @@ +--- tests/incremental/04-var-rename/01-nothing.c ++++ tests/incremental/04-var-rename/01-nothing.c +@@ -1,4 +1,5 @@ + int main() { + int x = 0; ++ + return 0; + } diff --git a/tests/incremental/04-var-rename/diffs/00-unused_rename.c b/tests/incremental/04-var-rename/diffs/00-unused_rename.c new file mode 100644 index 0000000000..1fbd3f6638 --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/00-unused_rename.c @@ -0,0 +1,4 @@ +int main() { + int b = 0; + return 0; +} diff --git a/tests/incremental/04-var-rename/diffs/01-nothing.c b/tests/incremental/04-var-rename/diffs/01-nothing.c new file mode 100644 index 0000000000..3c9e6cafd7 --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/01-nothing.c @@ -0,0 +1,5 @@ +int main() { + int x = 0; + + return 0; +} From 27dd10f7455ef488d62e981d3d40c2f71ca54898 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Fri, 18 Mar 2022 15:23:22 +0100 Subject: [PATCH 005/518] Rename detection works for simple cases --- src/incremental/compareAST.ml | 212 ++++++++++-------- src/incremental/compareCFG.ml | 25 ++- src/incremental/compareCIL.ml | 32 ++- .../04-var-rename/02-rename_and_shuffle.c | 11 + .../04-var-rename/02-rename_and_shuffle.json | 3 + .../04-var-rename/02-rename_and_shuffle.patch | 15 ++ .../04-var-rename/03-rename_with_usage.c | 11 + .../04-var-rename/03-rename_with_usage.json | 3 + .../04-var-rename/03-rename_with_usage.patch | 15 ++ .../diffs/02-rename_and_shuffle.c | 11 + .../diffs/03-rename_with_usage.c | 11 + 11 files changed, 241 insertions(+), 108 deletions(-) create mode 100644 tests/incremental/04-var-rename/02-rename_and_shuffle.c create mode 100644 tests/incremental/04-var-rename/02-rename_and_shuffle.json create mode 100644 tests/incremental/04-var-rename/02-rename_and_shuffle.patch create mode 100644 tests/incremental/04-var-rename/03-rename_with_usage.c create mode 100644 tests/incremental/04-var-rename/03-rename_with_usage.json create mode 100644 tests/incremental/04-var-rename/03-rename_with_usage.patch create mode 100644 tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c create mode 100644 tests/incremental/04-var-rename/diffs/03-rename_with_usage.c diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 1fb1965c7a..ba484693a0 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -5,6 +5,9 @@ type global_type = Fun | Decl | Var and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] +(*context is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) +type context = (string * string) list + let identifier_of_global glob = match glob with | GFun (fundec, l) -> {name = fundec.svar.vname; global_t = Fun} @@ -18,34 +21,39 @@ module GlobalMap = Map.Make(struct (* hack: CIL generates new type names for anonymous types - we want to ignore these *) -let compare_name a b = +let compare_name (a: string) (b: string) = let anon_struct = "__anonstruct_" in let anon_union = "__anonunion_" in + let _ = Printf.printf "Comparing names: %s = %s\n" a b in if a = b then true else BatString.(starts_with a anon_struct && starts_with b anon_struct || starts_with a anon_union && starts_with b anon_union) -let rec eq_constant (a: constant) (b: constant) = match a, b with +let rec eq_constant (context: context) (a: constant) (b: constant) = + match a, b with | CInt (val1, kind1, str1), CInt (val2, kind2, str2) -> Cilint.compare_cilint val1 val2 = 0 && kind1 = kind2 (* Ignore string representation, i.e. 0x2 == 2 *) - | CEnum (exp1, str1, enuminfo1), CEnum (exp2, str2, enuminfo2) -> eq_exp exp1 exp2 (* Ignore name and enuminfo *) + | CEnum (exp1, str1, enuminfo1), CEnum (exp2, str2, enuminfo2) -> eq_exp exp1 exp2 context (* Ignore name and enuminfo *) | a, b -> a = b -and eq_exp (a: exp) (b: exp) = match a,b with - | Const c1, Const c2 -> eq_constant c1 c2 - | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 - | SizeOf typ1, SizeOf typ2 -> eq_typ typ1 typ2 - | SizeOfE exp1, SizeOfE exp2 -> eq_exp exp1 exp2 +and eq_exp2 (context: context) (a: exp) (b: exp) = eq_exp a b context + +and eq_exp (a: exp) (b: exp) (context: context) = + match a, b with + | Const c1, Const c2 -> eq_constant context c1 c2 + | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 context + | SizeOf typ1, SizeOf typ2 -> eq_typ typ1 typ2 context + | SizeOfE exp1, SizeOfE exp2 -> eq_exp exp1 exp2 context | SizeOfStr str1, SizeOfStr str2 -> str1 = str2 (* possibly, having the same length would suffice *) - | AlignOf typ1, AlignOf typ2 -> eq_typ typ1 typ2 - | AlignOfE exp1, AlignOfE exp2 -> eq_exp exp1 exp2 - | UnOp (op1, exp1, typ1), UnOp (op2, exp2, typ2) -> op1 == op2 && eq_exp exp1 exp2 && eq_typ typ1 typ2 - | BinOp (op1, left1, right1, typ1), BinOp (op2, left2, right2, typ2) -> op1 = op2 && eq_exp left1 left2 && eq_exp right1 right2 && eq_typ typ1 typ2 - | CastE (typ1, exp1), CastE (typ2, exp2) -> eq_typ typ1 typ2 && eq_exp exp1 exp2 - | AddrOf lv1, AddrOf lv2 -> eq_lval lv1 lv2 - | StartOf lv1, StartOf lv2 -> eq_lval lv1 lv2 + | AlignOf typ1, AlignOf typ2 -> eq_typ typ1 typ2 context + | AlignOfE exp1, AlignOfE exp2 -> eq_exp exp1 exp2 context + | UnOp (op1, exp1, typ1), UnOp (op2, exp2, typ2) -> op1 == op2 && eq_exp exp1 exp2 context && eq_typ typ1 typ2 context + | BinOp (op1, left1, right1, typ1), BinOp (op2, left2, right2, typ2) -> op1 = op2 && eq_exp left1 left2 context && eq_exp right1 right2 context && eq_typ typ1 typ2 context + | CastE (typ1, exp1), CastE (typ2, exp2) -> eq_typ typ1 typ2 context && eq_exp exp1 exp2 context + | AddrOf lv1, AddrOf lv2 -> eq_lval lv1 lv2 context + | StartOf lv1, StartOf lv2 -> eq_lval lv1 lv2 context | _, _ -> false -and eq_lhost (a: lhost) (b: lhost) = match a, b with - Var v1, Var v2 -> eq_varinfo v1 v2 - | Mem exp1, Mem exp2 -> eq_exp exp1 exp2 +and eq_lhost (a: lhost) (b: lhost) (context: context) = match a, b with + Var v1, Var v2 -> eq_varinfo v1 v2 context + | Mem exp1, Mem exp2 -> eq_exp exp1 exp2 context | _, _ -> false and global_typ_acc: (typ * typ) list ref = ref [] (* TODO: optimize with physical Hashtbl? *) @@ -54,21 +62,21 @@ and mem_typ_acc (a: typ) (b: typ) acc = List.exists (fun p -> match p with (x, y and pretty_length () l = Pretty.num (List.length l) -and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) = +and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (context: context) = if Messages.tracing then Messages.tracei "compareast" "eq_typ_acc %a vs %a (%a, %a)\n" d_type a d_type b pretty_length acc pretty_length !global_typ_acc; (* %a makes List.length calls lazy if compareast isn't being traced *) let r = match a, b with - | TPtr (typ1, attr1), TPtr (typ2, attr2) -> eq_typ_acc typ1 typ2 acc && GobList.equal eq_attribute attr1 attr2 - | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc && eq_exp lenExp1 lenExp2 && GobList.equal eq_attribute attr1 attr2 - | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc && GobList.equal eq_attribute attr1 attr2 + | TPtr (typ1, attr1), TPtr (typ2, attr2) -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 + | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc context && eq_exp lenExp1 lenExp2 context && GobList.equal (eq_attribute context) attr1 attr2 + | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc && GobList.equal (eq_args acc) list1 list2 && varArg1 = varArg2 && - GobList.equal eq_attribute attr1 attr2 + -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_args context acc) list1 list2 && varArg1 = varArg2 && + GobList.equal (eq_attribute context) attr1 attr2 | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc && varArg1 = varArg2 && - GobList.equal eq_attribute attr1 attr2 - | TNamed (typinfo1, attr1), TNamed (typeinfo2, attr2) -> eq_typ_acc typinfo1.ttype typeinfo2.ttype acc && GobList.equal eq_attribute attr1 attr2 (* Ignore tname, treferenced *) - | TNamed (tinf, attr), b -> eq_typ_acc tinf.ttype b acc (* Ignore tname, treferenced. TODO: dismiss attributes, or not? *) - | a, TNamed (tinf, attr) -> eq_typ_acc a tinf.ttype acc (* Ignore tname, treferenced . TODO: dismiss attributes, or not? *) + -> eq_typ_acc typ1 typ2 acc context && varArg1 = varArg2 && + GobList.equal (eq_attribute context) attr1 attr2 + | TNamed (typinfo1, attr1), TNamed (typeinfo2, attr2) -> eq_typ_acc typinfo1.ttype typeinfo2.ttype acc context && GobList.equal (eq_attribute context) attr1 attr2 (* Ignore tname, treferenced *) + | TNamed (tinf, attr), b -> eq_typ_acc tinf.ttype b acc context (* Ignore tname, treferenced. TODO: dismiss attributes, or not? *) + | a, TNamed (tinf, attr) -> eq_typ_acc a tinf.ttype acc context (* Ignore tname, treferenced . TODO: dismiss attributes, or not? *) (* The following two lines are a hack to ensure that anonymous types get the same name and thus, the same typsig *) | TComp (compinfo1, attr1), TComp (compinfo2, attr2) -> if mem_typ_acc a b acc || mem_typ_acc a b !global_typ_acc then ( @@ -77,91 +85,106 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) = ) else ( let acc = (a, b) :: acc in - let res = eq_compinfo compinfo1 compinfo2 acc && GobList.equal eq_attribute attr1 attr2 in + let res = eq_compinfo compinfo1 compinfo2 acc context && GobList.equal (eq_attribute context) attr1 attr2 in if res && compinfo1.cname <> compinfo2.cname then compinfo2.cname <- compinfo1.cname; if res then global_typ_acc := (a, b) :: !global_typ_acc; res ) - | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> let res = eq_enuminfo enuminfo1 enuminfo2 && GobList.equal eq_attribute attr1 attr2 in (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); res - | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> GobList.equal eq_attribute attr1 attr2 - | TVoid attr1, TVoid attr2 -> GobList.equal eq_attribute attr1 attr2 - | TInt (ik1, attr1), TInt (ik2, attr2) -> ik1 = ik2 && GobList.equal eq_attribute attr1 attr2 - | TFloat (fk1, attr1), TFloat (fk2, attr2) -> fk1 = fk2 && GobList.equal eq_attribute attr1 attr2 + | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> let res = eq_enuminfo enuminfo1 enuminfo2 context && GobList.equal (eq_attribute context) attr1 attr2 in (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); res + | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> GobList.equal (eq_attribute context) attr1 attr2 + | TVoid attr1, TVoid attr2 -> GobList.equal (eq_attribute context) attr1 attr2 + | TInt (ik1, attr1), TInt (ik2, attr2) -> ik1 = ik2 && GobList.equal (eq_attribute context) attr1 attr2 + | TFloat (fk1, attr1), TFloat (fk2, attr2) -> fk1 = fk2 && GobList.equal (eq_attribute context) attr1 attr2 | _, _ -> false in if Messages.tracing then Messages.traceu "compareast" "eq_typ_acc %a vs %a\n" d_type a d_type b; r -and eq_typ (a: typ) (b: typ) = eq_typ_acc a b [] +and eq_typ (a: typ) (b: typ) (context: context) = eq_typ_acc a b [] context -and eq_eitems (a: string * exp * location) (b: string * exp * location) = match a, b with - (name1, exp1, _l1), (name2, exp2, _l2) -> name1 = name2 && eq_exp exp1 exp2 +and eq_eitems (context: context) (a: string * exp * location) (b: string * exp * location) = match a, b with + (name1, exp1, _l1), (name2, exp2, _l2) -> name1 = name2 && eq_exp exp1 exp2 context (* Ignore location *) -and eq_enuminfo (a: enuminfo) (b: enuminfo) = +and eq_enuminfo (a: enuminfo) (b: enuminfo) (context: context) = compare_name a.ename b.ename && - GobList.equal eq_attribute a.eattr b.eattr && - GobList.equal eq_eitems a.eitems b.eitems + GobList.equal (eq_attribute context) a.eattr b.eattr && + GobList.equal (eq_eitems context) a.eitems b.eitems (* Ignore ereferenced *) -and eq_args (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with - (name1, typ1, attr1), (name2, typ2, attr2) -> name1 = name2 && eq_typ_acc typ1 typ2 acc && GobList.equal eq_attribute attr1 attr2 +and eq_args (context: context) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with + (name1, typ1, attr1), (name2, typ2, attr2) -> name1 = name2 && eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 -and eq_attrparam (a: attrparam) (b: attrparam) = match a, b with - | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal eq_attrparam attrparams1 attrparams2 - | ASizeOf typ1, ASizeOf typ2 -> eq_typ typ1 typ2 - | ASizeOfE attrparam1, ASizeOfE attrparam2 -> eq_attrparam attrparam1 attrparam2 +and eq_attrparam (context: context) (a: attrparam) (b: attrparam) = match a, b with + | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam context) attrparams1 attrparams2 + | ASizeOf typ1, ASizeOf typ2 -> eq_typ typ1 typ2 context + | ASizeOfE attrparam1, ASizeOfE attrparam2 -> eq_attrparam context attrparam1 attrparam2 | ASizeOfS typsig1, ASizeOfS typsig2 -> typsig1 = typsig2 - | AAlignOf typ1, AAlignOf typ2 -> eq_typ typ1 typ2 - | AAlignOfE attrparam1, AAlignOfE attrparam2 -> eq_attrparam attrparam1 attrparam2 + | AAlignOf typ1, AAlignOf typ2 -> eq_typ typ1 typ2 context + | AAlignOfE attrparam1, AAlignOfE attrparam2 -> eq_attrparam context attrparam1 attrparam2 | AAlignOfS typsig1, AAlignOfS typsig2 -> typsig1 = typsig2 - | AUnOp (op1, attrparam1), AUnOp (op2, attrparam2) -> op1 = op2 && eq_attrparam attrparam1 attrparam2 - | ABinOp (op1, left1, right1), ABinOp (op2, left2, right2) -> op1 = op2 && eq_attrparam left1 left2 && eq_attrparam right1 right2 - | ADot (attrparam1, str1), ADot (attrparam2, str2) -> eq_attrparam attrparam1 attrparam2 && str1 = str2 - | AStar attrparam1, AStar attrparam2 -> eq_attrparam attrparam1 attrparam2 - | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam attrparam1 attrparam2 - | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam left1 left2 && eq_attrparam right1 right2 - | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> eq_attrparam left1 left2 && eq_attrparam middle1 middle2 && eq_attrparam right1 right2 + | AUnOp (op1, attrparam1), AUnOp (op2, attrparam2) -> op1 = op2 && eq_attrparam context attrparam1 attrparam2 + | ABinOp (op1, left1, right1), ABinOp (op2, left2, right2) -> op1 = op2 && eq_attrparam context left1 left2 && eq_attrparam context right1 right2 + | ADot (attrparam1, str1), ADot (attrparam2, str2) -> eq_attrparam context attrparam1 attrparam2 && str1 = str2 + | AStar attrparam1, AStar attrparam2 -> eq_attrparam context attrparam1 attrparam2 + | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam context attrparam1 attrparam2 + | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam context left1 left2 && eq_attrparam context right1 right2 + | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> eq_attrparam context left1 left2 && eq_attrparam context middle1 middle2 && eq_attrparam context right1 right2 | a, b -> a = b -and eq_attribute (a: attribute) (b: attribute) = match a, b with - Attr (name1, params1), Attr (name2, params2) -> name1 = name2 && GobList.equal eq_attrparam params1 params2 +and eq_attribute (context: context) (a: attribute) (b: attribute) = match a, b with + | Attr (name1, params1), Attr (name2, params2) -> name1 = name2 && GobList.equal (eq_attrparam context) params1 params2 + +and eq_varinfo2 (context: context) (a: varinfo) (b: varinfo) = eq_varinfo a b context -and eq_varinfo (a: varinfo) (b: varinfo) = a.vname = b.vname && eq_typ a.vtype b.vtype && GobList.equal eq_attribute a.vattr b.vattr && - a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof +and bla (context: context) = List.exists (fun x -> match x with (a, b) -> a == "") context + +and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = + let isNamingOk = if a.vname != b.vname then + let existingAssumption: (string*string) option = List.find_opt (fun x -> match x with (original, now) -> original = a.vname) context in + + match existingAssumption with + | Some (original, now) -> now = b.vname + | None -> true (*Var names differ, but there is no assumption, so this can't be good*) + + else true in + + let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in + (*a.vname = b.vname*) isNamingOk && eq_typ a.vtype b.vtype context && GobList.equal (eq_attribute context) a.vattr b.vattr && + a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) (* Accumulator is needed because of recursive types: we have to assume that two types we already encountered in a previous step of the recursion are equivalent *) -and eq_compinfo (a: compinfo) (b: compinfo) (acc: (typ * typ) list) = +and eq_compinfo (a: compinfo) (b: compinfo) (acc: (typ * typ) list) (context: context) = a.cstruct = b.cstruct && compare_name a.cname b.cname && - GobList.equal (fun a b-> eq_fieldinfo a b acc) a.cfields b.cfields && - GobList.equal eq_attribute a.cattr b.cattr && + GobList.equal (fun a b-> eq_fieldinfo a b acc context) a.cfields b.cfields && + GobList.equal (eq_attribute context) a.cattr b.cattr && a.cdefined = b.cdefined (* Ignore ckey, and ignore creferenced *) -and eq_fieldinfo (a: fieldinfo) (b: fieldinfo) (acc: (typ * typ) list)= +and eq_fieldinfo (a: fieldinfo) (b: fieldinfo) (acc: (typ * typ) list) (context: context) = if Messages.tracing then Messages.tracei "compareast" "fieldinfo %s vs %s\n" a.fname b.fname; - let r = a.fname = b.fname && eq_typ_acc a.ftype b.ftype acc && a.fbitfield = b.fbitfield && GobList.equal eq_attribute a.fattr b.fattr in + let r = a.fname = b.fname && eq_typ_acc a.ftype b.ftype acc context && a.fbitfield = b.fbitfield && GobList.equal (eq_attribute context) a.fattr b.fattr in if Messages.tracing then Messages.traceu "compareast" "fieldinfo %s vs %s\n" a.fname b.fname; r -and eq_offset (a: offset) (b: offset) = match a, b with +and eq_offset (a: offset) (b: offset) (context: context) = match a, b with NoOffset, NoOffset -> true - | Field (info1, offset1), Field (info2, offset2) -> eq_fieldinfo info1 info2 [] && eq_offset offset1 offset2 - | Index (exp1, offset1), Index (exp2, offset2) -> eq_exp exp1 exp2 && eq_offset offset1 offset2 + | Field (info1, offset1), Field (info2, offset2) -> eq_fieldinfo info1 info2 [] context && eq_offset offset1 offset2 context + | Index (exp1, offset1), Index (exp2, offset2) -> eq_exp exp1 exp2 context && eq_offset offset1 offset2 context | _, _ -> false -and eq_lval (a: lval) (b: lval) = match a, b with - (host1, off1), (host2, off2) -> eq_lhost host1 host2 && eq_offset off1 off2 +and eq_lval (a: lval) (b: lval) (context: context) = match a, b with + (host1, off1), (host2, off2) -> eq_lhost host1 host2 context && eq_offset off1 off2 context -let eq_instr (a: instr) (b: instr) = match a, b with - | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 && eq_exp exp1 exp2 - | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> eq_lval lv1 lv2 && eq_exp f1 f2 && GobList.equal eq_exp args1 args2 - | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> eq_exp f1 f2 && GobList.equal eq_exp args1 args2 - | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) - | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 +let eq_instr (context: context) (a: instr) (b: instr) = match a, b with + | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 context && eq_exp exp1 exp2 context + | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> eq_lval lv1 lv2 context && eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 + | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 + | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2 context) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2 context) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) + | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 context | _, _ -> false let eq_label (a: label) (b: label) = match a, b with @@ -180,35 +203,42 @@ let eq_stmt_with_location ((a, af): stmt * fundec) ((b, bf): stmt * fundec) = through the cfg and only compares the currently visited node (The cil blocks inside an if statement should not be compared together with its condition to avoid a to early and not precise detection of a changed node inside). Switch, break and continue statements are removed during cfg preparation and therefore need not to be handeled *) -let rec eq_stmtkind ?(cfg_comp = false) ((a, af): stmtkind * fundec) ((b, bf): stmtkind * fundec) = - let eq_block' = fun x y -> if cfg_comp then true else eq_block (x, af) (y, bf) in +let rec eq_stmtkind ?(cfg_comp = false) ((a, af): stmtkind * fundec) ((b, bf): stmtkind * fundec) (context: context) = + let eq_block' = fun x y -> if cfg_comp then true else eq_block (x, af) (y, bf) context in match a, b with - | Instr is1, Instr is2 -> GobList.equal eq_instr is1 is2 - | Return (Some exp1, _l1), Return (Some exp2, _l2) -> eq_exp exp1 exp2 + | Instr is1, Instr is2 -> GobList.equal (eq_instr context) is1 is2 + | Return (Some exp1, _l1), Return (Some exp2, _l2) -> eq_exp exp1 exp2 context | Return (None, _l1), Return (None, _l2) -> true | Return _, Return _ -> false | Goto (st1, _l1), Goto (st2, _l2) -> eq_stmt_with_location (!st1, af) (!st2, bf) | Break _, Break _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true | Continue _, Continue _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true - | If (exp1, then1, else1, _l1, _el1), If (exp2, then2, else2, _l2, _el2) -> eq_exp exp1 exp2 && eq_block' then1 then2 && eq_block' else1 else2 - | Switch (exp1, block1, stmts1, _l1, _el1), Switch (exp2, block2, stmts2, _l2, _el2) -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else eq_exp exp1 exp2 && eq_block' block1 block2 && GobList.equal (fun a b -> eq_stmt (a,af) (b,bf)) stmts1 stmts2 + | If (exp1, then1, else1, _l1, _el1), If (exp2, then2, else2, _l2, _el2) -> eq_exp exp1 exp2 context && eq_block' then1 then2 && eq_block' else1 else2 + | Switch (exp1, block1, stmts1, _l1, _el1), Switch (exp2, block2, stmts2, _l2, _el2) -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else eq_exp exp1 exp2 context && eq_block' block1 block2 && GobList.equal (fun a b -> eq_stmt (a,af) (b,bf) context) stmts1 stmts2 | Loop (block1, _l1, _el1, _con1, _br1), Loop (block2, _l2, _el2, _con2, _br2) -> eq_block' block1 block2 | Block block1, Block block2 -> eq_block' block1 block2 | _, _ -> false -and eq_stmt ?(cfg_comp = false) ((a, af): stmt * fundec) ((b, bf): stmt * fundec) = +and eq_stmt ?(cfg_comp = false) ((a, af): stmt * fundec) ((b, bf): stmt * fundec) (context: context) = GobList.equal eq_label a.labels b.labels && - eq_stmtkind ~cfg_comp (a.skind, af) (b.skind, bf) + eq_stmtkind ~cfg_comp (a.skind, af) (b.skind, bf) context -and eq_block ((a, af): Cil.block * fundec) ((b, bf): Cil.block * fundec) = - a.battrs = b.battrs && GobList.equal (fun x y -> eq_stmt (x, af) (y, bf)) a.bstmts b.bstmts +and eq_block ((a, af): Cil.block * fundec) ((b, bf): Cil.block * fundec) (context: context) = + a.battrs = b.battrs && GobList.equal (fun x y -> eq_stmt (x, af) (y, bf) context) a.bstmts b.bstmts -let rec eq_init (a: init) (b: init) = match a, b with - | SingleInit e1, SingleInit e2 -> eq_exp e1 e2 - | CompoundInit (t1, l1), CompoundInit (t2, l2) -> eq_typ t1 t2 && GobList.equal (fun (o1, i1) (o2, i2) -> eq_offset o1 o2 && eq_init i1 i2) l1 l2 +let rec eq_init (a: init) (b: init) (context: context) = match a, b with + | SingleInit e1, SingleInit e2 -> eq_exp e1 e2 context + | CompoundInit (t1, l1), CompoundInit (t2, l2) -> eq_typ t1 t2 context && GobList.equal (fun (o1, i1) (o2, i2) -> eq_offset o1 o2 context && eq_init i1 i2 context) l1 l2 | _, _ -> false -let eq_initinfo (a: initinfo) (b: initinfo) = match a.init, b.init with - | (Some init_a), (Some init_b) -> eq_init init_a init_b +let eq_initinfo (a: initinfo) (b: initinfo) (context: context) = match a.init, b.init with + | (Some init_a), (Some init_b) -> eq_init init_a init_b context | None, None -> true | _, _ -> false + +let context_to_string (context: context) = "[" ^ (match context with + | [] -> "" + | contextList -> + let elementsAsString = List.map (fun x -> match x with (originalName, nowName) -> "(" ^ originalName ^ " -> " ^ nowName ^ ")") contextList in + List.fold_left (fun a b -> a ^ ", " ^ b) (List.hd elementsAsString) (List.tl elementsAsString) + ) ^ "]" \ No newline at end of file diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 7f8e5aaa4d..f99b112e37 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -5,24 +5,24 @@ include CompareAST let eq_node (x, fun1) (y, fun2) = match x,y with - | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) - | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar - | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar + | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) [] + | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar [] + | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar [] | _ -> false (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) let eq_edge x y = match x, y with - | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 && eq_exp rv1 rv2 - | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 && GobList.equal eq_exp ars1 ars2 + | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 [] && eq_exp rv1 rv2 [] + | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 [] && GobList.equal (eq_exp2 []) ars1 ars2 | Proc (Some r1,f1,ars1), Proc (Some r2,f2,ars2) -> - eq_lval r1 r2 && eq_exp f1 f2 && GobList.equal eq_exp ars1 ars2 - | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar - | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar - | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 && eq_varinfo fd1.svar fd2.svar - | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 && b1 = b2 + eq_lval r1 r2 [] && eq_exp f1 f2 [] && GobList.equal (eq_exp2 []) ars1 ars2 + | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar [] + | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar [] + | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 [] && eq_varinfo fd1.svar fd2.svar [] + | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 [] && b1 = b2 | ASM _, ASM _ -> false | Skip, Skip -> true - | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 + | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 [] | SelfLoop, SelfLoop -> true | _ -> false @@ -44,6 +44,8 @@ module NTH = Hashtbl.Make( * process on their successors. If a node from the old CFG can not be matched, it is added to diff and no further * comparison is done for its successors. The two function entry nodes make up the tuple to start the comparison from. *) let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 fun2 = + let _ = Printf.printf "ComparingCfgs" in + let diff = NH.create 113 in let same = NTH.create 113 in let waitingList : (node * node) t = Queue.create () in @@ -127,6 +129,7 @@ let reexamine f1 f2 (same : unit NTH.t) (diffNodes1 : unit NH.t) (module CfgOld (NTH.to_seq_keys same, NH.to_seq_keys diffNodes1, NH.to_seq_keys diffNodes2) let compareFun (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 fun2 = + let _ = Printf.printf "Comparing funs" in let same, diff = compareCfgs (module CfgOld) (module CfgNew) fun1 fun2 in let unchanged, diffNodes1, diffNodes2 = reexamine fun1 fun2 same diff (module CfgOld) (module CfgNew) in List.of_seq unchanged, List.of_seq diffNodes1, List.of_seq diffNodes2 diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 26bd27b5a4..808b1ee706 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -32,18 +32,34 @@ let should_reanalyze (fdec: Cil.fundec) = * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) = - let unchangedHeader = eq_varinfo a.svar b.svar && GobList.equal eq_varinfo a.sformals b.sformals in + let unchangedHeader = eq_varinfo a.svar b.svar [] && GobList.equal (eq_varinfo2 []) a.sformals b.sformals in let identical, diffOpt = if should_reanalyze a then false, None else - let sameDef = unchangedHeader && GobList.equal eq_varinfo a.slocals b.slocals in + (* Here the local variables are checked to be equal *) + let rec context_aware_compare (alocals: varinfo list) (blocals: varinfo list) (context: context) = match alocals, blocals with + | [], [] -> true, context + | origLocal :: als, nowLocal :: bls -> + let newContext = if origLocal.vname = nowLocal.vname then context else context @ [(origLocal.vname, nowLocal.vname)] in + (*TODO: also call eq_varinfo*) + context_aware_compare als bls newContext + | _, _ -> false, context + in + + let sizeEqual, context = context_aware_compare a.slocals b.slocals [] in + + let _ = Printf.printf "Context=%s\n" (CompareAST.context_to_string context) in + let _ = Printf.printf "SizeEqual=%b; unchangedHeader=%b\n" sizeEqual unchangedHeader in + + let sameDef = unchangedHeader && sizeEqual in if not sameDef then (false, None) else match cfgs with - | None -> eq_block (a.sbody, a) (b.sbody, b), None + | None -> eq_block (a.sbody, a) (b.sbody, b) context, None | Some (cfgOld, cfgNew) -> + let _ = Printf.printf "compareCIL.eqF: Compaing 2 cfgs now\n" in let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgForward = struct let next = cfgNew end in let matches, diffNodes1, diffNodes2 = compareFun (module CfgOld) (module CfgNew) a b in @@ -53,12 +69,16 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) = identical, unchangedHeader, diffOpt let eq_glob (a: global) (b: global) (cfgs : (cfg * cfg) option) = match a, b with - | GFun (f,_), GFun (g,_) -> eqF f g cfgs - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y, false, None + | GFun (f,_), GFun (g,_) -> + let _ = Printf.printf "Comparing funs %s with %s\n" f.svar.vname g.svar.vname in + eqF f g cfgs + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y [], false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y [], false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = + let _ = Printf.printf "Comparing Cil files\n" in + let cfgs = if GobConfig.get_string "incremental.compare" = "cfg" then Some (CfgTools.getCFG oldAST |> fst, CfgTools.getCFG newAST |> fst) else None in diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.c b/tests/incremental/04-var-rename/02-rename_and_shuffle.c new file mode 100644 index 0000000000..9917738055 --- /dev/null +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.c @@ -0,0 +1,11 @@ +#include + +//a is renamed to c, but the usage of a is replaced by b +int main() { + int a = 0; + int b = 1; + + printf("Print %d", a); + + return 0; +} diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.json b/tests/incremental/04-var-rename/02-rename_and_shuffle.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.patch b/tests/incremental/04-var-rename/02-rename_and_shuffle.patch new file mode 100644 index 0000000000..5c1dc4785e --- /dev/null +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.patch @@ -0,0 +1,15 @@ +--- tests/incremental/04-var-rename/02-rename_and_shuffle.c ++++ tests/incremental/04-var-rename/02-rename_and_shuffle.c +@@ -2,10 +2,10 @@ + + //a is renamed to c, but the usage of a is replaced by b + int main() { +- int a = 0; ++ int c = 0; + int b = 1; + +- printf("Print %d", a); ++ printf("Print %d", b); + + return 0; + } diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.c b/tests/incremental/04-var-rename/03-rename_with_usage.c new file mode 100644 index 0000000000..2c93c487d8 --- /dev/null +++ b/tests/incremental/04-var-rename/03-rename_with_usage.c @@ -0,0 +1,11 @@ +#include + +//a is renamed to c, but its usages stay the same +int main() { + int a = 0; + int b = 1; + + printf("Print %d", a); + + return 0; +} diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.json b/tests/incremental/04-var-rename/03-rename_with_usage.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/03-rename_with_usage.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.patch b/tests/incremental/04-var-rename/03-rename_with_usage.patch new file mode 100644 index 0000000000..26fb98b340 --- /dev/null +++ b/tests/incremental/04-var-rename/03-rename_with_usage.patch @@ -0,0 +1,15 @@ +--- tests/incremental/04-var-rename/03-rename_with_usage.c ++++ tests/incremental/04-var-rename/03-rename_with_usage.c +@@ -2,10 +2,10 @@ + + //a is renamed to c, but its usages stay the same + int main() { +- int a = 0; ++ int c = 0; + int b = 1; + +- printf("Print %d", a); ++ printf("Print %d", c); + + return 0; + } diff --git a/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c b/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c new file mode 100644 index 0000000000..eb54a5c0aa --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c @@ -0,0 +1,11 @@ +#include + +//a is renamed to c, but the usage of a is replaced by b +int main() { + int c = 0; + int b = 1; + + printf("Print %d", b); + + return 0; +} diff --git a/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c b/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c new file mode 100644 index 0000000000..4676e03447 --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c @@ -0,0 +1,11 @@ +#include + +//a is renamed to c, but its usages stay the same +int main() { + int c = 0; + int b = 1; + + printf("Print %d", c); + + return 0; +} From 6bc0fca62df82fd265cbe520be8a352d6c8c6efc Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Sun, 3 Apr 2022 15:58:36 +0200 Subject: [PATCH 006/518] Rename detection for method parameters, too --- src/incremental/compareAST.ml | 7 ++---- src/incremental/compareCIL.ml | 23 ++++++++++++------- .../04-var-rename/04-overwritten_var.c | 9 ++++++++ .../04-var-rename/05-renamed-param.patch | 10 ++++++++ .../04-var-rename/05-renamed_param.c | 8 +++++++ .../04-var-rename/05-renamed_param.json | 3 +++ .../04-var-rename/diffs/04-overwritten_var.c | 11 +++++++++ .../04-var-rename/diffs/05-renamed_param.c | 8 +++++++ 8 files changed, 66 insertions(+), 13 deletions(-) create mode 100644 tests/incremental/04-var-rename/04-overwritten_var.c create mode 100644 tests/incremental/04-var-rename/05-renamed-param.patch create mode 100644 tests/incremental/04-var-rename/05-renamed_param.c create mode 100644 tests/incremental/04-var-rename/05-renamed_param.json create mode 100644 tests/incremental/04-var-rename/diffs/04-overwritten_var.c create mode 100644 tests/incremental/04-var-rename/diffs/05-renamed_param.c diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index ba484693a0..344ff1781b 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -24,7 +24,6 @@ module GlobalMap = Map.Make(struct let compare_name (a: string) (b: string) = let anon_struct = "__anonstruct_" in let anon_union = "__anonunion_" in - let _ = Printf.printf "Comparing names: %s = %s\n" a b in if a = b then true else BatString.(starts_with a anon_struct && starts_with b anon_struct || starts_with a anon_union && starts_with b anon_union) let rec eq_constant (context: context) (a: constant) (b: constant) = @@ -35,7 +34,7 @@ let rec eq_constant (context: context) (a: constant) (b: constant) = and eq_exp2 (context: context) (a: exp) (b: exp) = eq_exp a b context -and eq_exp (a: exp) (b: exp) (context: context) = +and eq_exp (a: exp) (b: exp) (context: context) = match a, b with | Const c1, Const c2 -> eq_constant context c1 c2 | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 context @@ -139,8 +138,6 @@ and eq_attribute (context: context) (a: attribute) (b: attribute) = match a, b w and eq_varinfo2 (context: context) (a: varinfo) (b: varinfo) = eq_varinfo a b context -and bla (context: context) = List.exists (fun x -> match x with (a, b) -> a == "") context - and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = let isNamingOk = if a.vname != b.vname then let existingAssumption: (string*string) option = List.find_opt (fun x -> match x with (original, now) -> original = a.vname) context in @@ -151,7 +148,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = else true in - let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in + (*let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in *) (*a.vname = b.vname*) isNamingOk && eq_typ a.vtype b.vtype context && GobList.equal (eq_attribute context) a.vattr b.vattr && a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 808b1ee706..65d462dac2 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -32,13 +32,10 @@ let should_reanalyze (fdec: Cil.fundec) = * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) = - let unchangedHeader = eq_varinfo a.svar b.svar [] && GobList.equal (eq_varinfo2 []) a.sformals b.sformals in - let identical, diffOpt = - if should_reanalyze a then - false, None - else - (* Here the local variables are checked to be equal *) - let rec context_aware_compare (alocals: varinfo list) (blocals: varinfo list) (context: context) = match alocals, blocals with + + (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, + * and as a second a context, holding the rename assumptions *) + let rec context_aware_compare (alocals: varinfo list) (blocals: varinfo list) (context: context) = match alocals, blocals with | [], [] -> true, context | origLocal :: als, nowLocal :: bls -> let newContext = if origLocal.vname = nowLocal.vname then context else context @ [(origLocal.vname, nowLocal.vname)] in @@ -47,7 +44,17 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) = | _, _ -> false, context in - let sizeEqual, context = context_aware_compare a.slocals b.slocals [] in + let headerSizeEqual, headerContext = context_aware_compare a.sformals b.sformals [] in + + let unchangedHeader = eq_varinfo a.svar b.svar headerContext && GobList.equal (eq_varinfo2 []) a.sformals b.sformals in + let identical, diffOpt = + if should_reanalyze a then + false, None + else + (* Here the local variables are checked to be equal *) + + + let sizeEqual, context = context_aware_compare a.slocals b.slocals headerContext in let _ = Printf.printf "Context=%s\n" (CompareAST.context_to_string context) in let _ = Printf.printf "SizeEqual=%b; unchangedHeader=%b\n" sizeEqual unchangedHeader in diff --git a/tests/incremental/04-var-rename/04-overwritten_var.c b/tests/incremental/04-var-rename/04-overwritten_var.c new file mode 100644 index 0000000000..80956dea76 --- /dev/null +++ b/tests/incremental/04-var-rename/04-overwritten_var.c @@ -0,0 +1,9 @@ +int main() { + int i = 0; + + for(int i = 0; i < 10; i++) { + + } + + return 0; +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/05-renamed-param.patch b/tests/incremental/04-var-rename/05-renamed-param.patch new file mode 100644 index 0000000000..944566b05c --- /dev/null +++ b/tests/incremental/04-var-rename/05-renamed-param.patch @@ -0,0 +1,10 @@ +--- tests/incremental/04-var-rename/05-renamed_param.c ++++ tests/incremental/04-var-rename/05-renamed_param.c +@@ -1,5 +1,5 @@ +-void method(int a) { +- int c = a; ++void method(int b) { ++ int c = b; + } + + int main() { diff --git a/tests/incremental/04-var-rename/05-renamed_param.c b/tests/incremental/04-var-rename/05-renamed_param.c new file mode 100644 index 0000000000..72fdfaf0e9 --- /dev/null +++ b/tests/incremental/04-var-rename/05-renamed_param.c @@ -0,0 +1,8 @@ +void method(int a) { + int c = a; +} + +int main() { + method(0); + return 0; +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/05-renamed_param.json b/tests/incremental/04-var-rename/05-renamed_param.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/05-renamed_param.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/04-overwritten_var.c b/tests/incremental/04-var-rename/diffs/04-overwritten_var.c new file mode 100644 index 0000000000..240bdbb8ad --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/04-overwritten_var.c @@ -0,0 +1,11 @@ +int main() { + int i = 0; + + for(int a = 0; a < 10; a++) { + i++; + } + + assert(i < 11); + + return 0; +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/05-renamed_param.c b/tests/incremental/04-var-rename/diffs/05-renamed_param.c new file mode 100644 index 0000000000..198bd82496 --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/05-renamed_param.c @@ -0,0 +1,8 @@ +void method(int b) { + int c = b; +} + +int main() { + method(0); + return 0; +} \ No newline at end of file From ca6670b3323fe0117eb0d498945d467cc611bcfc Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 5 Apr 2022 16:53:57 +0200 Subject: [PATCH 007/518] Renaming of method params should work now. --- src/incremental/compareAST.ml | 101 ++++++++++++++---- src/incremental/compareCFG.ml | 27 ++--- src/incremental/compareCIL.ml | 66 +++++++++--- src/util/server.ml | 2 +- ...med-param.patch => 05-renamed_param.patch} | 0 .../06-renamed_param_usage_changed.c | 11 ++ .../06-renamed_param_usage_changed.json | 3 + .../06-renamed_param_usage_changed.patch | 10 ++ .../diffs/06-renamed_param_usage_changed.c | 11 ++ 9 files changed, 183 insertions(+), 48 deletions(-) rename tests/incremental/04-var-rename/{05-renamed-param.patch => 05-renamed_param.patch} (100%) create mode 100644 tests/incremental/04-var-rename/06-renamed_param_usage_changed.c create mode 100644 tests/incremental/04-var-rename/06-renamed_param_usage_changed.json create mode 100644 tests/incremental/04-var-rename/06-renamed_param_usage_changed.patch create mode 100644 tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 344ff1781b..f471cfa61d 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -5,8 +5,41 @@ type global_type = Fun | Decl | Var and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] +type local_rename = string * string +(**) +type method_context = {original_method_name: string; new_method_name: string; parameter_renames: (string * string) list} + (*context is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type context = (string * string) list +type context = (local_rename list) * (method_context list) + +(*Compares two names, being aware of the context. Returns true iff: + 1. there is a rename for name1 -> name2 = rename(name1) + 2. there is no rename for name1 -> name1 = name2*) +let context_aware_name_comparison (name1: string) (name2: string) (context: context) = + let (local_c, method_c) = context in + let existingAssumption: (string*string) option = List.find_opt (fun x -> match x with (original, now) -> original = name1) local_c in + + match existingAssumption with + | Some (original, now) -> + (*Printf.printf "Assumption is: %s -> %s\n" original now;*) + now = name2 + | None -> + (*Printf.printf "No assumption when %s, %s, %b\n" name1 name2 (name1 = name2);*) + name1 = name2 (*Var names differ, but there is no assumption, so this can't be good*) + +let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> + List.map (fun x -> match x with (first, second) -> "(" ^ first ^ " -> " ^ second ^ ")") |> + String.concat ", ") ^ "]" + +let context_to_string (context: context) = + let (local, methods) = context in + let local_string = string_tuple_to_string local in + let methods_string: string = methods |> + List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> + "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ + "; renamed_params=" ^ string_tuple_to_string parameter_renames ^ ")") |> + String.concat ", " in + "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "])" let identifier_of_global glob = match glob with @@ -68,7 +101,9 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (context: context) = | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc context && eq_exp lenExp1 lenExp2 context && GobList.equal (eq_attribute context) attr1 attr2 | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_args context acc) list1 list2 && varArg1 = varArg2 && + -> + Printf.printf "eq_typ_acc=1:%b;2:%b;3:%b;4:%b;\n" ( eq_typ_acc typ1 typ2 acc context) (GobList.equal (eq_args context acc) list1 list2) (varArg1 = varArg2) (GobList.equal (eq_attribute context) attr1 attr2); + eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_args context acc) list1 list2 && varArg1 = varArg2 && GobList.equal (eq_attribute context) attr1 attr2 | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) -> eq_typ_acc typ1 typ2 acc context && varArg1 = varArg2 && @@ -114,7 +149,13 @@ and eq_enuminfo (a: enuminfo) (b: enuminfo) (context: context) = (* Ignore ereferenced *) and eq_args (context: context) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with - (name1, typ1, attr1), (name2, typ2, attr2) -> name1 = name2 && eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 + (name1, typ1, attr1), (name2, typ2, attr2) -> + Printf.printf "Comparing args: %s <-> %s\n" name1 name2; + Printf.printf "Current context: %s\n" (context_to_string context); + let result = context_aware_name_comparison name1 name2 context && eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 in + + Printf.printf "Back\n"; + result and eq_attrparam (context: context) (a: attrparam) (b: attrparam) = match a, b with | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam context) attrparams1 attrparams2 @@ -139,18 +180,41 @@ and eq_attribute (context: context) (a: attribute) (b: attribute) = match a, b w and eq_varinfo2 (context: context) (a: varinfo) (b: varinfo) = eq_varinfo a b context and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = - let isNamingOk = if a.vname != b.vname then - let existingAssumption: (string*string) option = List.find_opt (fun x -> match x with (original, now) -> original = a.vname) context in + Printf.printf "Comp %s with %s\n" a.vname b.vname; + let isNamingOk = context_aware_name_comparison a.vname b.vname context in + + (*If the following is a method call, we need to check if we have a mapping for that method call. *) + let (_, method_contexts) = context in + let typ_context, did_context_switch = match b.vtype with + | TFun(_, _, _, _) -> ( + let new_locals = List.find_opt (fun x -> match x with + | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname + ) method_contexts in + + match new_locals with + | Some locals -> + Printf.printf "Performing context switch. New context=%s\n" (context_to_string (locals.parameter_renames, method_contexts)); + (locals.parameter_renames, method_contexts), true + | None -> ([], method_contexts), false + ) + | _ -> context, false + in + + let typeCheck = eq_typ a.vtype b.vtype typ_context in + let attrCheck = GobList.equal (eq_attribute context) a.vattr b.vattr in - match existingAssumption with - | Some (original, now) -> now = b.vname - | None -> true (*Var names differ, but there is no assumption, so this can't be good*) + let _ = Printf.printf "eq_varinfo: 0=%b;1=%b;2=%b;3=%b;4=%b;5=%b\n" isNamingOk typeCheck attrCheck (a.vstorage = b.vstorage) (a.vglob = b.vglob) (a.vaddrof = b.vaddrof) in - else true in + + (*let _ = if isNamingOk then a.vname <- b.vname in*) (*let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in *) - (*a.vname = b.vname*) isNamingOk && eq_typ a.vtype b.vtype context && GobList.equal (eq_attribute context) a.vattr b.vattr && - a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof + (*a.vname = b.vname*) + let result = isNamingOk && typeCheck && attrCheck && + a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in + if did_context_switch then Printf.printf "Undo context switch \n"; + + result (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) (* Accumulator is needed because of recursive types: we have to assume that two types we already encountered in a previous step of the recursion are equivalent *) @@ -178,8 +242,10 @@ and eq_lval (a: lval) (b: lval) (context: context) = match a, b with let eq_instr (context: context) (a: instr) (b: instr) = match a, b with | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 context && eq_exp exp1 exp2 context - | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> eq_lval lv1 lv2 context && eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 - | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 + | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> + eq_lval lv1 lv2 context && eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 + | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> + eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2 context) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2 context) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 context | _, _ -> false @@ -231,11 +297,4 @@ let rec eq_init (a: init) (b: init) (context: context) = match a, b with let eq_initinfo (a: initinfo) (b: initinfo) (context: context) = match a.init, b.init with | (Some init_a), (Some init_b) -> eq_init init_a init_b context | None, None -> true - | _, _ -> false - -let context_to_string (context: context) = "[" ^ (match context with - | [] -> "" - | contextList -> - let elementsAsString = List.map (fun x -> match x with (originalName, nowName) -> "(" ^ originalName ^ " -> " ^ nowName ^ ")") contextList in - List.fold_left (fun a b -> a ^ ", " ^ b) (List.hd elementsAsString) (List.tl elementsAsString) - ) ^ "]" \ No newline at end of file + | _, _ -> false \ No newline at end of file diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index f99b112e37..25b5f64ccf 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -4,25 +4,28 @@ open Cil include CompareAST let eq_node (x, fun1) (y, fun2) = + let empty_context: context = ([], []) in match x,y with - | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) [] - | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar [] - | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar [] + | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_context + | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_context + | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar empty_context | _ -> false (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) -let eq_edge x y = match x, y with - | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 [] && eq_exp rv1 rv2 [] - | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 [] && GobList.equal (eq_exp2 []) ars1 ars2 +let eq_edge x y = + let empty_context: context = ([], []) in + match x, y with + | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_context && eq_exp rv1 rv2 empty_context + | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_context && GobList.equal (eq_exp2 empty_context) ars1 ars2 | Proc (Some r1,f1,ars1), Proc (Some r2,f2,ars2) -> - eq_lval r1 r2 [] && eq_exp f1 f2 [] && GobList.equal (eq_exp2 []) ars1 ars2 - | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar [] - | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar [] - | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 [] && eq_varinfo fd1.svar fd2.svar [] - | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 [] && b1 = b2 + eq_lval r1 r2 empty_context && eq_exp f1 f2 empty_context && GobList.equal (eq_exp2 empty_context) ars1 ars2 + | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar empty_context + | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar empty_context + | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 empty_context && eq_varinfo fd1.svar fd2.svar empty_context + | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 empty_context && b1 = b2 | ASM _, ASM _ -> false | Skip, Skip -> true - | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 [] + | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 empty_context | SelfLoop, SelfLoop -> true | _ -> false diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 65d462dac2..013ba21248 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -31,11 +31,11 @@ let should_reanalyze (fdec: Cil.fundec) = (* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) -let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) = +let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_context: method_context list) = (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a context, holding the rename assumptions *) - let rec context_aware_compare (alocals: varinfo list) (blocals: varinfo list) (context: context) = match alocals, blocals with + let rec context_aware_compare (alocals: varinfo list) (blocals: varinfo list) (context: local_rename list) = match alocals, blocals with | [], [] -> true, context | origLocal :: als, nowLocal :: bls -> let newContext = if origLocal.vname = nowLocal.vname then context else context @ [(origLocal.vname, nowLocal.vname)] in @@ -45,8 +45,12 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) = in let headerSizeEqual, headerContext = context_aware_compare a.sformals b.sformals [] in + let actHeaderContext = (headerContext, global_context) in + Printf.printf "Header context=%s\n" (context_to_string actHeaderContext); - let unchangedHeader = eq_varinfo a.svar b.svar headerContext && GobList.equal (eq_varinfo2 []) a.sformals b.sformals in + let unchangedHeader = eq_varinfo a.svar b.svar actHeaderContext && GobList.equal (eq_varinfo2 actHeaderContext) a.sformals b.sformals in + let _ = Printf.printf "unchangedHeader=%b\n" unchangedHeader in + let _ = Printf.printf "part1=%b; part2=%b \n" (eq_varinfo a.svar b.svar actHeaderContext) (GobList.equal (eq_varinfo2 actHeaderContext) a.sformals b.sformals) in let identical, diffOpt = if should_reanalyze a then false, None @@ -54,19 +58,21 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) = (* Here the local variables are checked to be equal *) - let sizeEqual, context = context_aware_compare a.slocals b.slocals headerContext in + let sizeEqual, local_rename = context_aware_compare a.slocals b.slocals headerContext in + let context: context = (local_rename, global_context) in let _ = Printf.printf "Context=%s\n" (CompareAST.context_to_string context) in - let _ = Printf.printf "SizeEqual=%b; unchangedHeader=%b\n" sizeEqual unchangedHeader in let sameDef = unchangedHeader && sizeEqual in if not sameDef then (false, None) else match cfgs with - | None -> eq_block (a.sbody, a) (b.sbody, b) context, None + | None -> + Printf.printf "Comparing blocks\n"; + eq_block (a.sbody, a) (b.sbody, b) context, None | Some (cfgOld, cfgNew) -> - let _ = Printf.printf "compareCIL.eqF: Compaing 2 cfgs now\n" in + Printf.printf "compareCIL.eqF: Compaing 2 cfgs now\n"; let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgForward = struct let next = cfgNew end in let matches, diffNodes1, diffNodes2 = compareFun (module CfgOld) (module CfgNew) a b in @@ -75,12 +81,16 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) = in identical, unchangedHeader, diffOpt -let eq_glob (a: global) (b: global) (cfgs : (cfg * cfg) option) = match a, b with +let eq_glob (a: global) (b: global) (cfgs : (cfg * cfg) option) (global_context: method_context list) = match a, b with | GFun (f,_), GFun (g,_) -> let _ = Printf.printf "Comparing funs %s with %s\n" f.svar.vname g.svar.vname in - eqF f g cfgs - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y [], false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y [], false, None + let identical, unchangedHeader, diffOpt = eqF f g cfgs global_context in + + let _ = Printf.printf "identical=%b; unchangedHeader=%b\n" identical unchangedHeader in + + identical, unchangedHeader, diffOpt + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y ([], []), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y ([], []), false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = @@ -90,6 +100,26 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = then Some (CfgTools.getCFG oldAST |> fst, CfgTools.getCFG newAST |> fst) else None in + let generate_global_context map global = + try + let ident = identifier_of_global global in + let old_global = GlobalMap.find ident map in + + match old_global, global with + | GFun(f, _), GFun (g, _) -> + let renamed_params: (string * string) list = if (List.length f.sformals) = (List.length g.sformals) then + List.combine f.sformals g.sformals |> + List.filter (fun (original, now) -> not (original.vname = now.vname)) |> + List.map (fun (original, now) -> (original.vname, now.vname)) + else [] in + + if not (f.svar.vname = g.svar.vname) || (List.length renamed_params) > 0 then + Option.some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} + else Option.none + | _, _ -> Option.none + with Not_found -> Option.none + in + let addGlobal map global = try let gid = identifier_of_global global in @@ -101,14 +131,15 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = with Not_found -> map in + let changes = empty_change_info () in global_typ_acc := []; - let checkUnchanged map global = + let checkUnchanged map global global_context = try let ident = identifier_of_global global in let old_global = GlobalMap.find ident map in (* Do a (recursive) equal comparison ignoring location information *) - let identical, unchangedHeader, diff = eq old_global global cfgs in + let identical, unchangedHeader, diff = eq old_global global cfgs global_context in if identical then changes.unchanged <- global :: changes.unchanged else changes.changed <- {current = global; old = old_global; unchangedHeader; diff} :: changes.changed @@ -122,10 +153,17 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = (* Store a map from functionNames in the old file to the function definition*) let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in + + let global_context: method_context list = Cil.foldGlobals newAST (fun (current_global_context: method_context list) global -> + match generate_global_context oldMap global with + | Some context -> current_global_context @ [context] + | None -> current_global_context + ) [] in + (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) Cil.iterGlobals newAST - (fun glob -> checkUnchanged oldMap glob); + (fun glob -> checkUnchanged oldMap glob global_context); (* We check whether functions have been added or removed *) Cil.iterGlobals newAST (fun glob -> if not (checkExists oldMap glob) then changes.added <- (glob::changes.added)); diff --git a/src/util/server.ml b/src/util/server.ml index e64d4b36e6..3c3cad9e60 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -116,7 +116,7 @@ let reparse (s: t) = (* Only called when the file has not been reparsed, so we can skip the expensive CFG comparison. *) let virtual_changes file = - let eq (glob: Cil.global) _ _ = match glob with + let eq (glob: Cil.global) _ _ _ = match glob with | GFun (fdec, _) -> CompareCIL.should_reanalyze fdec, false, None | _ -> false, false, None in diff --git a/tests/incremental/04-var-rename/05-renamed-param.patch b/tests/incremental/04-var-rename/05-renamed_param.patch similarity index 100% rename from tests/incremental/04-var-rename/05-renamed-param.patch rename to tests/incremental/04-var-rename/05-renamed_param.patch diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.c b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.c new file mode 100644 index 0000000000..aed642566c --- /dev/null +++ b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.c @@ -0,0 +1,11 @@ +//This test should mark foo and main as changed + +void foo(int a, int b) { + int x = a; + int y = b; +} + +int main() { + foo(3, 4); + return 0; +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.json b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.patch b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.patch new file mode 100644 index 0000000000..a93e45c4c5 --- /dev/null +++ b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.patch @@ -0,0 +1,10 @@ +--- tests/incremental/04-var-rename/06-renamed_param_usage_changed.c ++++ tests/incremental/04-var-rename/06-renamed_param_usage_changed.c +@@ -1,6 +1,6 @@ + //This test should mark foo and main as changed + +-void foo(int a, int b) { ++void foo(int b, int a) { + int x = a; + int y = b; + } diff --git a/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c b/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c new file mode 100644 index 0000000000..0bf42f645e --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c @@ -0,0 +1,11 @@ +//This test should mark foo and main as changed + +void foo(int b, int a) { + int x = a; + int y = b; +} + +int main() { + foo(3, 4); + return 0; +} \ No newline at end of file From c1e165cb9553291b4d7c4db818a2af703e1f0ba7 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 18 Apr 2022 15:52:27 +0200 Subject: [PATCH 008/518] Renaming of results does work for the log files. --- src/analyses/base.ml | 35 ++++++++++++++++++- src/incremental/compareAST.ml | 35 ++++++++++--------- src/incremental/compareCIL.ml | 34 ++++++++++++------ src/util/server.ml | 1 + .../04-var-rename/04-overwritten_var.c | 9 ----- .../04-var-rename/04-renamed_assert.c | 7 ++++ .../04-var-rename/04-renamed_assert.json | 3 ++ .../04-var-rename/04-renamed_assert.patch | 13 +++++++ .../04-var-rename/07-method_rename.c | 10 ++++++ .../04-var-rename/07-method_rename.json | 3 ++ .../04-var-rename/07-method_rename.patch | 15 ++++++++ .../04-var-rename/diffs/04-overwritten_var.c | 11 ------ .../04-var-rename/diffs/04-renamed_assert.c | 7 ++++ .../04-var-rename/diffs/07-method_rename.c | 10 ++++++ tests/incremental/04-var-rename/test.c | 15 ++++++++ 15 files changed, 160 insertions(+), 48 deletions(-) delete mode 100644 tests/incremental/04-var-rename/04-overwritten_var.c create mode 100644 tests/incremental/04-var-rename/04-renamed_assert.c create mode 100644 tests/incremental/04-var-rename/04-renamed_assert.json create mode 100644 tests/incremental/04-var-rename/04-renamed_assert.patch create mode 100644 tests/incremental/04-var-rename/07-method_rename.c create mode 100644 tests/incremental/04-var-rename/07-method_rename.json create mode 100644 tests/incremental/04-var-rename/07-method_rename.patch delete mode 100644 tests/incremental/04-var-rename/diffs/04-overwritten_var.c create mode 100644 tests/incremental/04-var-rename/diffs/04-renamed_assert.c create mode 100644 tests/incremental/04-var-rename/diffs/07-method_rename.c create mode 100644 tests/incremental/04-var-rename/test.c diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 2e846da692..202a15c5ab 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2015,6 +2015,36 @@ struct | _ -> [] let assert_fn ctx e should_warn change = + let parent_function: fundec = Node.find_fundec ctx.node in + + (*Performs the actual rename on lvals for renamed local variables.*) + let rename_lval lhost offset = + let new_lhost = match lhost with + | Var varinfo -> + varinfo.vname <- CompareCIL.get_local_rename parent_function.svar.vname varinfo.vname; + Var varinfo + | _ -> lhost + in + (new_lhost, offset) + in + + (*Recusivly go through the expression and rename all occurences of local variables. TODO: What happens with global vars*) + let rec rename_exp (exp: exp) = match exp with + | Lval (lhost, offset) -> Lval (rename_lval lhost offset) + | Real e -> Real (rename_exp e) + | Imag e -> Imag (rename_exp e) + | SizeOfE e -> SizeOfE (rename_exp e) + | AlignOfE e -> AlignOfE (rename_exp e) + | UnOp (unop, e, typ) -> UnOp (unop, rename_exp e, typ) + | BinOp (binop, e1, e2, typ) -> BinOp (binop, rename_exp e1, rename_exp e2, typ) + | Question (e1, e2, e3, typ) -> Question (rename_exp e1, rename_exp e2, rename_exp e3, typ) + | CastE (typ, e) -> CastE (typ, rename_exp e) + | AddrOf (lhost, offset) -> AddrOf (rename_lval lhost offset) + | StartOf (lhost, offset) -> StartOf (rename_lval lhost offset) + (*TODO: AddrOfLabel?*) + | _ -> exp + in + let check_assert e st = match eval_rv (Analyses.ask_of_ctx ctx) ctx.global st e with @@ -2027,7 +2057,7 @@ struct | `Bot -> `Bot | _ -> `Top in - let expr = sprint d_exp e in + let expr = sprint d_exp (rename_exp e) in let warn warn_fn ?annot msg = if should_warn then if get_bool "dbg.regression" then ( (* This only prints unexpected results (with the difference) as indicated by the comment behind the assert (same as used by the regression test script). *) let loc = !M.current_loc in @@ -2087,6 +2117,9 @@ struct invalidate ~ctx (Analyses.ask_of_ctx ctx) gs st addrs let special ctx (lv:lval option) (f: varinfo) (args: exp list) = + Printf.printf "special: varinfo=%s\n" f.vname; + List.iter (fun x -> ignore @@ Pretty.printf "%a\n" Cil.d_exp x;) args; + let invalidate_ret_lv st = match lv with | Some lv -> if M.tracing then M.tracel "invalidate" "Invalidating lhs %a for function call %s\n" d_plainlval lv f.vname; diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index f471cfa61d..d9361ec082 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -101,9 +101,7 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (context: context) = | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc context && eq_exp lenExp1 lenExp2 context && GobList.equal (eq_attribute context) attr1 attr2 | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) - -> - Printf.printf "eq_typ_acc=1:%b;2:%b;3:%b;4:%b;\n" ( eq_typ_acc typ1 typ2 acc context) (GobList.equal (eq_args context acc) list1 list2) (varArg1 = varArg2) (GobList.equal (eq_attribute context) attr1 attr2); - eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_args context acc) list1 list2 && varArg1 = varArg2 && + -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_args context acc) list1 list2 && varArg1 = varArg2 && GobList.equal (eq_attribute context) attr1 attr2 | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) -> eq_typ_acc typ1 typ2 acc context && varArg1 = varArg2 && @@ -150,12 +148,7 @@ and eq_enuminfo (a: enuminfo) (b: enuminfo) (context: context) = and eq_args (context: context) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with (name1, typ1, attr1), (name2, typ2, attr2) -> - Printf.printf "Comparing args: %s <-> %s\n" name1 name2; - Printf.printf "Current context: %s\n" (context_to_string context); - let result = context_aware_name_comparison name1 name2 context && eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 in - - Printf.printf "Back\n"; - result + context_aware_name_comparison name1 name2 context && eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 and eq_attrparam (context: context) (a: attrparam) (b: attrparam) = match a, b with | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam context) attrparams1 attrparams2 @@ -180,11 +173,24 @@ and eq_attribute (context: context) (a: attribute) (b: attribute) = match a, b w and eq_varinfo2 (context: context) (a: varinfo) (b: varinfo) = eq_varinfo a b context and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = - Printf.printf "Comp %s with %s\n" a.vname b.vname; - let isNamingOk = context_aware_name_comparison a.vname b.vname context in + (*Printf.printf "Comp %s with %s\n" a.vname b.vname;*) - (*If the following is a method call, we need to check if we have a mapping for that method call. *) let (_, method_contexts) = context in + + (*When we compare function names, we can directly compare the naming from the context if it exists.*) + let isNamingOk = match b.vtype with + | TFun(_, _, _, _) -> ( + let specific_method_context = List.find_opt (fun x -> match x with + | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname + ) method_contexts in + match specific_method_context with + | Some method_context -> method_context.original_method_name = a.vname && method_context.new_method_name = b.vname + | None -> a.vname = b.vname + ) + | _ -> context_aware_name_comparison a.vname b.vname context + in + + (*If the following is a method call, we need to check if we have a mapping for that method call. *) let typ_context, did_context_switch = match b.vtype with | TFun(_, _, _, _) -> ( let new_locals = List.find_opt (fun x -> match x with @@ -193,7 +199,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = match new_locals with | Some locals -> - Printf.printf "Performing context switch. New context=%s\n" (context_to_string (locals.parameter_renames, method_contexts)); + (*Printf.printf "Performing context switch. New context=%s\n" (context_to_string (locals.parameter_renames, method_contexts));*) (locals.parameter_renames, method_contexts), true | None -> ([], method_contexts), false ) @@ -203,9 +209,6 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = let typeCheck = eq_typ a.vtype b.vtype typ_context in let attrCheck = GobList.equal (eq_attribute context) a.vattr b.vattr in - let _ = Printf.printf "eq_varinfo: 0=%b;1=%b;2=%b;3=%b;4=%b;5=%b\n" isNamingOk typeCheck attrCheck (a.vstorage = b.vstorage) (a.vglob = b.vglob) (a.vaddrof = b.vaddrof) in - - (*let _ = if isNamingOk then a.vname <- b.vname in*) (*let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in *) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 013ba21248..b95c56694a 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -3,6 +3,8 @@ open MyCFG include CompareAST include CompareCFG +let rename_map: (string, (string, string) Hashtbl.t) Hashtbl.t ref = ref (Hashtbl.create 100) + type nodes_diff = { unchangedNodes: (node * node) list; primObsoleteNodes: node list; (** primary obsolete nodes -> all obsolete nodes are reachable from these *) @@ -23,6 +25,14 @@ type change_info = { mutable added: global list } +let store_local_rename (function_name: string) (rename_table: (string, string) Hashtbl.t) = + Hashtbl.add !rename_map function_name rename_table + +(*Returnes the rename if one exists, or param_name when no entry exists.*) +let get_local_rename (function_name: string) (param_name: string) = match (Hashtbl.find_opt !rename_map function_name) with + | Some (local_map) -> Option.value (Hashtbl.find_opt local_map param_name) ~default:param_name + | None -> param_name + let empty_change_info () : change_info = {added = []; removed = []; changed = []; unchanged = []} let should_reanalyze (fdec: Cil.fundec) = @@ -32,6 +42,12 @@ let should_reanalyze (fdec: Cil.fundec) = * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_context: method_context list) = + let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in + + List.combine a.slocals b.slocals |> + List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> + List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); + (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a context, holding the rename assumptions *) @@ -46,11 +62,8 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_cont let headerSizeEqual, headerContext = context_aware_compare a.sformals b.sformals [] in let actHeaderContext = (headerContext, global_context) in - Printf.printf "Header context=%s\n" (context_to_string actHeaderContext); let unchangedHeader = eq_varinfo a.svar b.svar actHeaderContext && GobList.equal (eq_varinfo2 actHeaderContext) a.sformals b.sformals in - let _ = Printf.printf "unchangedHeader=%b\n" unchangedHeader in - let _ = Printf.printf "part1=%b; part2=%b \n" (eq_varinfo a.svar b.svar actHeaderContext) (GobList.equal (eq_varinfo2 actHeaderContext) a.sformals b.sformals) in let identical, diffOpt = if should_reanalyze a then false, None @@ -69,7 +82,6 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_cont else match cfgs with | None -> - Printf.printf "Comparing blocks\n"; eq_block (a.sbody, a) (b.sbody, b) context, None | Some (cfgOld, cfgNew) -> Printf.printf "compareCIL.eqF: Compaing 2 cfgs now\n"; @@ -79,15 +91,15 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_cont if diffNodes1 = [] && diffNodes2 = [] then (true, None) else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1; primNewNodes = diffNodes2}) in + + if (identical) then store_local_rename a.svar.vname local_rename_map; + identical, unchangedHeader, diffOpt let eq_glob (a: global) (b: global) (cfgs : (cfg * cfg) option) (global_context: method_context list) = match a, b with | GFun (f,_), GFun (g,_) -> - let _ = Printf.printf "Comparing funs %s with %s\n" f.svar.vname g.svar.vname in let identical, unchangedHeader, diffOpt = eqF f g cfgs global_context in - let _ = Printf.printf "identical=%b; unchangedHeader=%b\n" identical unchangedHeader in - identical, unchangedHeader, diffOpt | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y ([], []), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y ([], []), false, None @@ -114,10 +126,10 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = else [] in if not (f.svar.vname = g.svar.vname) || (List.length renamed_params) > 0 then - Option.some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} - else Option.none - | _, _ -> Option.none - with Not_found -> Option.none + Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} + else None + | _, _ -> None + with Not_found -> None in let addGlobal map global = diff --git a/src/util/server.ml b/src/util/server.ml index 3c3cad9e60..dc7115b828 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -124,6 +124,7 @@ let virtual_changes file = let increment_data (s: t) file reparsed = match !Serialize.server_solver_data with | Some solver_data when reparsed -> + Printf.printf "Increment_data\n"; let _, changes = VersionLookup.updateMap s.file file s.version_map in let old_data = Some { Analyses.cil_file = s.file; solver_data } in s.max_ids <- UpdateCil.update_ids s.file s.max_ids file s.version_map changes; diff --git a/tests/incremental/04-var-rename/04-overwritten_var.c b/tests/incremental/04-var-rename/04-overwritten_var.c deleted file mode 100644 index 80956dea76..0000000000 --- a/tests/incremental/04-var-rename/04-overwritten_var.c +++ /dev/null @@ -1,9 +0,0 @@ -int main() { - int i = 0; - - for(int i = 0; i < 10; i++) { - - } - - return 0; -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/04-renamed_assert.c b/tests/incremental/04-var-rename/04-renamed_assert.c new file mode 100644 index 0000000000..55d83e7229 --- /dev/null +++ b/tests/incremental/04-var-rename/04-renamed_assert.c @@ -0,0 +1,7 @@ +int main() { + int myVar = 0; + + assert(myVar < 11); + + return 0; +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/04-renamed_assert.json b/tests/incremental/04-var-rename/04-renamed_assert.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/04-renamed_assert.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/04-renamed_assert.patch b/tests/incremental/04-var-rename/04-renamed_assert.patch new file mode 100644 index 0000000000..9644dcf6a1 --- /dev/null +++ b/tests/incremental/04-var-rename/04-renamed_assert.patch @@ -0,0 +1,13 @@ +--- tests/incremental/04-var-rename/04-renamed_assert.c ++++ tests/incremental/04-var-rename/04-renamed_assert.c +@@ -1,7 +1,7 @@ + int main() { +- int myVar = 0; ++ int myRenamedVar = 0; + +- assert(myVar < 11); ++ assert(myRenamedVar < 11); + + return 0; + } +\ Kein Zeilenumbruch am Dateiende. diff --git a/tests/incremental/04-var-rename/07-method_rename.c b/tests/incremental/04-var-rename/07-method_rename.c new file mode 100644 index 0000000000..84ce2d8621 --- /dev/null +++ b/tests/incremental/04-var-rename/07-method_rename.c @@ -0,0 +1,10 @@ +//Method is renamed with all of its usages. Test should say no changes. + +int foo() { + return 12; +} + +int main() { + foo(); + return 0; +} diff --git a/tests/incremental/04-var-rename/07-method_rename.json b/tests/incremental/04-var-rename/07-method_rename.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/07-method_rename.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/07-method_rename.patch b/tests/incremental/04-var-rename/07-method_rename.patch new file mode 100644 index 0000000000..e55d61e986 --- /dev/null +++ b/tests/incremental/04-var-rename/07-method_rename.patch @@ -0,0 +1,15 @@ +--- tests/incremental/04-var-rename/07-method_rename.c ++++ tests/incremental/04-var-rename/07-method_rename.c +@@ -1,10 +1,10 @@ + //Method is renamed with all of its usages. Test should say no changes. + +-int foo() { ++int bar() { + return 12; + } + + int main() { +- foo(); ++ bar(); + return 0; + } diff --git a/tests/incremental/04-var-rename/diffs/04-overwritten_var.c b/tests/incremental/04-var-rename/diffs/04-overwritten_var.c deleted file mode 100644 index 240bdbb8ad..0000000000 --- a/tests/incremental/04-var-rename/diffs/04-overwritten_var.c +++ /dev/null @@ -1,11 +0,0 @@ -int main() { - int i = 0; - - for(int a = 0; a < 10; a++) { - i++; - } - - assert(i < 11); - - return 0; -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c new file mode 100644 index 0000000000..8f74e36a13 --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c @@ -0,0 +1,7 @@ +int main() { + int j = 0; + + assert(j < 11); + + return 0; +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/07-method_rename.c b/tests/incremental/04-var-rename/diffs/07-method_rename.c new file mode 100644 index 0000000000..0d6c2aa9b9 --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/07-method_rename.c @@ -0,0 +1,10 @@ +//Method is renamed with all of its usages. Test should say no changes. + +int bar() { + return 12; +} + +int main() { + bar(); + return 0; +} diff --git a/tests/incremental/04-var-rename/test.c b/tests/incremental/04-var-rename/test.c new file mode 100644 index 0000000000..f51eb0d6f7 --- /dev/null +++ b/tests/incremental/04-var-rename/test.c @@ -0,0 +1,15 @@ +void foo() { + int i = 0; + + for(int i = 0; i < 10; i++); +} + +void bar() { + int i = 0; +} + +int main() { + foo(); + bar(); + return 0; +} \ No newline at end of file From d589278c780659e583205de0144f6da312aff7e2 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 19 Apr 2022 11:44:07 +0200 Subject: [PATCH 009/518] Added multiple incremental runs test --- scripts/test-incremental-multiple.sh | 36 +++++++++++++ src/analyses/base.ml | 8 +++ src/incremental/compareCIL.ml | 50 ++++++++++++++++--- .../04-var-rename/08-2_incremental_runs.json | 3 ++ .../04-var-rename/08-2_incremental_runs_1.c | 8 +++ .../08-2_incremental_runs_1.patch | 14 ++++++ .../04-var-rename/08-2_incremental_runs_2.c | 8 +++ .../08-2_incremental_runs_2.patch | 14 ++++++ .../04-var-rename/08-2_incremental_runs_3.c | 8 +++ .../04-var-rename/09-2_ir_with_changes.json | 3 ++ .../04-var-rename/09-2_ir_with_changes_1.c | 17 +++++++ .../09-2_ir_with_changes_1.patch | 22 ++++++++ .../04-var-rename/09-2_ir_with_changes_2.c | 17 +++++++ .../09-2_ir_with_changes_2.patch | 22 ++++++++ .../04-var-rename/09-2_ir_with_changes_3.c | 18 +++++++ 15 files changed, 240 insertions(+), 8 deletions(-) create mode 100644 scripts/test-incremental-multiple.sh create mode 100644 tests/incremental/04-var-rename/08-2_incremental_runs.json create mode 100644 tests/incremental/04-var-rename/08-2_incremental_runs_1.c create mode 100644 tests/incremental/04-var-rename/08-2_incremental_runs_1.patch create mode 100644 tests/incremental/04-var-rename/08-2_incremental_runs_2.c create mode 100644 tests/incremental/04-var-rename/08-2_incremental_runs_2.patch create mode 100644 tests/incremental/04-var-rename/08-2_incremental_runs_3.c create mode 100644 tests/incremental/04-var-rename/09-2_ir_with_changes.json create mode 100644 tests/incremental/04-var-rename/09-2_ir_with_changes_1.c create mode 100644 tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch create mode 100644 tests/incremental/04-var-rename/09-2_ir_with_changes_2.c create mode 100644 tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch create mode 100644 tests/incremental/04-var-rename/09-2_ir_with_changes_3.c diff --git a/scripts/test-incremental-multiple.sh b/scripts/test-incremental-multiple.sh new file mode 100644 index 0000000000..87b7e150ce --- /dev/null +++ b/scripts/test-incremental-multiple.sh @@ -0,0 +1,36 @@ +test=$1 + +base=./tests/incremental +source=$base/${test}_1.c +conf=$base/$test.json +patch1=$base/${test}_1.patch +patch2=$base/${test}_2.patch + +args="--enable dbg.debug --enable printstats -v" + +cat $source + +./goblint --conf $conf $args --enable incremental.save $source &> $base/$test.before.log --html + +patch -p0 -b <$patch1 + +cat $source + +./goblint --conf $conf $args --enable incremental.load --set save_run $base/$test-incrementalrun $source &> $base/$test.after.incr1.log --html + +patch -p0 <$patch2 + +cat $source + +./goblint --conf $conf $args --enable incremental.load --set save_run $base/$test-incrementalrun $source &> $base/$test.after.incr2.log --html + + +#./goblint --conf $conf $args --enable incremental.only-rename --set save_run $base/$test-originalrun $source &> $base/$test.after.scratch.log --html +#./goblint --conf $conf --enable solverdiffs --compare_runs $base/$test-originalrun $base/$test-incrementalrun $source --html + +patch -p0 -b -R <$patch2 +patch -p0 -b -R <$patch1 +# rm -r $base/$test-originalrun $base/$test-incrementalrun +rm -r $base/$test-incrementalrun + +cat $source diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 202a15c5ab..6e218bbfa0 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2015,6 +2015,14 @@ struct | _ -> [] let assert_fn ctx e should_warn change = + let _ = Hashtbl.iter (fun fun_name map -> + begin + Printf.printf "%s: [" fun_name; + Hashtbl.iter (fun from tox -> Printf.printf "%s -> %s; " from tox) map; + Printf.printf "]\n"; + end + ) !CompareCIL.rename_map in + let parent_function: fundec = Node.find_fundec ctx.node in (*Performs the actual rename on lvals for renamed local variables.*) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index b95c56694a..762d6fbac5 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -3,8 +3,12 @@ open MyCFG include CompareAST include CompareCFG +(*Maps the function name to a table of it's local variable and parameter renames. The rename table has key of original name and value of renamed name.*) let rename_map: (string, (string, string) Hashtbl.t) Hashtbl.t ref = ref (Hashtbl.create 100) +(*Same as rename_map, but maps renamed name to original name instead.*) +let reverse_rename_map: (string, (string, string) Hashtbl.t) Hashtbl.t ref = ref (Hashtbl.create 100) + type nodes_diff = { unchangedNodes: (node * node) list; primObsoleteNodes: node list; (** primary obsolete nodes -> all obsolete nodes are reachable from these *) @@ -26,13 +30,36 @@ type change_info = { } let store_local_rename (function_name: string) (rename_table: (string, string) Hashtbl.t) = - Hashtbl.add !rename_map function_name rename_table + begin + Hashtbl.add !rename_map function_name rename_table; + let reverse_rename_table = Hashtbl.create (Hashtbl.length !rename_map) in + Hashtbl.iter (fun original_name new_name -> Hashtbl.add reverse_rename_table new_name original_name) rename_table; + Hashtbl.add !reverse_rename_map function_name reverse_rename_table; + end (*Returnes the rename if one exists, or param_name when no entry exists.*) let get_local_rename (function_name: string) (param_name: string) = match (Hashtbl.find_opt !rename_map function_name) with | Some (local_map) -> Option.value (Hashtbl.find_opt local_map param_name) ~default:param_name | None -> param_name +let get_orignal_name (function_name: string) (new_var_name: string) = match (Hashtbl.find_opt !reverse_rename_map function_name) with + | Some (reverse_map) -> Option.value (Hashtbl.find_opt reverse_map new_var_name) ~default:new_var_name + |None -> new_var_name + +let show_rename_map = + let show_local_rename_map (local_rename_map: (string, string) Hashtbl.t) = + let rename_string = Seq.map (fun (orig, new_name) -> orig ^ " -> " ^ new_name) (Hashtbl.to_seq local_rename_map) |> + List.of_seq in + String.concat ", " rename_string + in + + Hashtbl.to_seq !rename_map |> + Seq.iter (fun (fun_name, map) -> Printf.printf "%s=%d" fun_name (Hashtbl.length map)); + + let function_strings = Seq.map (fun (fun_name, map) -> fun_name ^ ": [" ^ (show_local_rename_map map) ^ "]") (Hashtbl.to_seq !rename_map) |> List.of_seq in + + String.concat ", " function_strings + let empty_change_info () : change_info = {added = []; removed = []; changed = []; unchanged = []} let should_reanalyze (fdec: Cil.fundec) = @@ -44,9 +71,10 @@ let should_reanalyze (fdec: Cil.fundec) = let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_context: method_context list) = let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in - List.combine a.slocals b.slocals |> - List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> - List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); + if (List.length a.slocals) = (List.length b.slocals) then + List.combine a.slocals b.slocals |> + List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> + List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, @@ -146,14 +174,20 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let changes = empty_change_info () in global_typ_acc := []; - let checkUnchanged map global global_context = + let findChanges map global global_context = try let ident = identifier_of_global global in let old_global = GlobalMap.find ident map in (* Do a (recursive) equal comparison ignoring location information *) let identical, unchangedHeader, diff = eq old_global global cfgs global_context in - if identical - then changes.unchanged <- global :: changes.unchanged + if identical then + (*Rename*) + (*match global with + | GFun (fundec, _) -> fundec.slocals |> + List.iter (fun local -> local.vname <- get_orignal_name fundec.svar.vname local.vname); + | _ -> ();*) + + changes.unchanged <- global :: changes.unchanged else changes.changed <- {current = global; old = old_global; unchangedHeader; diff} :: changes.changed with Not_found -> () (* Global was no variable or function, it does not belong into the map *) in @@ -175,7 +209,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) Cil.iterGlobals newAST - (fun glob -> checkUnchanged oldMap glob global_context); + (fun glob -> findChanges oldMap glob global_context); (* We check whether functions have been added or removed *) Cil.iterGlobals newAST (fun glob -> if not (checkExists oldMap glob) then changes.added <- (glob::changes.added)); diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs.json b/tests/incremental/04-var-rename/08-2_incremental_runs.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/08-2_incremental_runs.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_1.c b/tests/incremental/04-var-rename/08-2_incremental_runs_1.c new file mode 100644 index 0000000000..d9b5afdd19 --- /dev/null +++ b/tests/incremental/04-var-rename/08-2_incremental_runs_1.c @@ -0,0 +1,8 @@ +int main() { + int varFirstIteration = 0; + + varFirstIteration++; + + assert(varFirstIteration < 10); + return 0; +} diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_1.patch b/tests/incremental/04-var-rename/08-2_incremental_runs_1.patch new file mode 100644 index 0000000000..191b335f3c --- /dev/null +++ b/tests/incremental/04-var-rename/08-2_incremental_runs_1.patch @@ -0,0 +1,14 @@ +--- tests/incremental/04-var-rename/08-2_incremental_runs_1.c ++++ tests/incremental/04-var-rename/08-2_incremental_runs_1.c +@@ -1,8 +1,8 @@ + int main() { +- int varFirstIteration = 0; ++ int varSecondIteration = 0; + +- varFirstIteration++; ++ varSecondIteration++; + +- assert(varFirstIteration < 10); ++ assert(varSecondIteration < 10); + return 0; + } diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_2.c b/tests/incremental/04-var-rename/08-2_incremental_runs_2.c new file mode 100644 index 0000000000..1190fdb14c --- /dev/null +++ b/tests/incremental/04-var-rename/08-2_incremental_runs_2.c @@ -0,0 +1,8 @@ +int main() { + int varSecondIteration = 0; + + varSecondIteration++; + + assert(varSecondIteration < 10); + return 0; +} diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_2.patch b/tests/incremental/04-var-rename/08-2_incremental_runs_2.patch new file mode 100644 index 0000000000..0952f3a4bf --- /dev/null +++ b/tests/incremental/04-var-rename/08-2_incremental_runs_2.patch @@ -0,0 +1,14 @@ +--- tests/incremental/04-var-rename/08-2_incremental_runs_1.c ++++ tests/incremental/04-var-rename/08-2_incremental_runs_1.c +@@ -1,8 +1,8 @@ + int main() { +- int varSecondIteration = 0; ++ int varThirdIteration = 0; + +- varSecondIteration++; ++ varThirdIteration++; + +- assert(varSecondIteration < 10); ++ assert(varThirdIteration < 10); + return 0; + } diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_3.c b/tests/incremental/04-var-rename/08-2_incremental_runs_3.c new file mode 100644 index 0000000000..9ff7105ebb --- /dev/null +++ b/tests/incremental/04-var-rename/08-2_incremental_runs_3.c @@ -0,0 +1,8 @@ +int main() { + int varThirdIteration = 0; + + varThirdIteration++; + + assert(varThirdIteration < 10); + return 0; +} diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes.json b/tests/incremental/04-var-rename/09-2_ir_with_changes.json new file mode 100644 index 0000000000..544b7b4ddd --- /dev/null +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes.json @@ -0,0 +1,3 @@ +{ + +} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_1.c b/tests/incremental/04-var-rename/09-2_ir_with_changes_1.c new file mode 100644 index 0000000000..535d3c21fc --- /dev/null +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes_1.c @@ -0,0 +1,17 @@ +void foo() { + int fooOne = 1; + fooOne++; + assert(fooOne == 2); +} + +void bar() { + int barOne = 10; + if (barOne < 11) barOne = 20; + assert(barOne == 20); +} + +int main() { + foo(); + bar(); + return 0; +} diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch b/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch new file mode 100644 index 0000000000..4f2d38927c --- /dev/null +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch @@ -0,0 +1,22 @@ +--- tests/incremental/04-var-rename/09-2_ir_with_changes_1.c ++++ tests/incremental/04-var-rename/09-2_ir_with_changes_1.c +@@ -1,13 +1,13 @@ + void foo() { +- int fooOne = 1; +- fooOne++; +- assert(fooOne == 2); ++ int fooTwo = 1; ++ fooTwo++; ++ assert(fooTwo == 2); + } + + void bar() { +- int barOne = 10; +- if (barOne < 11) barOne = 20; +- assert(barOne == 20); ++ int barTwo = 10; ++ if (barTwo < 11) barTwo = 20; ++ assert(barTwo == 20); + } + + int main() { diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.c b/tests/incremental/04-var-rename/09-2_ir_with_changes_2.c new file mode 100644 index 0000000000..6469a06781 --- /dev/null +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes_2.c @@ -0,0 +1,17 @@ +void foo() { + int fooTwo = 1; + fooTwo++; + assert(fooTwo == 2); +} + +void bar() { + int barTwo = 10; + if (barTwo < 11) barTwo = 20; + assert(barTwo == 20); +} + +int main() { + foo(); + bar(); + return 0; +} diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch b/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch new file mode 100644 index 0000000000..823bbd7a0e --- /dev/null +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch @@ -0,0 +1,22 @@ +--- tests/incremental/04-var-rename/09-2_ir_with_changes_1.c ++++ tests/incremental/04-var-rename/09-2_ir_with_changes_1.c +@@ -1,13 +1,14 @@ + void foo() { +- int fooTwo = 1; +- fooTwo++; +- assert(fooTwo == 2); ++ int fooThree = 1; ++ fooThree++; ++ assert(fooThree == 2); + } + + void bar() { + int barTwo = 10; +- if (barTwo < 11) barTwo = 20; +- assert(barTwo == 20); ++ int x = 3; ++ if (x < 11) barTwo = 13; ++ assert(x > 1); + } + + int main() { diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_3.c b/tests/incremental/04-var-rename/09-2_ir_with_changes_3.c new file mode 100644 index 0000000000..eaf77e72d1 --- /dev/null +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes_3.c @@ -0,0 +1,18 @@ +void foo() { + int fooThree = 1; + fooThree++; + assert(fooThree == 2); +} + +void bar() { + int barTwo = 10; + int x = 3; + if (x < 11) barTwo = 13; + assert(x > 1); +} + +int main() { + foo(); + bar(); + return 0; +} From 9eb3f875f9767424e20f627e725f1d33210ec615 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 20 Apr 2022 15:53:26 +0200 Subject: [PATCH 010/518] Renamed local vars are now also shown in g2html. --- src/cdomains/baseDomain.ml | 6 ++++-- src/framework/analyses.ml | 8 ++++++++ .../04-var-rename/09-2_ir_with_changes_1.patch | 7 ++++--- .../04-var-rename/09-2_ir_with_changes_2.c | 5 +++-- .../04-var-rename/09-2_ir_with_changes_2.patch | 11 +---------- 5 files changed, 20 insertions(+), 17 deletions(-) diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml index 472de2a66f..dc2b63a95f 100644 --- a/src/cdomains/baseDomain.ml +++ b/src/cdomains/baseDomain.ml @@ -108,9 +108,11 @@ struct ++ text ")" let printXml f r = + CPA.iter (fun key value -> key.vname <- (CompareCIL.get_local_rename (!Analyses.currentFunctionName) key.vname)) r.cpa; + let e = XmlUtil.escape in - BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n\n%s\n\n%a\n\n" - (e @@ CPA.name ()) CPA.printXml r.cpa + BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n\n%s\n\n%a\n\n" + (e @@ (CPA.name () ^ "ASSSSSSS")) CPA.printXml r.cpa (e @@ PartDeps.name ()) PartDeps.printXml r.deps (e @@ WeakUpdates.name ()) WeakUpdates.printXml r.weak (e @@ PrivD.name ()) PrivD.printXml r.priv diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index d6244d60e1..0d00ac672a 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -8,6 +8,8 @@ open GobConfig module GU = Goblintutil module M = Messages +let currentFunctionName: string ref = ref "" + (** Analysis starts from lists of functions: start functions, exit functions, and * other functions. *) type fundecs = fundec list * fundec list * fundec list @@ -150,6 +152,10 @@ struct (* Not using Node.location here to have updated locations in incremental analysis. See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) let loc = UpdateCil.getLoc n in + + let parentNode = Node.find_fundec n in + currentFunctionName.contents <- parentNode.svar.vname; + BatPrintf.fprintf f "\n" (Node.show_id n) loc.file loc.line loc.byte loc.column; BatPrintf.fprintf f "%a\n" Range.printXml v in @@ -185,6 +191,8 @@ struct match get_string "result" with | "pretty" -> ignore (fprintf out "%a\n" pretty (Lazy.force table)) | "fast_xml" -> + Printf.printf "%s" (Printexc.get_callstack 15 |> Printexc.raw_backtrace_to_string); + let module SH = BatHashtbl.Make (Basetype.RawStrings) in let file2funs = SH.create 100 in let funs2node = SH.create 100 in diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch b/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch index 4f2d38927c..c640034ea4 100644 --- a/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch @@ -1,6 +1,6 @@ --- tests/incremental/04-var-rename/09-2_ir_with_changes_1.c +++ tests/incremental/04-var-rename/09-2_ir_with_changes_1.c -@@ -1,13 +1,13 @@ +@@ -1,13 +1,14 @@ void foo() { - int fooOne = 1; - fooOne++; @@ -15,8 +15,9 @@ - if (barOne < 11) barOne = 20; - assert(barOne == 20); + int barTwo = 10; -+ if (barTwo < 11) barTwo = 20; -+ assert(barTwo == 20); ++ int x = 3; ++ if (x < 11) barTwo = 13; ++ assert(x > 1); } int main() { diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.c b/tests/incremental/04-var-rename/09-2_ir_with_changes_2.c index 6469a06781..6c4f789066 100644 --- a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.c +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes_2.c @@ -6,8 +6,9 @@ void foo() { void bar() { int barTwo = 10; - if (barTwo < 11) barTwo = 20; - assert(barTwo == 20); + int x = 3; + if (x < 11) barTwo = 13; + assert(x > 1); } int main() { diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch b/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch index 823bbd7a0e..ad44fd2303 100644 --- a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch +++ b/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch @@ -1,6 +1,6 @@ --- tests/incremental/04-var-rename/09-2_ir_with_changes_1.c +++ tests/incremental/04-var-rename/09-2_ir_with_changes_1.c -@@ -1,13 +1,14 @@ +@@ -1,7 +1,7 @@ void foo() { - int fooTwo = 1; - fooTwo++; @@ -11,12 +11,3 @@ } void bar() { - int barTwo = 10; -- if (barTwo < 11) barTwo = 20; -- assert(barTwo == 20); -+ int x = 3; -+ if (x < 11) barTwo = 13; -+ assert(x > 1); - } - - int main() { From d652715f577295a231ec8bcf7d7b6b5a365ace2b Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 3 May 2022 15:51:11 +0200 Subject: [PATCH 011/518] Added incremental aware print statements and replaced traditional print statements with those in many places --- src/analyses/base.ml | 91 +++++++++++++++++--------------- src/analyses/basePriv.ml | 12 ++--- src/cdomains/baseDomain.ml | 6 +-- src/cdomains/exp.ml | 2 +- src/cdomains/lval.ml | 4 +- src/framework/analyses.ml | 16 +++--- src/framework/constraints.ml | 6 +-- src/framework/edge.ml | 11 ++-- src/framework/node.ml | 16 +++--- src/incremental/compareAST.ml | 4 ++ src/incremental/compareCIL.ml | 39 +------------- src/incremental/renameMapping.ml | 62 ++++++++++++++++++++++ src/util/cilType.ml | 1 + src/util/cilfacade.ml | 4 +- 14 files changed, 155 insertions(+), 119 deletions(-) create mode 100644 src/incremental/renameMapping.ml diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 6e218bbfa0..65dff1a699 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -346,7 +346,7 @@ struct * which part of an array is involved. *) let rec get ?(full=false) a (gs: glob_fun) (st: store) (addrs:address) (exp:exp option): value = let at = AD.get_type addrs in - let firstvar = if M.tracing then match AD.to_var_may addrs with [] -> "" | x :: _ -> x.vname else "" in + let firstvar = if M.tracing then match AD.to_var_may addrs with [] -> "" | x :: _ -> RenameMapping.show_varinfo x else "" in if M.tracing then M.traceli "get" ~var:firstvar "Address: %a\nState: %a\n" AD.pretty addrs CPA.pretty st.cpa; (* Finding a single varinfo*offset pair *) let res = @@ -576,7 +576,7 @@ struct (* The evaluation function as mutually recursive eval_lv & eval_rv *) let rec eval_rv (a: Q.ask) (gs:glob_fun) (st: store) (exp:exp): value = - if M.tracing then M.traceli "evalint" "base eval_rv %a\n" d_exp exp; + if M.tracing then M.traceli "evalint" "base eval_rv %a\n" RenameMapping.d_exp exp; let r = (* we have a special expression that should evaluate to top ... *) if exp = MyCFG.unknown_exp then @@ -584,7 +584,7 @@ struct else eval_rv_ask_evalint a gs st exp in - if M.tracing then M.traceu "evalint" "base eval_rv %a -> %a\n" d_exp exp VD.pretty r; + if M.tracing then M.traceu "evalint" "base eval_rv %a -> %a\n" RenameMapping.d_exp exp VD.pretty r; r (** Evaluate expression using EvalInt query. @@ -593,13 +593,13 @@ struct Non-integer expression just delegate to next eval_rv function. *) and eval_rv_ask_evalint a gs st exp = let eval_next () = eval_rv_no_ask_evalint a gs st exp in - if M.tracing then M.traceli "evalint" "base eval_rv_ask_evalint %a\n" d_exp exp; + if M.tracing then M.traceli "evalint" "base eval_rv_ask_evalint %a\n" RenameMapping.d_exp exp; let r = match Cilfacade.typeOf exp with | typ when Cil.isIntegralType typ && not (Cil.isConstant exp) -> (* don't EvalInt integer constants, base can do them precisely itself *) - if M.tracing then M.traceli "evalint" "base ask EvalInt %a\n" d_exp exp; + if M.tracing then M.traceli "evalint" "base ask EvalInt %a\n" RenameMapping.d_exp exp; let a = a.f (Q.EvalInt exp) in (* through queries includes eval_next, so no (exponential) branching is necessary *) - if M.tracing then M.traceu "evalint" "base ask EvalInt %a -> %a\n" d_exp exp Queries.ID.pretty a; + if M.tracing then M.traceu "evalint" "base ask EvalInt %a -> %a\n" RenameMapping.d_exp exp Queries.ID.pretty a; begin match a with | `Bot -> eval_next () (* Base EvalInt returns bot on incorrect type (e.g. pthread_t); ignore and continue. *) (* | x -> Some (`Int x) *) @@ -609,7 +609,7 @@ struct | exception Cilfacade.TypeOfError _ (* Bug: typeOffset: Field on a non-compound *) | _ -> eval_next () in - if M.tracing then M.traceu "evalint" "base eval_rv_ask_evalint %a -> %a\n" d_exp exp VD.pretty r; + if M.tracing then M.traceu "evalint" "base eval_rv_ask_evalint %a -> %a\n" RenameMapping.d_exp exp VD.pretty r; r (** Evaluate expression without EvalInt query on outermost expression. @@ -622,11 +622,11 @@ struct Otherwise just delegate to next eval_rv function. *) and eval_rv_ask_mustbeequal a gs st exp = let eval_next () = eval_rv_base a gs st exp in - if M.tracing then M.traceli "evalint" "base eval_rv_ask_mustbeequal %a\n" d_exp exp; + if M.tracing then M.traceli "evalint" "base eval_rv_ask_mustbeequal %a\n" RenameMapping.d_exp exp; let binop op e1 e2 = let must_be_equal () = let r = a.f (Q.MustBeEqual (e1, e2)) in - if M.tracing then M.tracel "query" "MustBeEqual (%a, %a) = %b\n" d_exp e1 d_exp e2 r; + if M.tracing then M.tracel "query" "MustBeEqual (%a, %a) = %b\n" RenameMapping.d_exp e1 RenameMapping.d_exp e2 r; r in match op with @@ -654,14 +654,14 @@ struct | BinOp (op,arg1,arg2,_) -> binop op arg1 arg2 | _ -> eval_next () in - if M.tracing then M.traceu "evalint" "base eval_rv_ask_mustbeequal %a -> %a\n" d_exp exp VD.pretty r; + if M.tracing then M.traceu "evalint" "base eval_rv_ask_mustbeequal %a -> %a\n" RenameMapping.d_exp exp VD.pretty r; r (** Evaluate expression structurally by base. This handles constants directly and variables using CPA. Subexpressions delegate to [eval_rv], which may use queries on them. *) and eval_rv_base (a: Q.ask) (gs:glob_fun) (st: store) (exp:exp): value = - if M.tracing then M.traceli "evalint" "base eval_rv_base %a\n" d_exp exp; + if M.tracing then M.traceli "evalint" "base eval_rv_base %a\n" RenameMapping.d_exp exp; let rec do_offs def = function (* for types that only have one value *) | Field (fd, offs) -> begin match Goblintutil.is_blessed (TComp (fd.fcomp, [])) with @@ -741,7 +741,7 @@ struct let te2 = Cilfacade.typeOf e2 in let both_arith_type = isArithmeticType te1 && isArithmeticType te2 in let is_safe = (VD.equal a1 a2 || VD.is_safe_cast t1 te1 && VD.is_safe_cast t2 te2) && not both_arith_type in - M.tracel "cast" "remove cast on both sides for %a? -> %b\n" d_exp exp is_safe; + M.tracel "cast" "remove cast on both sides for %a? -> %b\n" RenameMapping.d_exp exp is_safe; if is_safe then ( (* we can ignore the casts if the values are equal anyway, or if the casts can't change the value *) let e1 = if isArithmeticType te1 then c1 else e1 in let e2 = if isArithmeticType te2 then c2 else e2 in @@ -779,7 +779,7 @@ struct VD.cast ~torg:(Cilfacade.typeOf exp) t v | _ -> VD.top () in - if M.tracing then M.traceu "evalint" "base eval_rv_base %a -> %a\n" d_exp exp VD.pretty r; + if M.tracing then M.traceu "evalint" "base eval_rv_base %a -> %a\n" RenameMapping.d_exp exp VD.pretty r; r (* A hackish evaluation of expressions that should immediately yield an * address, e.g. when calling functions. *) @@ -857,20 +857,20 @@ struct let eval_rv (a: Q.ask) (gs:glob_fun) (st: store) (exp:exp): value = try let r = eval_rv a gs st exp in - if M.tracing then M.tracel "eval" "eval_rv %a = %a\n" d_exp exp VD.pretty r; + if M.tracing then M.tracel "eval" "eval_rv %a = %a\n" RenameMapping.d_exp exp VD.pretty r; if VD.is_bot r then VD.top_value (Cilfacade.typeOf exp) else r with IntDomain.ArithmeticOnIntegerBot _ -> ValueDomain.Compound.top_value (Cilfacade.typeOf exp) let query_evalint ask gs st e = - if M.tracing then M.traceli "evalint" "base query_evalint %a\n" d_exp e; + if M.tracing then M.traceli "evalint" "base query_evalint %a\n" RenameMapping.d_exp e; let r = match eval_rv_no_ask_evalint ask gs st e with | `Int i -> `Lifted i (* cast should be unnecessary, eval_rv should guarantee right ikind already *) | `Bot -> Queries.ID.bot () (* TODO: remove? *) (* | v -> M.warn ("Query function answered " ^ (VD.show v)); Queries.Result.top q *) - | v -> M.debug ~category:Analyzer "Base EvalInt %a query answering bot instead of %a" d_exp e VD.pretty v; Queries.ID.bot () + | v -> M.debug ~category:Analyzer "Base EvalInt %a query answering bot instead of %a" RenameMapping.d_exp e VD.pretty v; Queries.ID.bot () in - if M.tracing then M.traceu "evalint" "base query_evalint %a -> %a\n" d_exp e Queries.ID.pretty r; + if M.tracing then M.traceu "evalint" "base query_evalint %a -> %a\n" RenameMapping.d_exp e Queries.ID.pretty r; r (* Evaluate an expression containing only locals. This is needed for smart joining the partitioned arrays where ctx is not accessible. *) @@ -892,12 +892,12 @@ struct try let fp = eval_fv (Analyses.ask_of_ctx ctx) ctx.global ctx.local fval in if AD.mem Addr.UnknownPtr fp then begin - M.warn "Function pointer %a may contain unknown functions." d_exp fval; + M.warn "Function pointer %a may contain unknown functions." RenameMapping.d_exp fval; dummyFunDec.svar :: AD.to_var_may fp end else AD.to_var_may fp with SetDomain.Unsupported _ -> - M.warn "Unknown call to function %a." d_exp fval; + M.warn "Unknown call to function %a." RenameMapping.d_exp fval; [dummyFunDec.svar] (** Evaluate expression as address. @@ -1000,7 +1000,7 @@ struct (* check if we have an array of chars that form a string *) (* TODO return may-points-to-set of strings *) | `Address a when List.compare_length_with (AD.to_string a) 1 > 0 -> (* oh oh *) - M.debug "EvalStr (%a) returned %a" d_exp e AD.pretty a; + M.debug "EvalStr (%a) returned %a" RenameMapping.d_exp e AD.pretty a; Queries.Result.top q | `Address a when List.compare_length_with (AD.to_var_may a) 1 = 0 -> (* some other address *) (* Cil.varinfo * (AD.Addr.field, AD.Addr.idx) Lval.offs *) @@ -1101,12 +1101,14 @@ struct * precise information about arrays. *) let set (a: Q.ask) ?(ctx=None) ?(invariant=false) ?lval_raw ?rval_raw ?t_override (gs:glob_fun) (st: store) (lval: AD.t) (lval_type: Cil.typ) (value: value) : store = let update_variable x t y z = - if M.tracing then M.tracel "setosek" ~var:x.vname "update_variable: start '%s' '%a'\nto\n%a\n\n" x.vname VD.pretty y CPA.pretty z; + let x_vname = RenameMapping.show_varinfo x in + + if M.tracing then M.tracel "setosek" ~var:x_vname "update_variable: start '%s' '%a'\nto\n%a\n\n" x_vname VD.pretty y CPA.pretty z; let r = update_variable x t y z in (* refers to defintion that is outside of set *) - if M.tracing then M.tracel "setosek" ~var:x.vname "update_variable: start '%s' '%a'\nto\n%a\nresults in\n%a\n" x.vname VD.pretty y CPA.pretty z CPA.pretty r; + if M.tracing then M.tracel "setosek" ~var:x_vname "update_variable: start '%s' '%a'\nto\n%a\nresults in\n%a\n" x_vname VD.pretty y CPA.pretty z CPA.pretty r; r in - let firstvar = if M.tracing then match AD.to_var_may lval with [] -> "" | x :: _ -> x.vname else "" in + let firstvar = if M.tracing then match AD.to_var_may lval with [] -> "" | x :: _ -> RenameMapping.show_varinfo x else "" in let lval_raw = (Option.map (fun x -> Lval x) lval_raw) in if M.tracing then M.tracel "set" ~var:firstvar "lval: %a\nvalue: %a\nstate: %a\n" AD.pretty lval VD.pretty value CPA.pretty st.cpa; (* Updating a single varinfo*offset pair. NB! This function's type does @@ -1150,10 +1152,12 @@ struct if M.tracing then M.tracel "setosek" ~var:firstvar "update_one_addr: BAD? exp.globs_are_top is set \n"; { st with cpa = CPA.add x `Top st.cpa } end else + let x_vname = RenameMapping.show_varinfo x in + (* Check if we need to side-effect this one. We no longer generate * side-effects here, but the code still distinguishes these cases. *) if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then begin - if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: update a global var '%s' ...\n" x.vname; + if M.tracing then M.tracel "setosek" ~var:x_vname "update_one_addr: update a global var '%s' ...\n" x_vname; let priv_getg = priv_getg gs in (* Optimization to avoid evaluating integer values when setting them. The case when invariant = true requires the old_value to be sound for the meet. @@ -1165,10 +1169,10 @@ struct in let new_value = update_offset old_value in let r = Priv.write_global ~invariant a priv_getg (priv_sideg (Option.get ctx).sideg) st x new_value in - if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: updated a global var '%s' \nstate:%a\n\n" x.vname D.pretty r; + if M.tracing then M.tracel "setosek" ~var:x_vname "update_one_addr: updated a global var '%s' \nstate:%a\n\n" x_vname D.pretty r; r end else begin - if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: update a local var '%s' ...\n" x.vname; + if M.tracing then M.tracel "setosek" ~var:x_vname "update_one_addr: update a local var '%s' ...\n" x_vname; (* Normal update of the local state *) let new_value = update_offset (CPA.find x st.cpa) in (* what effect does changing this local variable have on arrays - @@ -1376,7 +1380,7 @@ struct if M.tracing then M.trace "invariant" "Failed! (operation not supported)\n\n"; None in - if M.tracing then M.traceli "invariant" "assume expression %a is %B\n" d_exp exp tv; + if M.tracing then M.traceli "invariant" "assume expression %a is %B\n" RenameMapping.d_exp exp tv; let null_val typ = match Cil.unrollType typ with | TPtr _ -> `Address AD.null_ptr @@ -1598,12 +1602,12 @@ struct | BinOp(op, CastE (t1, c1), CastE (t2, c2), t) when (op = Eq || op = Ne) && typeSig (Cilfacade.typeOf c1) = typeSig (Cilfacade.typeOf c2) && VD.is_safe_cast t1 (Cilfacade.typeOf c1) && VD.is_safe_cast t2 (Cilfacade.typeOf c2) -> inv_exp c (BinOp (op, c1, c2, t)) st | BinOp (op, e1, e2, _) as e -> - if M.tracing then M.tracel "inv" "binop %a with %a %a %a == %a\n" d_exp e VD.pretty (eval e1 st) d_binop op VD.pretty (eval e2 st) ID.pretty c; + if M.tracing then M.tracel "inv" "binop %a with %a %a %a == %a\n" RenameMapping.d_exp e VD.pretty (eval e1 st) d_binop op VD.pretty (eval e2 st) ID.pretty c; (match eval e1 st, eval e2 st with | `Int a, `Int b -> let ikind = Cilfacade.get_ikind_exp e1 in (* both operands have the same type (except for Shiftlt, Shiftrt)! *) let a', b' = inv_bin_int (a, b) ikind c op in - if M.tracing then M.tracel "inv" "binop: %a, a': %a, b': %a\n" d_exp e ID.pretty a' ID.pretty b'; + if M.tracing then M.tracel "inv" "binop: %a, a': %a, b': %a\n" RenameMapping.d_exp e ID.pretty a' ID.pretty b'; let st' = inv_exp a' e1 st in let st'' = inv_exp b' e2 st' in st'' @@ -1788,23 +1792,23 @@ struct let valu = eval_rv (Analyses.ask_of_ctx ctx) ctx.global ctx.local exp in let refine () = let res = invariant ctx (Analyses.ask_of_ctx ctx) ctx.global ctx.local exp tv in - if M.tracing then M.tracec "branch" "EqualSet result for expression %a is %a\n" d_exp exp Queries.ES.pretty (ctx.ask (Queries.EqualSet exp)); - if M.tracing then M.tracec "branch" "CondVars result for expression %a is %a\n" d_exp exp Queries.ES.pretty (ctx.ask (Queries.CondVars exp)); + if M.tracing then M.tracec "branch" "EqualSet result for expression %a is %a\n" RenameMapping.d_exp exp Queries.ES.pretty (ctx.ask (Queries.EqualSet exp)); + if M.tracing then M.tracec "branch" "CondVars result for expression %a is %a\n" RenameMapping.d_exp exp Queries.ES.pretty (ctx.ask (Queries.CondVars exp)); if M.tracing then M.traceu "branch" "Invariant enforced!\n"; match ctx.ask (Queries.CondVars exp) with | s when Queries.ES.cardinal s = 1 -> let e = Queries.ES.choose s in - M.debug "CondVars result for expression %a is %a" d_exp exp d_exp e; + M.debug "CondVars result for expression %a is %a" RenameMapping.d_exp exp RenameMapping.d_exp e; invariant ctx (Analyses.ask_of_ctx ctx) ctx.global res e tv | _ -> res in - if M.tracing then M.traceli "branch" ~subsys:["invariant"] "Evaluating branch for expression %a with value %a\n" d_exp exp VD.pretty valu; - if M.tracing then M.tracel "branchosek" "Evaluating branch for expression %a with value %a\n" d_exp exp VD.pretty valu; + if M.tracing then M.traceli "branch" ~subsys:["invariant"] "Evaluating branch for expression %a with value %a\n" RenameMapping.d_exp exp VD.pretty valu; + if M.tracing then M.tracel "branchosek" "Evaluating branch for expression %a with value %a\n" RenameMapping.d_exp exp VD.pretty valu; (* First we want to see, if we can determine a dead branch: *) match valu with (* For a boolean value: *) | `Int value when (ID.is_bool value) -> - if M.tracing then M.traceu "branch" "Expression %a evaluated to %a\n" d_exp exp ID.pretty value; + if M.tracing then M.traceu "branch" "Expression %a evaluated to %a\n" RenameMapping.d_exp exp ID.pretty value; (* to suppress pattern matching warnings: *) let fromJust x = match x with Some x -> x | None -> assert false in let v = fromJust (ID.to_bool value) in @@ -1980,7 +1984,7 @@ struct in Some (lval, v, args) else ( - M.debug ~category:Analyzer "Not creating a thread from %s because its type is %a" v.vname d_type v.vtype; + M.debug ~category:Analyzer "Not creating a thread from %s because its type is %a" (RenameMapping.show_varinfo v) d_type v.vtype; None ) in @@ -2015,6 +2019,7 @@ struct | _ -> [] let assert_fn ctx e should_warn change = + (* let _ = Hashtbl.iter (fun fun_name map -> begin Printf.printf "%s: [" fun_name; @@ -2052,6 +2057,7 @@ struct (*TODO: AddrOfLabel?*) | _ -> exp in + *) let check_assert e st = @@ -2065,7 +2071,7 @@ struct | `Bot -> `Bot | _ -> `Top in - let expr = sprint d_exp (rename_exp e) in + let expr = sprint RenameMapping.d_exp e in let warn warn_fn ?annot msg = if should_warn then if get_bool "dbg.regression" then ( (* This only prints unexpected results (with the difference) as indicated by the comment behind the assert (same as used by the regression test script). *) let loc = !M.current_loc in @@ -2104,7 +2110,7 @@ struct end let special_unknown_invalidate ctx ask gs st f args = - (if not (CilType.Varinfo.equal f dummyFunDec.svar) && not (LF.use_special f.vname) then M.error ~category:Imprecise ~tags:[Category Unsound] "Function definition missing for %s" f.vname); + (if not (CilType.Varinfo.equal f dummyFunDec.svar) && not (LF.use_special f.vname) then M.error ~category:Imprecise ~tags:[Category Unsound] "Function definition missing for %s" (RenameMapping.show_varinfo f)); (if CilType.Varinfo.equal f dummyFunDec.svar then M.warn "Unknown function ptr called"); let addrs = if get_bool "sem.unknown_function.invalidate.globals" then ( @@ -2125,17 +2131,16 @@ struct invalidate ~ctx (Analyses.ask_of_ctx ctx) gs st addrs let special ctx (lv:lval option) (f: varinfo) (args: exp list) = - Printf.printf "special: varinfo=%s\n" f.vname; - List.iter (fun x -> ignore @@ Pretty.printf "%a\n" Cil.d_exp x;) args; + List.iter (fun x -> ignore @@ Pretty.printf "%a\n" RenameMapping.d_exp x;) args; let invalidate_ret_lv st = match lv with | Some lv -> - if M.tracing then M.tracel "invalidate" "Invalidating lhs %a for function call %s\n" d_plainlval lv f.vname; + if M.tracing then M.tracel "invalidate" "Invalidating lhs %a for function call %s\n" d_plainlval lv (RenameMapping.show_varinfo f); invalidate ~ctx (Analyses.ask_of_ctx ctx) ctx.global st [Cil.mkAddrOrStartOf lv] | None -> st in let forks = forkfun ctx lv f args in - if M.tracing then if not (List.is_empty forks) then M.tracel "spawn" "Base.special %s: spawning functions %a\n" f.vname (d_list "," d_varinfo) (List.map BatTuple.Tuple3.second forks); + if M.tracing then if not (List.is_empty forks) then M.tracel "spawn" "Base.special %s: spawning functions %a\n" (RenameMapping.show_varinfo f) (d_list "," d_varinfo) (List.map BatTuple.Tuple3.second forks); List.iter (BatTuple.Tuple3.uncurry ctx.spawn) forks; let st: store = ctx.local in let gs = ctx.global in @@ -2379,7 +2384,7 @@ struct | _, v -> VD.show v in let args_short = List.map short_fun f.sformals in - Printable.get_short_list (f.svar.vname ^ "(") ")" args_short + Printable.get_short_list (RenameMapping.show_varinfo f.svar ^ "(") ")" args_short let threadenter ctx (lval: lval option) (f: varinfo) (args: exp list): D.t list = match Cilfacade.find_varinfo_fundec f with diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 7d8d7179f2..e0c5cec32e 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -94,7 +94,7 @@ struct let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = if invariant && not (is_private ask x) then ( - if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant); + if M.tracing then M.tracel "setosek" ~var:(RenameMapping.show_varinfo x) "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant); st ) else ( @@ -110,7 +110,7 @@ struct let sync ask getg sideg (st: BaseComponents (D).t) reason = (* For each global variable, we create the side effect *) let side_var (v: varinfo) (value) (st: BaseComponents (D).t) = - if M.tracing then M.traceli "globalize" ~var:v.vname "Tracing for %s\n" v.vname; + if M.tracing then M.traceli "globalize" ~var:(RenameMapping.show_varinfo v) "Tracing for %s\n" (RenameMapping.show_varinfo v); let res = if is_global ask v then begin if M.tracing then M.tracec "globalize" "Publishing its value: %a\n" VD.pretty value; @@ -151,7 +151,7 @@ struct let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = if invariant && not (is_private ask x) then ( - if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant); + if M.tracing then M.tracel "setosek" ~var:(RenameMapping.show_varinfo x) "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant); st ) else ( @@ -170,7 +170,7 @@ struct if M.tracing then M.tracel "sync" "OldPriv: %a\n" BaseComponents.pretty st; (* For each global variable, we create the side effect *) let side_var (v: varinfo) (value) (st: BaseComponents.t) = - if M.tracing then M.traceli "globalize" ~var:v.vname "Tracing for %s\n" v.vname; + if M.tracing then M.traceli "globalize" ~var:(RenameMapping.show_varinfo v) "Tracing for %s\n" (RenameMapping.show_varinfo v); let res = if is_global ask v && ((privates && not (is_precious_glob v)) || not (is_private ask v)) then begin if M.tracing then M.tracec "globalize" "Publishing its value: %a\n" VD.pretty value; @@ -427,7 +427,7 @@ struct let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = if invariant && not (is_private ask x) then ( - if M.tracing then M.tracel "setosek" ~var:x.vname "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant); + if M.tracing then M.tracel "setosek" ~var:(RenameMapping.show_varinfo x) "update_one_addr: BAD! effect = '%B', or else is private! \n" (not invariant); st ) else ( @@ -448,7 +448,7 @@ struct let privates = sync_privates reason ask in (* For each global variable, we create the side effect *) let side_var (v: varinfo) (value) (st: BaseComponents (D).t) = - if M.tracing then M.traceli "globalize" ~var:v.vname "Tracing for %s\n" v.vname; + if M.tracing then M.traceli "globalize" ~var:(RenameMapping.show_varinfo v) "Tracing for %s\n" (RenameMapping.show_varinfo v); let res = if is_global ask v then let protected = is_protected ask v in diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml index dc2b63a95f..472de2a66f 100644 --- a/src/cdomains/baseDomain.ml +++ b/src/cdomains/baseDomain.ml @@ -108,11 +108,9 @@ struct ++ text ")" let printXml f r = - CPA.iter (fun key value -> key.vname <- (CompareCIL.get_local_rename (!Analyses.currentFunctionName) key.vname)) r.cpa; - let e = XmlUtil.escape in - BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n\n%s\n\n%a\n\n" - (e @@ (CPA.name () ^ "ASSSSSSS")) CPA.printXml r.cpa + BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n\n%s\n\n%a\n\n" + (e @@ CPA.name ()) CPA.printXml r.cpa (e @@ PartDeps.name ()) PartDeps.printXml r.deps (e @@ WeakUpdates.name ()) WeakUpdates.printXml r.weak (e @@ PrivD.name ()) PrivD.printXml r.priv diff --git a/src/cdomains/exp.ml b/src/cdomains/exp.ml index 35c585f8ef..1ff23b5448 100644 --- a/src/cdomains/exp.ml +++ b/src/cdomains/exp.ml @@ -260,7 +260,7 @@ struct let ee_to_str x = match x with - | EVar v -> v.vname + | EVar v -> RenameMapping.show_varinfo v | EAddr -> "&" | EDeref -> "*" | EField f -> f.fname diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index c7037594c5..74d467777b 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -220,8 +220,8 @@ struct let short_addr (x, o) = if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo x then let description = RichVarinfo.BiVarinfoMap.Collection.describe_varinfo x in - "(" ^ x.vname ^ ", " ^ description ^ ")" ^ short_offs o - else x.vname ^ short_offs o + "(" ^ RenameMapping.show_varinfo x ^ ", " ^ description ^ ")" ^ short_offs o + else RenameMapping.show_varinfo x ^ short_offs o let show = function | Addr (x, o)-> short_addr (x, o) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 0d00ac672a..21d015c512 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -37,7 +37,7 @@ struct let printXml f n = let l = Node.location n in - BatPrintf.fprintf f "\n" (Node.show_id n) l.file (Node.find_fundec n).svar.vname l.line l.byte l.column + BatPrintf.fprintf f "\n" (Node.show_id n) l.file (RenameMapping.show_varinfo (Node.find_fundec n).svar) l.line l.byte l.column let var_id = Node.show_id let node n = n @@ -117,7 +117,7 @@ struct See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) let x = UpdateCil.getLoc a in let f = Node.find_fundec a in - CilType.Location.show x ^ "(" ^ f.svar.vname ^ ")" + CilType.Location.show x ^ "(" ^ RenameMapping.show_varinfo f.svar ^ ")" include Printable.SimpleShow ( struct @@ -154,7 +154,7 @@ struct let loc = UpdateCil.getLoc n in let parentNode = Node.find_fundec n in - currentFunctionName.contents <- parentNode.svar.vname; + currentFunctionName.contents <- RenameMapping.show_varinfo parentNode.svar; BatPrintf.fprintf f "\n" (Node.show_id n) loc.file loc.line loc.byte loc.column; BatPrintf.fprintf f "%a\n" Range.printXml v @@ -196,9 +196,9 @@ struct let module SH = BatHashtbl.Make (Basetype.RawStrings) in let file2funs = SH.create 100 in let funs2node = SH.create 100 in - iter (fun n _ -> SH.add funs2node (Node.find_fundec n).svar.vname n) (Lazy.force table); + iter (fun n _ -> SH.add funs2node (RenameMapping.show_varinfo (Node.find_fundec n).svar) n) (Lazy.force table); iterGlobals file (function - | GFun (fd,loc) -> SH.add file2funs loc.file fd.svar.vname + | GFun (fd,loc) -> SH.add file2funs loc.file (RenameMapping.show_varinfo fd.svar) | _ -> () ); let p_node f n = BatPrintf.fprintf f "%s" (Node.show_id n) in @@ -244,9 +244,9 @@ struct let module SH = BatHashtbl.Make (Basetype.RawStrings) in let file2funs = SH.create 100 in let funs2node = SH.create 100 in - iter (fun n _ -> SH.add funs2node (Node.find_fundec n).svar.vname n) (Lazy.force table); + iter (fun n _ -> SH.add funs2node (RenameMapping.show_varinfo (Node.find_fundec n).svar) n) (Lazy.force table); iterGlobals file (function - | GFun (fd,loc) -> SH.add file2funs loc.file fd.svar.vname + | GFun (fd,loc) -> SH.add file2funs loc.file (RenameMapping.show_varinfo fd.svar) | _ -> () ); let p_enum p f xs = BatEnum.print ~first:"[\n " ~last:"\n]" ~sep:",\n " p f xs in @@ -547,7 +547,7 @@ struct your analysis to be path sensitive, do override this. To obtain a behavior where all paths are kept apart, set this to D.equal x y *) - let call_descr f _ = f.svar.vname + let call_descr f _ = RenameMapping.show_varinfo f.svar (* prettier name for equation variables --- currently base can do this and MCP just forwards it to Base.*) diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index ed3acc309f..53b3897039 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -371,7 +371,7 @@ struct if ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.context.widen" ~keepAttr:"widen" ~removeAttr:"no-widen" f then ( let v_old = M.find f.svar m in (* S.D.bot () if not found *) let v_new = S.D.widen v_old (S.D.join v_old v_cur) in - Messages.(if tracing && not (S.D.equal v_old v_new) then tracel "widen-context" "enter results in new context for function %s\n" f.svar.vname); + Messages.(if tracing && not (S.D.equal v_old v_new) then tracel "widen-context" "enter results in new context for function %s\n" (RenameMapping.show_varinfo f.svar)); v_new, M.add f.svar v_new m ) else @@ -512,7 +512,7 @@ struct ignore (getl (Function fd, c)) | exception Not_found -> (* unknown function *) - M.error ~category:Imprecise ~tags:[Category Unsound] "Created a thread from unknown function %s" f.vname + M.error ~category:Imprecise ~tags:[Category Unsound] "Created a thread from unknown function %s" (RenameMapping.show_varinfo f) (* actual implementation (e.g. invalidation) is done by threadenter *) ) ds in @@ -646,7 +646,7 @@ struct let one_function f = match Cilfacade.find_varinfo_fundec f with | fd when LibraryFunctions.use_special f.vname -> - M.warn "Using special for defined function %s" f.vname; + M.warn "Using special for defined function %s" (RenameMapping.show_varinfo f); tf_special_call ctx lv f args | fd -> tf_normal_call ctx lv e fd args getl sidel getg sideg diff --git a/src/framework/edge.ml b/src/framework/edge.ml index 0118eabb09..376934510b 100644 --- a/src/framework/edge.ml +++ b/src/framework/edge.ml @@ -33,6 +33,7 @@ type t = (** This for interrupt edges.! *) [@@deriving eq, to_yojson] +let dn_exp = RenameMapping.dn_exp let pretty () = function | Test (exp, b) -> if b then Pretty.dprintf "Pos(%a)" dn_exp exp else Pretty.dprintf "Neg(%a)" dn_exp exp @@ -47,15 +48,17 @@ let pretty () = function | VDecl v -> Cil.defaultCilPrinter#pVDecl () v | SelfLoop -> Pretty.text "SelfLoop" +let d_exp = RenameMapping.d_exp + let pretty_plain () = function | Assign (lv,rv) -> dprintf "Assign '%a = %a' " d_lval lv d_exp rv | Proc (None ,f,ars) -> dprintf "Proc '%a(%a)'" d_exp f (d_list ", " d_exp) ars | Proc (Some r,f,ars) -> dprintf "Proc '%a = %a(%a)'" d_lval r d_exp f (d_list ", " d_exp) ars - | Entry f -> dprintf "Entry %s" f.svar.vname - | Ret (None,fd) -> dprintf "Ret (None, %s)" fd.svar.vname - | Ret (Some r,fd) -> dprintf "Ret (Some %a, %s)" d_exp r fd.svar.vname + | Entry f -> dprintf "Entry %s" (RenameMapping.show_varinfo f.svar) + | Ret (None,fd) -> dprintf "Ret (None, %s)" (RenameMapping.show_varinfo fd.svar) + | Ret (Some r,fd) -> dprintf "Ret (Some %a, %s)" d_exp r (RenameMapping.show_varinfo fd.svar) | Test (p,b) -> dprintf "Test (%a,%b)" d_exp p b | ASM _ -> text "ASM ..." | Skip -> text "Skip" - | VDecl v -> dprintf "VDecl '%a %s;'" d_type v.vtype v.vname + | VDecl v -> dprintf "VDecl '%a %s;'" d_type v.vtype (RenameMapping.show_varinfo v) | SelfLoop -> text "SelfLoop" diff --git a/src/framework/node.ml b/src/framework/node.ml index 1d5a8291f9..cc1d32a018 100644 --- a/src/framework/node.ml +++ b/src/framework/node.ml @@ -22,21 +22,21 @@ let name () = "node" (** Pretty node plainly with entire stmt. *) let pretty_plain () = function | Statement s -> text "Statement " ++ dn_stmt () s - | Function f -> text "Function " ++ text f.svar.vname - | FunctionEntry f -> text "FunctionEntry " ++ text f.svar.vname + | Function f -> text "Function " ++ text (RenameMapping.show_varinfo f.svar) + | FunctionEntry f -> text "FunctionEntry " ++ text (RenameMapping.show_varinfo f.svar) (* TODO: remove this? *) (** Pretty node plainly with stmt location. *) let pretty_plain_short () = function | Statement s -> text "Statement @ " ++ CilType.Location.pretty () (Cilfacade.get_stmtLoc s) - | Function f -> text "Function " ++ text f.svar.vname - | FunctionEntry f -> text "FunctionEntry " ++ text f.svar.vname + | Function f -> text "Function " ++ text (RenameMapping.show_varinfo f.svar) + | FunctionEntry f -> text "FunctionEntry " ++ text (RenameMapping.show_varinfo f.svar) (** Pretty node for solver variable tracing with short stmt. *) let pretty_trace () = function | Statement stmt -> dprintf "node %d \"%a\"" stmt.sid Cilfacade.stmt_pretty_short stmt - | Function fd -> dprintf "call of %s" fd.svar.vname - | FunctionEntry fd -> dprintf "entry state of %s" fd.svar.vname + | Function fd -> dprintf "call of %s" (RenameMapping.show_varinfo fd.svar) + | FunctionEntry fd -> dprintf "entry state of %s" (RenameMapping.show_varinfo fd.svar) (** Output functions for Printable interface *) let pretty () x = pretty_trace () x @@ -56,8 +56,8 @@ let show_id = function (** Show node label for CFG. *) let show_cfg = function | Statement stmt -> string_of_int stmt.sid (* doesn't use this but defaults to no label and uses ID from show_id instead *) - | Function fd -> "return of " ^ fd.svar.vname ^ "()" - | FunctionEntry fd -> fd.svar.vname ^ "()" + | Function fd -> "return of " ^ (RenameMapping.show_varinfo fd.svar) ^ "()" + | FunctionEntry fd -> (RenameMapping.show_varinfo fd.svar) ^ "()" let location (node: t) = diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index d9361ec082..1d1456bdf4 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -217,6 +217,10 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in if did_context_switch then Printf.printf "Undo context switch \n"; + (*Save rename mapping for future usage. If this function later turns out to actually being changed, the new varinfo id will be used anyway + and this mapping has no effect*) + if a.vname <> b.vname && result then RenameMapping.store_update_varinfo_name a b.vname; + result (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 762d6fbac5..643673829a 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -3,12 +3,6 @@ open MyCFG include CompareAST include CompareCFG -(*Maps the function name to a table of it's local variable and parameter renames. The rename table has key of original name and value of renamed name.*) -let rename_map: (string, (string, string) Hashtbl.t) Hashtbl.t ref = ref (Hashtbl.create 100) - -(*Same as rename_map, but maps renamed name to original name instead.*) -let reverse_rename_map: (string, (string, string) Hashtbl.t) Hashtbl.t ref = ref (Hashtbl.create 100) - type nodes_diff = { unchangedNodes: (node * node) list; primObsoleteNodes: node list; (** primary obsolete nodes -> all obsolete nodes are reachable from these *) @@ -29,37 +23,6 @@ type change_info = { mutable added: global list } -let store_local_rename (function_name: string) (rename_table: (string, string) Hashtbl.t) = - begin - Hashtbl.add !rename_map function_name rename_table; - let reverse_rename_table = Hashtbl.create (Hashtbl.length !rename_map) in - Hashtbl.iter (fun original_name new_name -> Hashtbl.add reverse_rename_table new_name original_name) rename_table; - Hashtbl.add !reverse_rename_map function_name reverse_rename_table; - end - -(*Returnes the rename if one exists, or param_name when no entry exists.*) -let get_local_rename (function_name: string) (param_name: string) = match (Hashtbl.find_opt !rename_map function_name) with - | Some (local_map) -> Option.value (Hashtbl.find_opt local_map param_name) ~default:param_name - | None -> param_name - -let get_orignal_name (function_name: string) (new_var_name: string) = match (Hashtbl.find_opt !reverse_rename_map function_name) with - | Some (reverse_map) -> Option.value (Hashtbl.find_opt reverse_map new_var_name) ~default:new_var_name - |None -> new_var_name - -let show_rename_map = - let show_local_rename_map (local_rename_map: (string, string) Hashtbl.t) = - let rename_string = Seq.map (fun (orig, new_name) -> orig ^ " -> " ^ new_name) (Hashtbl.to_seq local_rename_map) |> - List.of_seq in - String.concat ", " rename_string - in - - Hashtbl.to_seq !rename_map |> - Seq.iter (fun (fun_name, map) -> Printf.printf "%s=%d" fun_name (Hashtbl.length map)); - - let function_strings = Seq.map (fun (fun_name, map) -> fun_name ^ ": [" ^ (show_local_rename_map map) ^ "]") (Hashtbl.to_seq !rename_map) |> List.of_seq in - - String.concat ", " function_strings - let empty_change_info () : change_info = {added = []; removed = []; changed = []; unchanged = []} let should_reanalyze (fdec: Cil.fundec) = @@ -120,7 +83,7 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_cont else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1; primNewNodes = diffNodes2}) in - if (identical) then store_local_rename a.svar.vname local_rename_map; + (*if (identical) then store_local_rename a.svar.vname local_rename_map;*) identical, unchangedHeader, diffOpt diff --git a/src/incremental/renameMapping.ml b/src/incremental/renameMapping.ml new file mode 100644 index 0000000000..2251d45899 --- /dev/null +++ b/src/incremental/renameMapping.ml @@ -0,0 +1,62 @@ +open Cil + +module IncrementallyUpdatedVarinfoMap = Hashtbl.Make (CilType.Varinfo) + +(*Mapps a varinfo to its updated name*) +let renamedVarinfoMap: string IncrementallyUpdatedVarinfoMap.t ref = ref (IncrementallyUpdatedVarinfoMap.create 100) + +let get_old_or_updated_varinfo_name (old_varinfo: varinfo) = + let r: string option = IncrementallyUpdatedVarinfoMap.find_opt !renamedVarinfoMap old_varinfo in + Option.value r ~default:old_varinfo.vname + +let store_update_varinfo_name (old_varinfo: varinfo) (new_name: string) = + Printf.printf "Storing renamed name: %s -> %s\n" old_varinfo.vname new_name; + IncrementallyUpdatedVarinfoMap.add !renamedVarinfoMap old_varinfo new_name + +(* + Incremental rename aware version of show. Returns the renamed name of the varinfo if it has been updated by an incremental build, or vname if nothing has changed. + + Dev Note: Putting this into CilType.Varinfo results in a cyclic dependency. It should not be put into CilType anyway, as CilType only defines types based on the types themselves, not implement any logic based on other components outside its own definitions. So I think it's cleaner this way. +*) +let show_varinfo (varinfo: varinfo) = + Printf.printf "Accessing renamed: %s -> %s\n" varinfo.vname (get_old_or_updated_varinfo_name varinfo); + get_old_or_updated_varinfo_name varinfo + + +class incremental_printer : Cil.cilPrinter = object(self) + inherit Cil.defaultCilPrinterClass + method pVar (v:varinfo) = Pretty.text (show_varinfo v) + end;; + +class plain_incremental_printer : Cil.cilPrinter = object(self) + inherit Cil.plainCilPrinterClass + method pVar (v:varinfo) = Pretty.text (show_varinfo v) +end;; + +let incremental_aware_printer = new incremental_printer +let plain_incremental_aware_printer = new plain_incremental_printer + +let d_exp () e = printExp incremental_aware_printer () e + +(* A hack to allow forward reference of d_exp. Copy from Cil. *) +let pd_exp : (unit -> exp -> Pretty.doc) ref = + ref (fun _ -> failwith "") + +let _ = pd_exp := d_exp + +(*Fixme: Im a copy of Cil.dn_obj because i couldnt figure out why I couldn't access Cil.dn_obj*) +let dn_obj (func: unit -> 'a -> Pretty.doc) : (unit -> 'a -> Pretty.doc) = + begin + (* construct the closure to return *) + let theFunc () (obj:'a) : Pretty.doc = + begin + let prevStyle = !lineDirectiveStyle in + lineDirectiveStyle := None; + let ret = (func () obj) in (* call underlying printer *) + lineDirectiveStyle := prevStyle; + ret + end in + theFunc + end + +let dn_exp = (dn_obj d_exp) diff --git a/src/util/cilType.ml b/src/util/cilType.ml index 577b307904..436239f080 100644 --- a/src/util/cilType.ml +++ b/src/util/cilType.ml @@ -99,6 +99,7 @@ struct let show = show end ) + let pp fmt x = Format.fprintf fmt "%s" x.vname (* for deriving show *) end diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml index 01951ac5cd..6c22c57977 100644 --- a/src/util/cilfacade.ml +++ b/src/util/cilfacade.ml @@ -320,8 +320,8 @@ let getFirstStmt fd = List.hd fd.sbody.bstmts let pstmt stmt = dumpStmt defaultCilPrinter stdout 0 stmt; print_newline () -let p_expr exp = Pretty.printf "%a\n" (printExp defaultCilPrinter) exp -let d_expr exp = Pretty.printf "%a\n" (printExp plainCilPrinter) exp +let p_expr exp = Pretty.printf "%a\n" (printExp RenameMapping.incremental_aware_printer) exp +let d_expr exp = Pretty.printf "%a\n" (printExp RenameMapping.plain_incremental_aware_printer) exp (* Returns the ikind of a TInt(_) and TEnum(_). Unrolls typedefs. Warns if a a different type is put in and return IInt *) let rec get_ikind t = From 08da3fb35383bc066de0bd5254f92047ef59f3cc Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 4 May 2022 15:38:57 +0200 Subject: [PATCH 012/518] Renamed variable names are now displayed with their new name in g2html --- src/analyses/apron/apronAnalysis.apron.ml | 2 +- src/analyses/arinc.ml | 14 ++++---- src/cdomains/basetype.ml | 4 +-- src/framework/edge.ml | 4 ++- src/incremental/renameMapping.ml | 41 +++++++++++++++++++++-- 5 files changed, 52 insertions(+), 13 deletions(-) diff --git a/src/analyses/apron/apronAnalysis.apron.ml b/src/analyses/apron/apronAnalysis.apron.ml index 8fbe0660e4..d73bda5533 100644 --- a/src/analyses/apron/apronAnalysis.apron.ml +++ b/src/analyses/apron/apronAnalysis.apron.ml @@ -146,7 +146,7 @@ struct if !GU.global_initialization && e = MyCFG.unknown_exp then st (* ignore extern inits because there's no body before assign, so the apron env is empty... *) else ( - if M.tracing then M.traceli "apron" "assign %a = %a\n" d_lval lv d_exp e; + if M.tracing then M.traceli "apron" "assign %a = %a\n" RenameMapping.d_lval lv d_exp e; let ask = Analyses.ask_of_ctx ctx in let r = assign_to_global_wrapper ask ctx.global ctx.sideg st lv (fun st v -> assign_from_globals_wrapper ask ctx.global st e (fun apr' e' -> diff --git a/src/analyses/arinc.ml b/src/analyses/arinc.ml index fe2679cc50..03aa2ecea0 100644 --- a/src/analyses/arinc.ml +++ b/src/analyses/arinc.ml @@ -137,7 +137,7 @@ struct let return_code_is_success z = Cilint.is_zero_cilint z || Cilint.compare_cilint z Cilint.one_cilint = 0 let str_return_code i = if return_code_is_success i then "SUCCESS" else "ERROR" let str_return_dlval (v,o as dlval) = - sprint d_lval (Lval.CilLval.to_lval dlval) ^ "_" ^ string_of_int v.vdecl.line |> + sprint RenameMapping.d_lval (Lval.CilLval.to_lval dlval) ^ "_" ^ string_of_int v.vdecl.line |> Str.global_replace (Str.regexp "[^a-zA-Z0-9]") "_" let add_return_dlval env kind dlval = ArincUtil.add_return_var env.procid kind (str_return_dlval dlval) @@ -152,17 +152,17 @@ struct | a when not (Queries.LS.is_top a) && Queries.LS.cardinal a > 0 -> let top_elt = (dummyFunDec.svar, `NoOffset) in let a' = if Queries.LS.mem top_elt a then ( - M.debug "mayPointTo: query result for %a contains TOP!" d_exp exp; (* UNSOUND *) + M.debug "mayPointTo: query result for %a contains TOP!" RenameMapping.d_exp exp; (* UNSOUND *) Queries.LS.remove top_elt a ) else a in Queries.LS.elements a' | v -> - M.debug "mayPointTo: query result for %a is %a" d_exp exp Queries.LS.pretty v; + M.debug "mayPointTo: query result for %a is %a" RenameMapping.d_exp exp Queries.LS.pretty v; (*failwith "mayPointTo"*) [] let iterMayPointTo ctx exp f = mayPointTo ctx exp |> List.iter f - let debugMayPointTo ctx exp = M.debug "%a mayPointTo %a" d_exp exp (Pretty.d_list ", " Lval.CilLval.pretty) (mayPointTo ctx exp) + let debugMayPointTo ctx exp = M.debug "%a mayPointTo %a" RenameMapping.d_exp exp (Pretty.d_list ", " Lval.CilLval.pretty) (mayPointTo ctx exp) (* transfer functions *) @@ -184,7 +184,7 @@ struct let edges_added = ref false in let f dlval = (* M.debug @@ "assign: MayPointTo " ^ sprint d_plainlval lval ^ ": " ^ sprint d_plainexp (Lval.CilLval.to_exp dlval); *) - let is_ret_type = try is_return_code_type @@ Lval.CilLval.to_exp dlval with Cilfacade.TypeOfError Index_NonArray -> M.debug "assign: Cilfacade.typeOf %a threw exception Errormsg.Error \"Bug: typeOffset: Index on a non-array\". Will assume this is a return type to remain sound." d_exp (Lval.CilLval.to_exp dlval); true in + let is_ret_type = try is_return_code_type @@ Lval.CilLval.to_exp dlval with Cilfacade.TypeOfError Index_NonArray -> M.debug "assign: Cilfacade.typeOf %a threw exception Errormsg.Error \"Bug: typeOffset: Index on a non-array\". Will assume this is a return type to remain sound." RenameMapping.d_exp (Lval.CilLval.to_exp dlval); true in if (not is_ret_type) || Lval.CilLval.has_index dlval then () else let dlval = global_dlval dlval "assign" in edges_added := true; @@ -320,7 +320,7 @@ struct let is_creating_fun = startsWith (Functions.prefix^"Create") f.vname in if M.tracing && is_arinc_fun then ( (* M.tracel "arinc" "found %s(%s)\n" f.vname args_str *) - M.debug "found %s(%a) in %s" f.vname (Pretty.d_list ", " d_exp) arglist env.fundec.svar.vname + M.debug "found %s(%a) in %s" f.vname (Pretty.d_list ", " RenameMapping.d_exp) arglist env.fundec.svar.vname ); let is_error_handler = env.pname = pname_ErrorHandler in let eval_int exp = @@ -339,7 +339,7 @@ struct (* call assign for all analyses (we only need base)! *) | AddrOf lval -> ctx.emit (Assign {lval; exp = mkAddrOf @@ var id}) (* TODO not needed for the given code, but we could use Queries.MayPointTo exp in this case *) - | _ -> failwith @@ "Could not assign id. Expected &id. Found "^sprint d_exp exp + | _ -> failwith @@ "Could not assign id. Expected &id. Found "^sprint RenameMapping.d_exp exp in let assign_id_by_name resource_type name id = assign_id id (get_id (resource_type, eval_str name)) diff --git a/src/cdomains/basetype.ml b/src/cdomains/basetype.ml index 3d48c74292..138d60216d 100644 --- a/src/cdomains/basetype.ml +++ b/src/cdomains/basetype.ml @@ -26,8 +26,8 @@ struct let show x = if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo x then let description = RichVarinfo.BiVarinfoMap.Collection.describe_varinfo x in - "(" ^ x.vname ^ ", " ^ description ^ ")" - else x.vname + "(" ^ RenameMapping.show_varinfo x ^ ", " ^ description ^ ")" + else RenameMapping.show_varinfo x let pretty () x = Pretty.text (show x) let pretty_trace () x = Pretty.dprintf "%s on %a" x.vname CilType.Location.pretty x.vdecl let get_location x = x.vdecl diff --git a/src/framework/edge.ml b/src/framework/edge.ml index 376934510b..22ae3efb78 100644 --- a/src/framework/edge.ml +++ b/src/framework/edge.ml @@ -34,6 +34,7 @@ type t = [@@deriving eq, to_yojson] let dn_exp = RenameMapping.dn_exp +let dn_lval = RenameMapping.dn_lval let pretty () = function | Test (exp, b) -> if b then Pretty.dprintf "Pos(%a)" dn_exp exp else Pretty.dprintf "Neg(%a)" dn_exp exp @@ -45,10 +46,11 @@ let pretty () = function | Ret (None,f) -> Pretty.dprintf "return" | ASM (_,_,_) -> Pretty.text "ASM ..." | Skip -> Pretty.text "skip" - | VDecl v -> Cil.defaultCilPrinter#pVDecl () v + | VDecl v -> RenameMapping.incremental_aware_printer#pVDecl () v | SelfLoop -> Pretty.text "SelfLoop" let d_exp = RenameMapping.d_exp +let d_lval = RenameMapping.d_lval let pretty_plain () = function | Assign (lv,rv) -> dprintf "Assign '%a = %a' " d_lval lv d_exp rv diff --git a/src/incremental/renameMapping.ml b/src/incremental/renameMapping.ml index 2251d45899..ed5cfdcea7 100644 --- a/src/incremental/renameMapping.ml +++ b/src/incremental/renameMapping.ml @@ -22,21 +22,48 @@ let show_varinfo (varinfo: varinfo) = Printf.printf "Accessing renamed: %s -> %s\n" varinfo.vname (get_old_or_updated_varinfo_name varinfo); get_old_or_updated_varinfo_name varinfo +(*in original Cil v.vname is hardcoded*) +let pVDeclImpl () (v:varinfo) (pType) (pAttrs) = + (* First the storage modifiers *) + Pretty.(text (if v.vinline then "__inline " else "") + ++ d_storage () v.vstorage + ++ (pType (Some (Pretty.text (show_varinfo v))) () v.vtype) + ++ Pretty.text " " + ++ pAttrs () v.vattr) class incremental_printer : Cil.cilPrinter = object(self) inherit Cil.defaultCilPrinterClass method pVar (v:varinfo) = Pretty.text (show_varinfo v) - end;; + + (* variable declaration *) + method pVDecl () (v:varinfo) = pVDeclImpl () v self#pType self#pAttrs +end;; class plain_incremental_printer : Cil.cilPrinter = object(self) inherit Cil.plainCilPrinterClass method pVar (v:varinfo) = Pretty.text (show_varinfo v) + + method pVDecl () (v:varinfo) = pVDeclImpl () v self#pType self#pAttrs end;; let incremental_aware_printer = new incremental_printer let plain_incremental_aware_printer = new plain_incremental_printer -let d_exp () e = printExp incremental_aware_printer () e +let d_exp () e = + let _ = Pretty.printf "Printing Exp: %a\n" (printExp incremental_aware_printer) e in + let _ = match e with + | BinOp (_, exp1, exp2, _) -> + ignore@@Pretty.printf "BinOp: %a and %a\n" (printExp incremental_aware_printer) exp1 (printExp incremental_aware_printer) exp2; + Pretty.printf "%s\n" (Printexc.get_callstack 15 |> Printexc.raw_backtrace_to_string); + | _ -> + Pretty.printf ""; + in + + printExp incremental_aware_printer () e + +let d_lval () l = printLval incremental_aware_printer () l + +let d_stmt () s = printStmt incremental_aware_printer () s (* A hack to allow forward reference of d_exp. Copy from Cil. *) let pd_exp : (unit -> exp -> Pretty.doc) ref = @@ -44,6 +71,12 @@ let pd_exp : (unit -> exp -> Pretty.doc) ref = let _ = pd_exp := d_exp +let pd_lval : (unit -> lval -> Pretty.doc) ref = ref (fun _ -> failwith "") +let _ = pd_lval := d_lval + +let pd_stmt : (unit -> stmt -> Pretty.doc) ref = ref (fun _ -> failwith "") +let _ = pd_stmt := d_stmt + (*Fixme: Im a copy of Cil.dn_obj because i couldnt figure out why I couldn't access Cil.dn_obj*) let dn_obj (func: unit -> 'a -> Pretty.doc) : (unit -> 'a -> Pretty.doc) = begin @@ -60,3 +93,7 @@ let dn_obj (func: unit -> 'a -> Pretty.doc) : (unit -> 'a -> Pretty.doc) = end let dn_exp = (dn_obj d_exp) + +let dn_lval = (dn_obj d_lval) + +let dn_stmt = (dn_obj d_stmt) \ No newline at end of file From 3a11fb917c1ee8ef88d3a6d7abaa6856d25e985c Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 9 May 2022 10:49:21 +0200 Subject: [PATCH 013/518] Cleanup print statements and added some docu. --- scripts/test-incremental-multiple.sh | 4 +- src/analyses/base.ml | 63 +++++----------------------- src/analyses/spec.ml | 2 +- src/framework/analyses.ml | 2 - src/incremental/compareAST.ml | 13 ++---- src/incremental/compareCFG.ml | 3 -- src/incremental/compareCIL.ml | 7 ---- src/incremental/renameMapping.ml | 35 +++++++--------- 8 files changed, 32 insertions(+), 97 deletions(-) diff --git a/scripts/test-incremental-multiple.sh b/scripts/test-incremental-multiple.sh index 87b7e150ce..a910e8498a 100644 --- a/scripts/test-incremental-multiple.sh +++ b/scripts/test-incremental-multiple.sh @@ -16,13 +16,13 @@ patch -p0 -b <$patch1 cat $source -./goblint --conf $conf $args --enable incremental.load --set save_run $base/$test-incrementalrun $source &> $base/$test.after.incr1.log --html +./goblint --conf $conf $args --enable incremental.load --enable incremental.save $source &> $base/$test.after.incr1.log --html patch -p0 <$patch2 cat $source -./goblint --conf $conf $args --enable incremental.load --set save_run $base/$test-incrementalrun $source &> $base/$test.after.incr2.log --html +./goblint --conf $conf $args --enable incremental.load --enable incremental.save --set save_run $base/$test-incrementalrun $source &> $base/$test.after.incr2.log --html #./goblint --conf $conf $args --enable incremental.only-rename --set save_run $base/$test-originalrun $source &> $base/$test.after.scratch.log --html diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 65dff1a699..3c8f2a6b00 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -845,7 +845,7 @@ struct do_offs (AD.map (add_offset_varinfo (convert_offset a gs st ofs)) adr) ofs | `Bot -> AD.bot () | _ -> - M.debug ~category:Analyzer "Failed evaluating %a to lvalue" d_lval lval; do_offs AD.unknown_ptr ofs + M.debug ~category:Analyzer "Failed evaluating %a to lvalue" RenameMapping.d_lval lval; do_offs AD.unknown_ptr ofs end (* run eval_rv from above and keep a result that is bottom *) @@ -1128,7 +1128,7 @@ struct with Cilfacade.TypeOfError _ -> (* If we cannot determine the correct type here, we go with the one of the LVal *) (* This will usually lead to a type mismatch in the ValueDomain (and hence supertop) *) - M.warn "Cilfacade.typeOfLval failed Could not obtain the type of %a" d_lval (Var x, cil_offset); + M.warn "Cilfacade.typeOfLval failed Could not obtain the type of %a" RenameMapping.d_lval (Var x, cil_offset); lval_type in let update_offset old_value = @@ -1307,7 +1307,7 @@ struct match (op, lval, value, tv) with (* The true-branch where x == value: *) | Eq, x, value, true -> - if M.tracing then M.tracec "invariant" "Yes, %a equals %a\n" d_lval x VD.pretty value; + if M.tracing then M.tracec "invariant" "Yes, %a equals %a\n" RenameMapping.d_lval x VD.pretty value; (match value with | `Int n -> let ikind = Cilfacade.get_ikind_exp (Lval lval) in @@ -1320,13 +1320,13 @@ struct match ID.to_int n with | Some n -> (* When x != n, we can return a singleton exclusion set *) - if M.tracing then M.tracec "invariant" "Yes, %a is not %s\n" d_lval x (BI.to_string n); + if M.tracing then M.tracec "invariant" "Yes, %a is not %s\n" RenameMapping.d_lval x (BI.to_string n); let ikind = Cilfacade.get_ikind_exp (Lval lval) in Some (x, `Int (ID.of_excl_list ikind [n])) | None -> None end | `Address n -> begin - if M.tracing then M.tracec "invariant" "Yes, %a is not %a\n" d_lval x AD.pretty n; + if M.tracing then M.tracec "invariant" "Yes, %a is not %a\n" RenameMapping.d_lval x AD.pretty n; match eval_rv_address a gs st (Lval x) with | `Address a when AD.is_definite n -> Some (x, `Address (AD.diff a n)) @@ -1353,7 +1353,7 @@ struct let limit_from = if tv then ID.maximal else ID.minimal in match limit_from n with | Some n -> - if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" d_lval x (BI.to_string n); + if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" RenameMapping.d_lval x (BI.to_string n); Some (x, `Int (range_from n)) | None -> None end @@ -1368,7 +1368,7 @@ struct let limit_from = if tv then ID.maximal else ID.minimal in match limit_from n with | Some n -> - if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" d_lval x (BI.to_string n); + if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" RenameMapping.d_lval x (BI.to_string n); Some (x, `Int (range_from n)) | None -> None end @@ -1428,12 +1428,12 @@ struct in match derived_invariant exp tv with | Some (lval, value) -> - if M.tracing then M.tracec "invariant" "Restricting %a with %a\n" d_lval lval VD.pretty value; + if M.tracing then M.tracec "invariant" "Restricting %a with %a\n" RenameMapping.d_lval lval VD.pretty value; let addr = eval_lv a gs st lval in if (AD.is_top addr) then st else let oldval = get a gs st addr None in (* None is ok here, we could try to get more precise, but this is ok (reading at unknown position in array) *) - let oldval = if is_some_bot oldval then (M.tracec "invariant" "%a is bot! This should not happen. Will continue with top!" d_lval lval; VD.top ()) else oldval in + let oldval = if is_some_bot oldval then (M.tracec "invariant" "%a is bot! This should not happen. Will continue with top!" RenameMapping.d_lval lval; VD.top ()) else oldval in let t_lval = Cilfacade.typeOfLval lval in let state_with_excluded = set a gs st addr t_lval value ~invariant:true ~ctx:(Some ctx) in let value = get a gs state_with_excluded addr None in @@ -1639,7 +1639,7 @@ struct let v = VD.meet oldv c' in if is_some_bot v then raise Deadcode else ( - if M.tracing then M.tracel "inv" "improve lval %a from %a to %a (c = %a, c' = %a)\n" d_lval x VD.pretty oldv VD.pretty v ID.pretty c VD.pretty c'; + if M.tracing then M.tracel "inv" "improve lval %a from %a to %a (c = %a, c' = %a)\n" RenameMapping.d_lval x VD.pretty oldv VD.pretty v ID.pretty c VD.pretty c'; set' x v st )) | Const _ -> st (* nothing to do *) @@ -2019,47 +2019,6 @@ struct | _ -> [] let assert_fn ctx e should_warn change = - (* - let _ = Hashtbl.iter (fun fun_name map -> - begin - Printf.printf "%s: [" fun_name; - Hashtbl.iter (fun from tox -> Printf.printf "%s -> %s; " from tox) map; - Printf.printf "]\n"; - end - ) !CompareCIL.rename_map in - - let parent_function: fundec = Node.find_fundec ctx.node in - - (*Performs the actual rename on lvals for renamed local variables.*) - let rename_lval lhost offset = - let new_lhost = match lhost with - | Var varinfo -> - varinfo.vname <- CompareCIL.get_local_rename parent_function.svar.vname varinfo.vname; - Var varinfo - | _ -> lhost - in - (new_lhost, offset) - in - - (*Recusivly go through the expression and rename all occurences of local variables. TODO: What happens with global vars*) - let rec rename_exp (exp: exp) = match exp with - | Lval (lhost, offset) -> Lval (rename_lval lhost offset) - | Real e -> Real (rename_exp e) - | Imag e -> Imag (rename_exp e) - | SizeOfE e -> SizeOfE (rename_exp e) - | AlignOfE e -> AlignOfE (rename_exp e) - | UnOp (unop, e, typ) -> UnOp (unop, rename_exp e, typ) - | BinOp (binop, e1, e2, typ) -> BinOp (binop, rename_exp e1, rename_exp e2, typ) - | Question (e1, e2, e3, typ) -> Question (rename_exp e1, rename_exp e2, rename_exp e3, typ) - | CastE (typ, e) -> CastE (typ, rename_exp e) - | AddrOf (lhost, offset) -> AddrOf (rename_lval lhost offset) - | StartOf (lhost, offset) -> StartOf (rename_lval lhost offset) - (*TODO: AddrOfLabel?*) - | _ -> exp - in - *) - - let check_assert e st = match eval_rv (Analyses.ask_of_ctx ctx) ctx.global st e with | `Int v when ID.is_bool v -> @@ -2131,8 +2090,6 @@ struct invalidate ~ctx (Analyses.ask_of_ctx ctx) gs st addrs let special ctx (lv:lval option) (f: varinfo) (args: exp list) = - List.iter (fun x -> ignore @@ Pretty.printf "%a\n" RenameMapping.d_exp x;) args; - let invalidate_ret_lv st = match lv with | Some lv -> if M.tracing then M.tracel "invalidate" "Invalidating lhs %a for function call %s\n" d_plainlval lv (RenameMapping.show_varinfo f); diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml index 38be505f5d..9fcfd7bb61 100644 --- a/src/analyses/spec.ml +++ b/src/analyses/spec.ml @@ -256,7 +256,7 @@ struct D.warn @@ "changed pointer "^D.string_of_key k1^" (no longer safe)"; (* saveOpened ~unknown:true k1 *) m |> D.unknown k1 | _ -> (* no change in D for other things *) - M.debug "assign (none in D): %a = %a [%a]" d_lval lval d_exp rval d_plainexp rval; + M.debug "assign (none in D): %a = %a [%a]" RenameMapping.d_lval lval d_exp rval d_plainexp rval; m (* diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 21d015c512..ddb76ccfd6 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -191,8 +191,6 @@ struct match get_string "result" with | "pretty" -> ignore (fprintf out "%a\n" pretty (Lazy.force table)) | "fast_xml" -> - Printf.printf "%s" (Printexc.get_callstack 15 |> Printexc.raw_backtrace_to_string); - let module SH = BatHashtbl.Make (Basetype.RawStrings) in let file2funs = SH.create 100 in let funs2node = SH.create 100 in diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 1d1456bdf4..c4330d25a3 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -191,7 +191,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = in (*If the following is a method call, we need to check if we have a mapping for that method call. *) - let typ_context, did_context_switch = match b.vtype with + let typ_context = match b.vtype with | TFun(_, _, _, _) -> ( let new_locals = List.find_opt (fun x -> match x with | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname @@ -200,22 +200,17 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = match new_locals with | Some locals -> (*Printf.printf "Performing context switch. New context=%s\n" (context_to_string (locals.parameter_renames, method_contexts));*) - (locals.parameter_renames, method_contexts), true - | None -> ([], method_contexts), false + (locals.parameter_renames, method_contexts) + | None -> ([], method_contexts) ) - | _ -> context, false + | _ -> context in let typeCheck = eq_typ a.vtype b.vtype typ_context in let attrCheck = GobList.equal (eq_attribute context) a.vattr b.vattr in - (*let _ = if isNamingOk then a.vname <- b.vname in*) - - (*let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in *) - (*a.vname = b.vname*) let result = isNamingOk && typeCheck && attrCheck && a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in - if did_context_switch then Printf.printf "Undo context switch \n"; (*Save rename mapping for future usage. If this function later turns out to actually being changed, the new varinfo id will be used anyway and this mapping has no effect*) diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 25b5f64ccf..e87df4f832 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -47,8 +47,6 @@ module NTH = Hashtbl.Make( * process on their successors. If a node from the old CFG can not be matched, it is added to diff and no further * comparison is done for its successors. The two function entry nodes make up the tuple to start the comparison from. *) let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 fun2 = - let _ = Printf.printf "ComparingCfgs" in - let diff = NH.create 113 in let same = NTH.create 113 in let waitingList : (node * node) t = Queue.create () in @@ -132,7 +130,6 @@ let reexamine f1 f2 (same : unit NTH.t) (diffNodes1 : unit NH.t) (module CfgOld (NTH.to_seq_keys same, NH.to_seq_keys diffNodes1, NH.to_seq_keys diffNodes2) let compareFun (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 fun2 = - let _ = Printf.printf "Comparing funs" in let same, diff = compareCfgs (module CfgOld) (module CfgNew) fun1 fun2 in let unchanged, diffNodes1, diffNodes2 = reexamine fun1 fun2 same diff (module CfgOld) (module CfgNew) in List.of_seq unchanged, List.of_seq diffNodes1, List.of_seq diffNodes2 diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 643673829a..01a3672d51 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -60,13 +60,9 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_cont false, None else (* Here the local variables are checked to be equal *) - - let sizeEqual, local_rename = context_aware_compare a.slocals b.slocals headerContext in let context: context = (local_rename, global_context) in - let _ = Printf.printf "Context=%s\n" (CompareAST.context_to_string context) in - let sameDef = unchangedHeader && sizeEqual in if not sameDef then (false, None) @@ -75,7 +71,6 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_cont | None -> eq_block (a.sbody, a) (b.sbody, b) context, None | Some (cfgOld, cfgNew) -> - Printf.printf "compareCIL.eqF: Compaing 2 cfgs now\n"; let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgForward = struct let next = cfgNew end in let matches, diffNodes1, diffNodes2 = compareFun (module CfgOld) (module CfgNew) a b in @@ -97,8 +92,6 @@ let eq_glob (a: global) (b: global) (cfgs : (cfg * cfg) option) (global_context: | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = - let _ = Printf.printf "Comparing Cil files\n" in - let cfgs = if GobConfig.get_string "incremental.compare" = "cfg" then Some (CfgTools.getCFG oldAST |> fst, CfgTools.getCFG newAST |> fst) else None in diff --git a/src/incremental/renameMapping.ml b/src/incremental/renameMapping.ml index ed5cfdcea7..e3f332e555 100644 --- a/src/incremental/renameMapping.ml +++ b/src/incremental/renameMapping.ml @@ -1,5 +1,13 @@ open Cil +(* + This file remembers which varinfos were renamed in the process of incremental analysis. + If the functions of this file are used to pretty print varinfos and their names, the correct updated name + will be shown instead of the old varinfo name that was used when the analysis result was created. + + The rename entries are filled up by CompareAST.ml while the comparison takes place. +*) + module IncrementallyUpdatedVarinfoMap = Hashtbl.Make (CilType.Varinfo) (*Mapps a varinfo to its updated name*) @@ -10,7 +18,6 @@ let get_old_or_updated_varinfo_name (old_varinfo: varinfo) = Option.value r ~default:old_varinfo.vname let store_update_varinfo_name (old_varinfo: varinfo) (new_name: string) = - Printf.printf "Storing renamed name: %s -> %s\n" old_varinfo.vname new_name; IncrementallyUpdatedVarinfoMap.add !renamedVarinfoMap old_varinfo new_name (* @@ -18,9 +25,7 @@ let store_update_varinfo_name (old_varinfo: varinfo) (new_name: string) = Dev Note: Putting this into CilType.Varinfo results in a cyclic dependency. It should not be put into CilType anyway, as CilType only defines types based on the types themselves, not implement any logic based on other components outside its own definitions. So I think it's cleaner this way. *) -let show_varinfo (varinfo: varinfo) = - Printf.printf "Accessing renamed: %s -> %s\n" varinfo.vname (get_old_or_updated_varinfo_name varinfo); - get_old_or_updated_varinfo_name varinfo +let show_varinfo = get_old_or_updated_varinfo_name (*in original Cil v.vname is hardcoded*) let pVDeclImpl () (v:varinfo) (pType) (pAttrs) = @@ -33,33 +38,23 @@ let pVDeclImpl () (v:varinfo) (pType) (pAttrs) = class incremental_printer : Cil.cilPrinter = object(self) inherit Cil.defaultCilPrinterClass - method pVar (v:varinfo) = Pretty.text (show_varinfo v) + method! pVar (v:varinfo) = Pretty.text (show_varinfo v) (* variable declaration *) - method pVDecl () (v:varinfo) = pVDeclImpl () v self#pType self#pAttrs + method! pVDecl () (v:varinfo) = pVDeclImpl () v self#pType self#pAttrs end;; class plain_incremental_printer : Cil.cilPrinter = object(self) inherit Cil.plainCilPrinterClass - method pVar (v:varinfo) = Pretty.text (show_varinfo v) + method! pVar (v:varinfo) = Pretty.text (show_varinfo v) - method pVDecl () (v:varinfo) = pVDeclImpl () v self#pType self#pAttrs + method! pVDecl () (v:varinfo) = pVDeclImpl () v self#pType self#pAttrs end;; let incremental_aware_printer = new incremental_printer let plain_incremental_aware_printer = new plain_incremental_printer -let d_exp () e = - let _ = Pretty.printf "Printing Exp: %a\n" (printExp incremental_aware_printer) e in - let _ = match e with - | BinOp (_, exp1, exp2, _) -> - ignore@@Pretty.printf "BinOp: %a and %a\n" (printExp incremental_aware_printer) exp1 (printExp incremental_aware_printer) exp2; - Pretty.printf "%s\n" (Printexc.get_callstack 15 |> Printexc.raw_backtrace_to_string); - | _ -> - Pretty.printf ""; - in - - printExp incremental_aware_printer () e +let d_exp () e = printExp incremental_aware_printer () e let d_lval () l = printLval incremental_aware_printer () l @@ -77,7 +72,7 @@ let _ = pd_lval := d_lval let pd_stmt : (unit -> stmt -> Pretty.doc) ref = ref (fun _ -> failwith "") let _ = pd_stmt := d_stmt -(*Fixme: Im a copy of Cil.dn_obj because i couldnt figure out why I couldn't access Cil.dn_obj*) +(*Fixme: Im a copy of Cil.dn_obj but Cil.dn_obj is not exported. So export Cil.dn_obj and then replace me.*) let dn_obj (func: unit -> 'a -> Pretty.doc) : (unit -> 'a -> Pretty.doc) = begin (* construct the closure to return *) From b7fac8970b55ec40f148f7a9042e856d2d8ee9cb Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 9 May 2022 15:06:07 +0200 Subject: [PATCH 014/518] Renamed context to rename_mapping --- src/incremental/compareAST.ml | 230 +++++++++++++++++----------------- src/incremental/compareCFG.ml | 26 ++-- src/incremental/compareCIL.ml | 46 +++---- 3 files changed, 151 insertions(+), 151 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index c4330d25a3..bc9ac84552 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -5,18 +5,18 @@ type global_type = Fun | Decl | Var and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] -type local_rename = string * string +type local_rename_assumption = string * string (**) -type method_context = {original_method_name: string; new_method_name: string; parameter_renames: (string * string) list} +type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: (string * string) list} -(*context is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type context = (local_rename list) * (method_context list) +(*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) +type rename_mapping = (local_rename_assumption list) * (method_rename_assumption list) -(*Compares two names, being aware of the context. Returns true iff: +(*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) 2. there is no rename for name1 -> name1 = name2*) -let context_aware_name_comparison (name1: string) (name2: string) (context: context) = - let (local_c, method_c) = context in +let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = + let (local_c, method_c) = rename_mapping in let existingAssumption: (string*string) option = List.find_opt (fun x -> match x with (original, now) -> original = name1) local_c in match existingAssumption with @@ -31,8 +31,8 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> List.map (fun x -> match x with (first, second) -> "(" ^ first ^ " -> " ^ second ^ ")") |> String.concat ", ") ^ "]" -let context_to_string (context: context) = - let (local, methods) = context in +let rename_mapping_to_string (rename_mapping: rename_mapping) = + let (local, methods) = rename_mapping in let local_string = string_tuple_to_string local in let methods_string: string = methods |> List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> @@ -59,33 +59,33 @@ let compare_name (a: string) (b: string) = let anon_union = "__anonunion_" in if a = b then true else BatString.(starts_with a anon_struct && starts_with b anon_struct || starts_with a anon_union && starts_with b anon_union) -let rec eq_constant (context: context) (a: constant) (b: constant) = +let rec eq_constant (rename_mapping: rename_mapping) (a: constant) (b: constant) = match a, b with | CInt (val1, kind1, str1), CInt (val2, kind2, str2) -> Cilint.compare_cilint val1 val2 = 0 && kind1 = kind2 (* Ignore string representation, i.e. 0x2 == 2 *) - | CEnum (exp1, str1, enuminfo1), CEnum (exp2, str2, enuminfo2) -> eq_exp exp1 exp2 context (* Ignore name and enuminfo *) + | CEnum (exp1, str1, enuminfo1), CEnum (exp2, str2, enuminfo2) -> eq_exp exp1 exp2 rename_mapping (* Ignore name and enuminfo *) | a, b -> a = b -and eq_exp2 (context: context) (a: exp) (b: exp) = eq_exp a b context +and eq_exp2 (rename_mapping: rename_mapping) (a: exp) (b: exp) = eq_exp a b rename_mapping -and eq_exp (a: exp) (b: exp) (context: context) = +and eq_exp (a: exp) (b: exp) (rename_mapping: rename_mapping) = match a, b with - | Const c1, Const c2 -> eq_constant context c1 c2 - | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 context - | SizeOf typ1, SizeOf typ2 -> eq_typ typ1 typ2 context - | SizeOfE exp1, SizeOfE exp2 -> eq_exp exp1 exp2 context + | Const c1, Const c2 -> eq_constant rename_mapping c1 c2 + | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 rename_mapping + | SizeOf typ1, SizeOf typ2 -> eq_typ typ1 typ2 rename_mapping + | SizeOfE exp1, SizeOfE exp2 -> eq_exp exp1 exp2 rename_mapping | SizeOfStr str1, SizeOfStr str2 -> str1 = str2 (* possibly, having the same length would suffice *) - | AlignOf typ1, AlignOf typ2 -> eq_typ typ1 typ2 context - | AlignOfE exp1, AlignOfE exp2 -> eq_exp exp1 exp2 context - | UnOp (op1, exp1, typ1), UnOp (op2, exp2, typ2) -> op1 == op2 && eq_exp exp1 exp2 context && eq_typ typ1 typ2 context - | BinOp (op1, left1, right1, typ1), BinOp (op2, left2, right2, typ2) -> op1 = op2 && eq_exp left1 left2 context && eq_exp right1 right2 context && eq_typ typ1 typ2 context - | CastE (typ1, exp1), CastE (typ2, exp2) -> eq_typ typ1 typ2 context && eq_exp exp1 exp2 context - | AddrOf lv1, AddrOf lv2 -> eq_lval lv1 lv2 context - | StartOf lv1, StartOf lv2 -> eq_lval lv1 lv2 context + | AlignOf typ1, AlignOf typ2 -> eq_typ typ1 typ2 rename_mapping + | AlignOfE exp1, AlignOfE exp2 -> eq_exp exp1 exp2 rename_mapping + | UnOp (op1, exp1, typ1), UnOp (op2, exp2, typ2) -> op1 == op2 && eq_exp exp1 exp2 rename_mapping && eq_typ typ1 typ2 rename_mapping + | BinOp (op1, left1, right1, typ1), BinOp (op2, left2, right2, typ2) -> op1 = op2 && eq_exp left1 left2 rename_mapping && eq_exp right1 right2 rename_mapping && eq_typ typ1 typ2 rename_mapping + | CastE (typ1, exp1), CastE (typ2, exp2) -> eq_typ typ1 typ2 rename_mapping && eq_exp exp1 exp2 rename_mapping + | AddrOf lv1, AddrOf lv2 -> eq_lval lv1 lv2 rename_mapping + | StartOf lv1, StartOf lv2 -> eq_lval lv1 lv2 rename_mapping | _, _ -> false -and eq_lhost (a: lhost) (b: lhost) (context: context) = match a, b with - Var v1, Var v2 -> eq_varinfo v1 v2 context - | Mem exp1, Mem exp2 -> eq_exp exp1 exp2 context +and eq_lhost (a: lhost) (b: lhost) (rename_mapping: rename_mapping) = match a, b with + Var v1, Var v2 -> eq_varinfo v1 v2 rename_mapping + | Mem exp1, Mem exp2 -> eq_exp exp1 exp2 rename_mapping | _, _ -> false and global_typ_acc: (typ * typ) list ref = ref [] (* TODO: optimize with physical Hashtbl? *) @@ -94,21 +94,21 @@ and mem_typ_acc (a: typ) (b: typ) acc = List.exists (fun p -> match p with (x, y and pretty_length () l = Pretty.num (List.length l) -and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (context: context) = +and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = if Messages.tracing then Messages.tracei "compareast" "eq_typ_acc %a vs %a (%a, %a)\n" d_type a d_type b pretty_length acc pretty_length !global_typ_acc; (* %a makes List.length calls lazy if compareast isn't being traced *) let r = match a, b with - | TPtr (typ1, attr1), TPtr (typ2, attr2) -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 - | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc context && eq_exp lenExp1 lenExp2 context && GobList.equal (eq_attribute context) attr1 attr2 - | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 + | TPtr (typ1, attr1), TPtr (typ2, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && eq_exp lenExp1 lenExp2 rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_args context acc) list1 list2 && varArg1 = varArg2 && - GobList.equal (eq_attribute context) attr1 attr2 + -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_args rename_mapping acc) list1 list2 && varArg1 = varArg2 && + GobList.equal (eq_attribute rename_mapping) attr1 attr2 | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc context && varArg1 = varArg2 && - GobList.equal (eq_attribute context) attr1 attr2 - | TNamed (typinfo1, attr1), TNamed (typeinfo2, attr2) -> eq_typ_acc typinfo1.ttype typeinfo2.ttype acc context && GobList.equal (eq_attribute context) attr1 attr2 (* Ignore tname, treferenced *) - | TNamed (tinf, attr), b -> eq_typ_acc tinf.ttype b acc context (* Ignore tname, treferenced. TODO: dismiss attributes, or not? *) - | a, TNamed (tinf, attr) -> eq_typ_acc a tinf.ttype acc context (* Ignore tname, treferenced . TODO: dismiss attributes, or not? *) + -> eq_typ_acc typ1 typ2 acc rename_mapping && varArg1 = varArg2 && + GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TNamed (typinfo1, attr1), TNamed (typeinfo2, attr2) -> eq_typ_acc typinfo1.ttype typeinfo2.ttype acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 (* Ignore tname, treferenced *) + | TNamed (tinf, attr), b -> eq_typ_acc tinf.ttype b acc rename_mapping (* Ignore tname, treferenced. TODO: dismiss attributes, or not? *) + | a, TNamed (tinf, attr) -> eq_typ_acc a tinf.ttype acc rename_mapping (* Ignore tname, treferenced . TODO: dismiss attributes, or not? *) (* The following two lines are a hack to ensure that anonymous types get the same name and thus, the same typsig *) | TComp (compinfo1, attr1), TComp (compinfo2, attr2) -> if mem_typ_acc a b acc || mem_typ_acc a b !global_typ_acc then ( @@ -117,97 +117,97 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (context: context) = ) else ( let acc = (a, b) :: acc in - let res = eq_compinfo compinfo1 compinfo2 acc context && GobList.equal (eq_attribute context) attr1 attr2 in + let res = eq_compinfo compinfo1 compinfo2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 in if res && compinfo1.cname <> compinfo2.cname then compinfo2.cname <- compinfo1.cname; if res then global_typ_acc := (a, b) :: !global_typ_acc; res ) - | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> let res = eq_enuminfo enuminfo1 enuminfo2 context && GobList.equal (eq_attribute context) attr1 attr2 in (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); res - | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> GobList.equal (eq_attribute context) attr1 attr2 - | TVoid attr1, TVoid attr2 -> GobList.equal (eq_attribute context) attr1 attr2 - | TInt (ik1, attr1), TInt (ik2, attr2) -> ik1 = ik2 && GobList.equal (eq_attribute context) attr1 attr2 - | TFloat (fk1, attr1), TFloat (fk2, attr2) -> fk1 = fk2 && GobList.equal (eq_attribute context) attr1 attr2 + | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> let res = eq_enuminfo enuminfo1 enuminfo2 rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 in (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); res + | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TVoid attr1, TVoid attr2 -> GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TInt (ik1, attr1), TInt (ik2, attr2) -> ik1 = ik2 && GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TFloat (fk1, attr1), TFloat (fk2, attr2) -> fk1 = fk2 && GobList.equal (eq_attribute rename_mapping) attr1 attr2 | _, _ -> false in if Messages.tracing then Messages.traceu "compareast" "eq_typ_acc %a vs %a\n" d_type a d_type b; r -and eq_typ (a: typ) (b: typ) (context: context) = eq_typ_acc a b [] context +and eq_typ (a: typ) (b: typ) (rename_mapping: rename_mapping) = eq_typ_acc a b [] rename_mapping -and eq_eitems (context: context) (a: string * exp * location) (b: string * exp * location) = match a, b with - (name1, exp1, _l1), (name2, exp2, _l2) -> name1 = name2 && eq_exp exp1 exp2 context +and eq_eitems (rename_mapping: rename_mapping) (a: string * exp * location) (b: string * exp * location) = match a, b with + (name1, exp1, _l1), (name2, exp2, _l2) -> name1 = name2 && eq_exp exp1 exp2 rename_mapping (* Ignore location *) -and eq_enuminfo (a: enuminfo) (b: enuminfo) (context: context) = +and eq_enuminfo (a: enuminfo) (b: enuminfo) (rename_mapping: rename_mapping) = compare_name a.ename b.ename && - GobList.equal (eq_attribute context) a.eattr b.eattr && - GobList.equal (eq_eitems context) a.eitems b.eitems + GobList.equal (eq_attribute rename_mapping) a.eattr b.eattr && + GobList.equal (eq_eitems rename_mapping) a.eitems b.eitems (* Ignore ereferenced *) -and eq_args (context: context) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with +and eq_args (rename_mapping: rename_mapping) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with (name1, typ1, attr1), (name2, typ2, attr2) -> - context_aware_name_comparison name1 name2 context && eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 + rename_mapping_aware_name_comparison name1 name2 rename_mapping && eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 -and eq_attrparam (context: context) (a: attrparam) (b: attrparam) = match a, b with - | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam context) attrparams1 attrparams2 - | ASizeOf typ1, ASizeOf typ2 -> eq_typ typ1 typ2 context - | ASizeOfE attrparam1, ASizeOfE attrparam2 -> eq_attrparam context attrparam1 attrparam2 +and eq_attrparam (rename_mapping: rename_mapping) (a: attrparam) (b: attrparam) = match a, b with + | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam rename_mapping) attrparams1 attrparams2 + | ASizeOf typ1, ASizeOf typ2 -> eq_typ typ1 typ2 rename_mapping + | ASizeOfE attrparam1, ASizeOfE attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 | ASizeOfS typsig1, ASizeOfS typsig2 -> typsig1 = typsig2 - | AAlignOf typ1, AAlignOf typ2 -> eq_typ typ1 typ2 context - | AAlignOfE attrparam1, AAlignOfE attrparam2 -> eq_attrparam context attrparam1 attrparam2 + | AAlignOf typ1, AAlignOf typ2 -> eq_typ typ1 typ2 rename_mapping + | AAlignOfE attrparam1, AAlignOfE attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 | AAlignOfS typsig1, AAlignOfS typsig2 -> typsig1 = typsig2 - | AUnOp (op1, attrparam1), AUnOp (op2, attrparam2) -> op1 = op2 && eq_attrparam context attrparam1 attrparam2 - | ABinOp (op1, left1, right1), ABinOp (op2, left2, right2) -> op1 = op2 && eq_attrparam context left1 left2 && eq_attrparam context right1 right2 - | ADot (attrparam1, str1), ADot (attrparam2, str2) -> eq_attrparam context attrparam1 attrparam2 && str1 = str2 - | AStar attrparam1, AStar attrparam2 -> eq_attrparam context attrparam1 attrparam2 - | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam context attrparam1 attrparam2 - | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam context left1 left2 && eq_attrparam context right1 right2 - | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> eq_attrparam context left1 left2 && eq_attrparam context middle1 middle2 && eq_attrparam context right1 right2 + | AUnOp (op1, attrparam1), AUnOp (op2, attrparam2) -> op1 = op2 && eq_attrparam rename_mapping attrparam1 attrparam2 + | ABinOp (op1, left1, right1), ABinOp (op2, left2, right2) -> op1 = op2 && eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping right1 right2 + | ADot (attrparam1, str1), ADot (attrparam2, str2) -> eq_attrparam rename_mapping attrparam1 attrparam2 && str1 = str2 + | AStar attrparam1, AStar attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 + | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 + | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping right1 right2 + | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping middle1 middle2 && eq_attrparam rename_mapping right1 right2 | a, b -> a = b -and eq_attribute (context: context) (a: attribute) (b: attribute) = match a, b with - | Attr (name1, params1), Attr (name2, params2) -> name1 = name2 && GobList.equal (eq_attrparam context) params1 params2 +and eq_attribute (rename_mapping: rename_mapping) (a: attribute) (b: attribute) = match a, b with + | Attr (name1, params1), Attr (name2, params2) -> name1 = name2 && GobList.equal (eq_attrparam rename_mapping) params1 params2 -and eq_varinfo2 (context: context) (a: varinfo) (b: varinfo) = eq_varinfo a b context +and eq_varinfo2 (rename_mapping: rename_mapping) (a: varinfo) (b: varinfo) = eq_varinfo a b rename_mapping -and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = +and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*Printf.printf "Comp %s with %s\n" a.vname b.vname;*) - let (_, method_contexts) = context in + let (_, method_rename_mappings) = rename_mapping in - (*When we compare function names, we can directly compare the naming from the context if it exists.*) + (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) let isNamingOk = match b.vtype with | TFun(_, _, _, _) -> ( - let specific_method_context = List.find_opt (fun x -> match x with + let specific_method_rename_mapping = List.find_opt (fun x -> match x with | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname - ) method_contexts in - match specific_method_context with - | Some method_context -> method_context.original_method_name = a.vname && method_context.new_method_name = b.vname + ) method_rename_mappings in + match specific_method_rename_mapping with + | Some method_rename_mapping -> method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname | None -> a.vname = b.vname ) - | _ -> context_aware_name_comparison a.vname b.vname context + | _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping in (*If the following is a method call, we need to check if we have a mapping for that method call. *) - let typ_context = match b.vtype with + let typ_rename_mapping = match b.vtype with | TFun(_, _, _, _) -> ( let new_locals = List.find_opt (fun x -> match x with | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname - ) method_contexts in + ) method_rename_mappings in match new_locals with | Some locals -> - (*Printf.printf "Performing context switch. New context=%s\n" (context_to_string (locals.parameter_renames, method_contexts));*) - (locals.parameter_renames, method_contexts) - | None -> ([], method_contexts) + (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) + (locals.parameter_renames, method_rename_mappings) + | None -> ([], method_rename_mappings) ) - | _ -> context + | _ -> rename_mapping in - let typeCheck = eq_typ a.vtype b.vtype typ_context in - let attrCheck = GobList.equal (eq_attribute context) a.vattr b.vattr in + let typeCheck = eq_typ a.vtype b.vtype typ_rename_mapping in + let attrCheck = GobList.equal (eq_attribute rename_mapping) a.vattr b.vattr in let result = isNamingOk && typeCheck && attrCheck && a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in @@ -220,36 +220,36 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) (* Accumulator is needed because of recursive types: we have to assume that two types we already encountered in a previous step of the recursion are equivalent *) -and eq_compinfo (a: compinfo) (b: compinfo) (acc: (typ * typ) list) (context: context) = +and eq_compinfo (a: compinfo) (b: compinfo) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = a.cstruct = b.cstruct && compare_name a.cname b.cname && - GobList.equal (fun a b-> eq_fieldinfo a b acc context) a.cfields b.cfields && - GobList.equal (eq_attribute context) a.cattr b.cattr && + GobList.equal (fun a b-> eq_fieldinfo a b acc rename_mapping) a.cfields b.cfields && + GobList.equal (eq_attribute rename_mapping) a.cattr b.cattr && a.cdefined = b.cdefined (* Ignore ckey, and ignore creferenced *) -and eq_fieldinfo (a: fieldinfo) (b: fieldinfo) (acc: (typ * typ) list) (context: context) = +and eq_fieldinfo (a: fieldinfo) (b: fieldinfo) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = if Messages.tracing then Messages.tracei "compareast" "fieldinfo %s vs %s\n" a.fname b.fname; - let r = a.fname = b.fname && eq_typ_acc a.ftype b.ftype acc context && a.fbitfield = b.fbitfield && GobList.equal (eq_attribute context) a.fattr b.fattr in + let r = a.fname = b.fname && eq_typ_acc a.ftype b.ftype acc rename_mapping && a.fbitfield = b.fbitfield && GobList.equal (eq_attribute rename_mapping) a.fattr b.fattr in if Messages.tracing then Messages.traceu "compareast" "fieldinfo %s vs %s\n" a.fname b.fname; r -and eq_offset (a: offset) (b: offset) (context: context) = match a, b with +and eq_offset (a: offset) (b: offset) (rename_mapping: rename_mapping) = match a, b with NoOffset, NoOffset -> true - | Field (info1, offset1), Field (info2, offset2) -> eq_fieldinfo info1 info2 [] context && eq_offset offset1 offset2 context - | Index (exp1, offset1), Index (exp2, offset2) -> eq_exp exp1 exp2 context && eq_offset offset1 offset2 context + | Field (info1, offset1), Field (info2, offset2) -> eq_fieldinfo info1 info2 [] rename_mapping && eq_offset offset1 offset2 rename_mapping + | Index (exp1, offset1), Index (exp2, offset2) -> eq_exp exp1 exp2 rename_mapping && eq_offset offset1 offset2 rename_mapping | _, _ -> false -and eq_lval (a: lval) (b: lval) (context: context) = match a, b with - (host1, off1), (host2, off2) -> eq_lhost host1 host2 context && eq_offset off1 off2 context +and eq_lval (a: lval) (b: lval) (rename_mapping: rename_mapping) = match a, b with + (host1, off1), (host2, off2) -> eq_lhost host1 host2 rename_mapping && eq_offset off1 off2 rename_mapping -let eq_instr (context: context) (a: instr) (b: instr) = match a, b with - | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 context && eq_exp exp1 exp2 context +let eq_instr (rename_mapping: rename_mapping) (a: instr) (b: instr) = match a, b with + | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 rename_mapping && eq_exp exp1 exp2 rename_mapping | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> - eq_lval lv1 lv2 context && eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 + eq_lval lv1 lv2 rename_mapping && eq_exp f1 f2 rename_mapping && GobList.equal (eq_exp2 rename_mapping) args1 args2 | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> - eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 - | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2 context) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2 context) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) - | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 context + eq_exp f1 f2 rename_mapping && GobList.equal (eq_exp2 rename_mapping) args1 args2 + | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2 rename_mapping) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2 rename_mapping) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) + | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 rename_mapping | _, _ -> false let eq_label (a: label) (b: label) = match a, b with @@ -268,35 +268,35 @@ let eq_stmt_with_location ((a, af): stmt * fundec) ((b, bf): stmt * fundec) = through the cfg and only compares the currently visited node (The cil blocks inside an if statement should not be compared together with its condition to avoid a to early and not precise detection of a changed node inside). Switch, break and continue statements are removed during cfg preparation and therefore need not to be handeled *) -let rec eq_stmtkind ?(cfg_comp = false) ((a, af): stmtkind * fundec) ((b, bf): stmtkind * fundec) (context: context) = - let eq_block' = fun x y -> if cfg_comp then true else eq_block (x, af) (y, bf) context in +let rec eq_stmtkind ?(cfg_comp = false) ((a, af): stmtkind * fundec) ((b, bf): stmtkind * fundec) (rename_mapping: rename_mapping) = + let eq_block' = fun x y -> if cfg_comp then true else eq_block (x, af) (y, bf) rename_mapping in match a, b with - | Instr is1, Instr is2 -> GobList.equal (eq_instr context) is1 is2 - | Return (Some exp1, _l1), Return (Some exp2, _l2) -> eq_exp exp1 exp2 context + | Instr is1, Instr is2 -> GobList.equal (eq_instr rename_mapping) is1 is2 + | Return (Some exp1, _l1), Return (Some exp2, _l2) -> eq_exp exp1 exp2 rename_mapping | Return (None, _l1), Return (None, _l2) -> true | Return _, Return _ -> false | Goto (st1, _l1), Goto (st2, _l2) -> eq_stmt_with_location (!st1, af) (!st2, bf) | Break _, Break _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true | Continue _, Continue _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true - | If (exp1, then1, else1, _l1, _el1), If (exp2, then2, else2, _l2, _el2) -> eq_exp exp1 exp2 context && eq_block' then1 then2 && eq_block' else1 else2 - | Switch (exp1, block1, stmts1, _l1, _el1), Switch (exp2, block2, stmts2, _l2, _el2) -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else eq_exp exp1 exp2 context && eq_block' block1 block2 && GobList.equal (fun a b -> eq_stmt (a,af) (b,bf) context) stmts1 stmts2 + | If (exp1, then1, else1, _l1, _el1), If (exp2, then2, else2, _l2, _el2) -> eq_exp exp1 exp2 rename_mapping && eq_block' then1 then2 && eq_block' else1 else2 + | Switch (exp1, block1, stmts1, _l1, _el1), Switch (exp2, block2, stmts2, _l2, _el2) -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else eq_exp exp1 exp2 rename_mapping && eq_block' block1 block2 && GobList.equal (fun a b -> eq_stmt (a,af) (b,bf) rename_mapping) stmts1 stmts2 | Loop (block1, _l1, _el1, _con1, _br1), Loop (block2, _l2, _el2, _con2, _br2) -> eq_block' block1 block2 | Block block1, Block block2 -> eq_block' block1 block2 | _, _ -> false -and eq_stmt ?(cfg_comp = false) ((a, af): stmt * fundec) ((b, bf): stmt * fundec) (context: context) = +and eq_stmt ?(cfg_comp = false) ((a, af): stmt * fundec) ((b, bf): stmt * fundec) (rename_mapping: rename_mapping) = GobList.equal eq_label a.labels b.labels && - eq_stmtkind ~cfg_comp (a.skind, af) (b.skind, bf) context + eq_stmtkind ~cfg_comp (a.skind, af) (b.skind, bf) rename_mapping -and eq_block ((a, af): Cil.block * fundec) ((b, bf): Cil.block * fundec) (context: context) = - a.battrs = b.battrs && GobList.equal (fun x y -> eq_stmt (x, af) (y, bf) context) a.bstmts b.bstmts +and eq_block ((a, af): Cil.block * fundec) ((b, bf): Cil.block * fundec) (rename_mapping: rename_mapping) = + a.battrs = b.battrs && GobList.equal (fun x y -> eq_stmt (x, af) (y, bf) rename_mapping) a.bstmts b.bstmts -let rec eq_init (a: init) (b: init) (context: context) = match a, b with - | SingleInit e1, SingleInit e2 -> eq_exp e1 e2 context - | CompoundInit (t1, l1), CompoundInit (t2, l2) -> eq_typ t1 t2 context && GobList.equal (fun (o1, i1) (o2, i2) -> eq_offset o1 o2 context && eq_init i1 i2 context) l1 l2 +let rec eq_init (a: init) (b: init) (rename_mapping: rename_mapping) = match a, b with + | SingleInit e1, SingleInit e2 -> eq_exp e1 e2 rename_mapping + | CompoundInit (t1, l1), CompoundInit (t2, l2) -> eq_typ t1 t2 rename_mapping && GobList.equal (fun (o1, i1) (o2, i2) -> eq_offset o1 o2 rename_mapping && eq_init i1 i2 rename_mapping) l1 l2 | _, _ -> false -let eq_initinfo (a: initinfo) (b: initinfo) (context: context) = match a.init, b.init with - | (Some init_a), (Some init_b) -> eq_init init_a init_b context +let eq_initinfo (a: initinfo) (b: initinfo) (rename_mapping: rename_mapping) = match a.init, b.init with + | (Some init_a), (Some init_b) -> eq_init init_a init_b rename_mapping | None, None -> true | _, _ -> false \ No newline at end of file diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index a6fb5230d9..11bb246d01 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -4,28 +4,28 @@ open Cil include CompareAST let eq_node (x, fun1) (y, fun2) = - let empty_context: context = ([], []) in + let empty_rename_mapping: rename_mapping = ([], []) in match x,y with - | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_context - | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_context - | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar empty_context + | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping + | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping + | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping | _ -> false (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) let eq_edge x y = - let empty_context: context = ([], []) in + let empty_rename_mapping: rename_mapping = ([], []) in match x, y with - | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_context && eq_exp rv1 rv2 empty_context - | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_context && GobList.equal (eq_exp2 empty_context) ars1 ars2 + | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping && eq_exp rv1 rv2 empty_rename_mapping + | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 | Proc (Some r1,f1,ars1), Proc (Some r2,f2,ars2) -> - eq_lval r1 r2 empty_context && eq_exp f1 f2 empty_context && GobList.equal (eq_exp2 empty_context) ars1 ars2 - | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar empty_context - | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar empty_context - | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 empty_context && eq_varinfo fd1.svar fd2.svar empty_context - | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 empty_context && b1 = b2 + eq_lval r1 r2 empty_rename_mapping && eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 + | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping + | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar empty_rename_mapping + | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 empty_rename_mapping && eq_varinfo fd1.svar fd2.svar empty_rename_mapping + | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 empty_rename_mapping && b1 = b2 | ASM _, ASM _ -> false | Skip, Skip -> true - | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 empty_context + | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 empty_rename_mapping | SelfLoop, SelfLoop -> true | _ -> false diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index b8a64ae045..40fd0b877a 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -36,7 +36,7 @@ let should_reanalyze (fdec: Cil.fundec) = (* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) -let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_context: method_context list) = +let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumption list) = let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in if (List.length a.slocals) = (List.length b.slocals) then @@ -46,34 +46,34 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, - * and as a second a context, holding the rename assumptions *) - let rec context_aware_compare (alocals: varinfo list) (blocals: varinfo list) (context: local_rename list) = match alocals, blocals with - | [], [] -> true, context + * and as a second a rename_mapping, holding the rename assumptions *) + let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: local_rename_assumption list) = match alocals, blocals with + | [], [] -> true, rename_mapping | origLocal :: als, nowLocal :: bls -> - let newContext = if origLocal.vname = nowLocal.vname then context else context @ [(origLocal.vname, nowLocal.vname)] in + let new_rename_mapping = if origLocal.vname = nowLocal.vname then rename_mapping else rename_mapping @ [(origLocal.vname, nowLocal.vname)] in (*TODO: also call eq_varinfo*) - context_aware_compare als bls newContext - | _, _ -> false, context + rename_mapping_aware_compare als bls new_rename_mapping + | _, _ -> false, rename_mapping in - let headerSizeEqual, headerContext = context_aware_compare a.sformals b.sformals [] in - let actHeaderContext = (headerContext, global_context) in + let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals [] in + let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in - let unchangedHeader = eq_varinfo a.svar b.svar actHeaderContext && GobList.equal (eq_varinfo2 actHeaderContext) a.sformals b.sformals in + let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping && GobList.equal (eq_varinfo2 actHeaderRenameMapping) a.sformals b.sformals in let identical, diffOpt = if should_reanalyze a then false, None else (* Here the local variables are checked to be equal *) - let sizeEqual, local_rename = context_aware_compare a.slocals b.slocals headerContext in - let context: context = (local_rename, global_context) in + let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in + let rename_mapping: rename_mapping = (local_rename, global_rename_mapping) in let sameDef = unchangedHeader && sizeEqual in if not sameDef then (false, None) else match cfgs with - | None -> eq_block (a.sbody, a) (b.sbody, b) context, None + | None -> eq_block (a.sbody, a) (b.sbody, b) rename_mapping, None | Some (cfgOld, (cfgNew, cfgNewBack)) -> let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in @@ -83,9 +83,9 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo in identical, unchangedHeader, diffOpt -let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_context: method_context list) = match a, b with +let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_ammping: method_rename_assumption list) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt = eqF f g cfgs global_context in + let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_ammping in identical, unchangedHeader, diffOpt | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y ([], []), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) @@ -97,7 +97,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = then Some (CfgTools.getCFG oldAST |> fst, CfgTools.getCFG newAST) else None in - let generate_global_context map global = + let generate_global_rename_mapping map global = try let ident = identifier_of_global global in let old_global = GlobalMap.find ident map in @@ -131,12 +131,12 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let changes = empty_change_info () in global_typ_acc := []; - let findChanges map global global_context = + let findChanges map global global_rename_mapping = try let ident = identifier_of_global global in let old_global = GlobalMap.find ident map in (* Do a (recursive) equal comparison ignoring location information *) - let identical, unchangedHeader, diff = eq old_global global cfgs global_context in + let identical, unchangedHeader, diff = eq old_global global cfgs global_rename_mapping in if identical then changes.unchanged <- {current = global; old = old_global} :: changes.unchanged else changes.changed <- {current = global; old = old_global; unchangedHeader; diff} :: changes.changed @@ -151,16 +151,16 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in - let global_context: method_context list = Cil.foldGlobals newAST (fun (current_global_context: method_context list) global -> - match generate_global_context oldMap global with - | Some context -> current_global_context @ [context] - | None -> current_global_context + let global_rename_mapping: method_rename_assumption list = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> + match generate_global_rename_mapping oldMap global with + | Some rename_mapping -> current_global_rename_mapping @ [rename_mapping] + | None -> current_global_rename_mapping ) [] in (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) Cil.iterGlobals newAST - (fun glob -> findChanges oldMap glob global_context); + (fun glob -> findChanges oldMap glob global_rename_mapping); (* We check whether functions have been added or removed *) Cil.iterGlobals newAST (fun glob -> if not (checkExists oldMap glob) then changes.added <- (glob::changes.added)); From abf871b201b310f7901d55fbcc1f2e7beedcdde4 Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 9 May 2022 16:09:32 +0200 Subject: [PATCH 015/518] Replaced rename mapping lists with Hashtbls for increased performance --- src/incremental/compareAST.ml | 27 +++++++++------------ src/incremental/compareCFG.ml | 4 ++-- src/incremental/compareCIL.ml | 45 ++++++++++++++++++++++------------- 3 files changed, 41 insertions(+), 35 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index bc9ac84552..07e5d6ab83 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -5,22 +5,21 @@ type global_type = Fun | Decl | Var and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] -type local_rename_assumption = string * string -(**) -type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: (string * string) list} +type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: (string, string) Hashtbl.t} +type method_rename_assumptions = (string, method_rename_assumption) Hashtbl.t (*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type rename_mapping = (local_rename_assumption list) * (method_rename_assumption list) +type rename_mapping = ((string, string) Hashtbl.t) * (method_rename_assumptions) (*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) 2. there is no rename for name1 -> name1 = name2*) let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = let (local_c, method_c) = rename_mapping in - let existingAssumption: (string*string) option = List.find_opt (fun x -> match x with (original, now) -> original = name1) local_c in + let existingAssumption: string option = Hashtbl.find_opt local_c name1 in match existingAssumption with - | Some (original, now) -> + | Some now -> (*Printf.printf "Assumption is: %s -> %s\n" original now;*) now = name2 | None -> @@ -33,11 +32,11 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods) = rename_mapping in - let local_string = string_tuple_to_string local in - let methods_string: string = methods |> + let local_string = string_tuple_to_string (List.of_seq (Hashtbl.to_seq local)) in + let methods_string: string = List.of_seq (Hashtbl.to_seq_values methods) |> List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ - "; renamed_params=" ^ string_tuple_to_string parameter_renames ^ ")") |> + "; renamed_params=" ^ string_tuple_to_string (List.of_seq (Hashtbl.to_seq parameter_renames)) ^ ")") |> String.concat ", " in "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "])" @@ -180,9 +179,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) let isNamingOk = match b.vtype with | TFun(_, _, _, _) -> ( - let specific_method_rename_mapping = List.find_opt (fun x -> match x with - | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname - ) method_rename_mappings in + let specific_method_rename_mapping = Hashtbl.find_opt method_rename_mappings a.vname in match specific_method_rename_mapping with | Some method_rename_mapping -> method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname | None -> a.vname = b.vname @@ -193,15 +190,13 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*If the following is a method call, we need to check if we have a mapping for that method call. *) let typ_rename_mapping = match b.vtype with | TFun(_, _, _, _) -> ( - let new_locals = List.find_opt (fun x -> match x with - | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname - ) method_rename_mappings in + let new_locals = Hashtbl.find_opt method_rename_mappings a.vname in match new_locals with | Some locals -> (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) (locals.parameter_renames, method_rename_mappings) - | None -> ([], method_rename_mappings) + | None -> (Hashtbl.create 0, method_rename_mappings) ) | _ -> rename_mapping in diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 11bb246d01..f03176122a 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -4,7 +4,7 @@ open Cil include CompareAST let eq_node (x, fun1) (y, fun2) = - let empty_rename_mapping: rename_mapping = ([], []) in + let empty_rename_mapping: rename_mapping = (Hashtbl.create 0, Hashtbl.create 0) in match x,y with | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping @@ -13,7 +13,7 @@ let eq_node (x, fun1) (y, fun2) = (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) let eq_edge x y = - let empty_rename_mapping: rename_mapping = ([], []) in + let empty_rename_mapping: rename_mapping = (Hashtbl.create 0, Hashtbl.create 0) in match x, y with | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping && eq_exp rv1 rv2 empty_rename_mapping | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 40fd0b877a..f5817ae76e 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -36,7 +36,7 @@ let should_reanalyze (fdec: Cil.fundec) = (* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) -let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumption list) = +let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in if (List.length a.slocals) = (List.length b.slocals) then @@ -47,16 +47,17 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a rename_mapping, holding the rename assumptions *) - let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: local_rename_assumption list) = match alocals, blocals with + let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: (string, string) Hashtbl.t) = match alocals, blocals with | [], [] -> true, rename_mapping | origLocal :: als, nowLocal :: bls -> - let new_rename_mapping = if origLocal.vname = nowLocal.vname then rename_mapping else rename_mapping @ [(origLocal.vname, nowLocal.vname)] in - (*TODO: also call eq_varinfo*) - rename_mapping_aware_compare als bls new_rename_mapping + if origLocal.vname <> nowLocal.vname then Hashtbl.add rename_mapping origLocal.vname nowLocal.vname; + + (*TODO: maybe optimize this with eq_varinfo*) + rename_mapping_aware_compare als bls rename_mapping | _, _ -> false, rename_mapping in - let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals [] in + let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (Hashtbl.create 0) in let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping && GobList.equal (eq_varinfo2 actHeaderRenameMapping) a.sformals b.sformals in @@ -83,13 +84,13 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo in identical, unchangedHeader, diffOpt -let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_ammping: method_rename_assumption list) = match a, b with +let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_ammping in + let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_mapping in identical, unchangedHeader, diffOpt - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y ([], []), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y ([], []), false, None + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = @@ -104,13 +105,18 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = match old_global, global with | GFun(f, _), GFun (g, _) -> - let renamed_params: (string * string) list = if (List.length f.sformals) = (List.length g.sformals) then + let renamed_params: (string, string) Hashtbl.t = if (List.length f.sformals) = (List.length g.sformals) then List.combine f.sformals g.sformals |> List.filter (fun (original, now) -> not (original.vname = now.vname)) |> - List.map (fun (original, now) -> (original.vname, now.vname)) - else [] in - - if not (f.svar.vname = g.svar.vname) || (List.length renamed_params) > 0 then + List.map (fun (original, now) -> (original.vname, now.vname)) |> + (fun list -> + let table: (string, string) Hashtbl.t = Hashtbl.create (List.length list) in + List.iter (fun mapping -> Hashtbl.add table (fst mapping) (snd mapping)) list; + table + ) + else Hashtbl.create 0 in + + if not (f.svar.vname = g.svar.vname) || (Hashtbl.length renamed_params) > 0 then Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} else None | _, _ -> None @@ -151,11 +157,16 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in - let global_rename_mapping: method_rename_assumption list = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> + let global_rename_mapping: method_rename_assumptions = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> match generate_global_rename_mapping oldMap global with | Some rename_mapping -> current_global_rename_mapping @ [rename_mapping] | None -> current_global_rename_mapping - ) [] in + ) [] |> + (fun mappings -> + let table = Hashtbl.create (List.length mappings) in + List.iter (fun mapping -> Hashtbl.add table mapping.original_method_name mapping) mappings; + table + ) in (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) From 4745a3fc8292ac8fe9091b9a7f793b9fbe991652 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Sat, 14 May 2022 14:14:30 +0200 Subject: [PATCH 016/518] cleanup print statements and code. --- src/analyses/base.ml | 278 +++++++++++++++------------------- src/cdomains/baseDomain.ml | 6 +- src/framework/analyses.ml | 2 - src/incremental/compareAST.ml | 9 +- src/incremental/compareCFG.ml | 3 - src/incremental/compareCIL.ml | 5 +- 6 files changed, 125 insertions(+), 178 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 6e218bbfa0..8a15ec008c 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -650,9 +650,9 @@ struct | _ -> eval_next () in let r = - match exp with - | BinOp (op,arg1,arg2,_) -> binop op arg1 arg2 - | _ -> eval_next () + match exp with + | BinOp (op,arg1,arg2,_) -> binop op arg1 arg2 + | _ -> eval_next () in if M.tracing then M.traceu "evalint" "base eval_rv_ask_mustbeequal %a -> %a\n" d_exp exp VD.pretty r; r @@ -860,7 +860,7 @@ struct if M.tracing then M.tracel "eval" "eval_rv %a = %a\n" d_exp exp VD.pretty r; if VD.is_bot r then VD.top_value (Cilfacade.typeOf exp) else r with IntDomain.ArithmeticOnIntegerBot _ -> - ValueDomain.Compound.top_value (Cilfacade.typeOf exp) + ValueDomain.Compound.top_value (Cilfacade.typeOf exp) let query_evalint ask gs st e = if M.tracing then M.traceli "evalint" "base query_evalint %a\n" d_exp e; @@ -961,9 +961,9 @@ struct | _ -> Queries.Result.top q end | Q.EvalThread e -> begin - let v = eval_rv (Analyses.ask_of_ctx ctx) ctx.global ctx.local e in - (* ignore (Pretty.eprintf "evalthread %a (%a): %a" d_exp e d_plainexp e VD.pretty v); *) - match v with + let v = eval_rv (Analyses.ask_of_ctx ctx) ctx.global ctx.local e in + (* ignore (Pretty.eprintf "evalthread %a (%a): %a" d_exp e d_plainexp e VD.pretty v); *) + match v with | `Thread a -> a | `Bot -> Queries.Result.bot q (* TODO: remove *) | _ -> Queries.Result.top q @@ -1028,7 +1028,7 @@ struct match ID.to_int i1, ID.to_int i2 with | Some i1', Some i2' when Z.equal i1' i2' -> true | _ -> false - end + end | _ -> false end | Q.MayBeEqual (e1, e2) -> begin @@ -1097,8 +1097,8 @@ struct | _ -> st (** [set st addr val] returns a state where [addr] is set to [val] - * it is always ok to put None for lval_raw and rval_raw, this amounts to not using/maintaining - * precise information about arrays. *) + * it is always ok to put None for lval_raw and rval_raw, this amounts to not using/maintaining + * precise information about arrays. *) let set (a: Q.ask) ?(ctx=None) ?(invariant=false) ?lval_raw ?rval_raw ?t_override (gs:glob_fun) (st: store) (lval: AD.t) (lval_type: Cil.typ) (value: value) : store = let update_variable x t y z = if M.tracing then M.tracel "setosek" ~var:x.vname "update_variable: start '%s' '%a'\nto\n%a\n\n" x.vname VD.pretty y CPA.pretty z; @@ -1208,20 +1208,20 @@ struct VD.affect_move a v x (fun x -> None) else let patched_ask = - match ctx with - | Some ctx -> - (* The usual recursion trick for ctx. *) - (* Must change ctx used by ask to also use new st (not ctx.local), otherwise recursive EvalInt queries use outdated state. *) - (* Note: query is just called on base, but not any other analyses. Potentially imprecise, but seems to be sufficient for now. *) - let rec ctx' = - { ctx with - ask = (fun (type a) (q: a Queries.t) -> query ctx' q) - ; local = st - } - in - Analyses.ask_of_ctx ctx' - | _ -> - a + match ctx with + | Some ctx -> + (* The usual recursion trick for ctx. *) + (* Must change ctx used by ask to also use new st (not ctx.local), otherwise recursive EvalInt queries use outdated state. *) + (* Note: query is just called on base, but not any other analyses. Potentially imprecise, but seems to be sufficient for now. *) + let rec ctx' = + { ctx with + ask = (fun (type a) (q: a Queries.t) -> query ctx' q) + ; local = st + } + in + Analyses.ask_of_ctx ctx' + | _ -> + a in let moved_by = fun x -> Some 0 in (* this is ok, the information is not provided if it *) VD.affect_move patched_ask v x moved_by (* was a set call caused e.g. by a guard *) @@ -1287,9 +1287,9 @@ struct let f s v = rem_partitioning a s v in List.fold_left f st v_list - (************************************************************************** - * Auxillary functions - **************************************************************************) + (************************************************************************** + * Auxillary functions + **************************************************************************) let is_some_bot x = match x with @@ -1305,10 +1305,10 @@ struct | Eq, x, value, true -> if M.tracing then M.tracec "invariant" "Yes, %a equals %a\n" d_lval x VD.pretty value; (match value with - | `Int n -> - let ikind = Cilfacade.get_ikind_exp (Lval lval) in - Some (x, `Int (ID.cast_to ikind n)) - | _ -> Some(x, value)) + | `Int n -> + let ikind = Cilfacade.get_ikind_exp (Lval lval) in + Some (x, `Int (ID.cast_to ikind n)) + | _ -> Some(x, value)) (* The false-branch for x == value: *) | Eq, x, value, false -> begin match value with @@ -1343,25 +1343,25 @@ struct | Lt, x, value, _ -> begin match value with | `Int n -> begin - let ikind = Cilfacade.get_ikind_exp (Lval lval) in - let n = ID.cast_to ikind n in - let range_from x = if tv then ID.ending ikind (BI.sub x BI.one) else ID.starting ikind x in - let limit_from = if tv then ID.maximal else ID.minimal in - match limit_from n with - | Some n -> - if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" d_lval x (BI.to_string n); - Some (x, `Int (range_from n)) - | None -> None + let ikind = Cilfacade.get_ikind_exp (Lval lval) in + let n = ID.cast_to ikind n in + let range_from x = if tv then ID.ending ikind (BI.sub x BI.one) else ID.starting ikind x in + let limit_from = if tv then ID.maximal else ID.minimal in + match limit_from n with + | Some n -> + if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" d_lval x (BI.to_string n); + Some (x, `Int (range_from n)) + | None -> None end | _ -> None end | Le, x, value, _ -> begin match value with | `Int n -> begin - let ikind = Cilfacade.get_ikind_exp (Lval lval) in - let n = ID.cast_to ikind n in - let range_from x = if tv then ID.ending ikind x else ID.starting ikind (BI.add x BI.one) in - let limit_from = if tv then ID.maximal else ID.minimal in + let ikind = Cilfacade.get_ikind_exp (Lval lval) in + let n = ID.cast_to ikind n in + let range_from x = if tv then ID.ending ikind x else ID.starting ikind (BI.add x BI.one) in + let limit_from = if tv then ID.maximal else ID.minimal in match limit_from n with | Some n -> if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" d_lval x (BI.to_string n); @@ -1393,15 +1393,15 @@ struct -> derived_invariant (BinOp (op, c1, c2, t)) tv | BinOp(op, CastE (TInt (ik, _) as t1, Lval x), rval, typ) -> (match eval_rv a gs st (Lval x) with - | `Int v -> - (* This is tricky: It it is not sufficient to check that ID.cast_to_ik v = v - * If there is one domain that knows this to be true and the other does not, we - * should still impose the invariant. E.g. i -> ([1,5]; Not {0}[byte]) *) - if VD.is_safe_cast t1 (Cilfacade.typeOfLval x) then - derived_invariant (BinOp (op, Lval x, rval, typ)) tv - else - None - | _ -> None) + | `Int v -> + (* This is tricky: It it is not sufficient to check that ID.cast_to_ik v = v + * If there is one domain that knows this to be true and the other does not, we + * should still impose the invariant. E.g. i -> ([1,5]; Not {0}[byte]) *) + if VD.is_safe_cast t1 (Cilfacade.typeOfLval x) then + derived_invariant (BinOp (op, Lval x, rval, typ)) tv + else + None + | _ -> None) | BinOp(op, rval, CastE (TInt (_, _) as ti, Lval x), typ) -> derived_invariant (BinOp (switchedOp op, CastE(ti, Lval x), rval, typ)) tv (* Cases like if (x) are treated like if (x != 0) *) @@ -1459,7 +1459,7 @@ struct let warn_and_top_on_zero x = if GobOption.exists (BI.equal BI.zero) (ID.to_int x) then (M.warn "Must Undefined Behavior: Second argument of div or mod is 0, continuing with top"; - ID.top_of ikind) + ID.top_of ikind) else x in @@ -1479,9 +1479,9 @@ struct (* Only multiplication with odd numbers is an invertible operation in (mod 2^n) *) (* refine x by information about y, using x * y == c *) let refine_by x y = (match ID.to_int y with - | None -> x - | Some v when BI.equal (BI.rem v (BI.of_int 2)) BI.zero (* v % 2 = 0 *) -> x (* A refinement would still be possible here, but has to take non-injectivity into account. *) - | Some v (* when Int64.rem v 2L = 1L *) -> ID.meet x (ID.div c y)) (* Div is ok here, c must be divisible by a and b *) + | None -> x + | Some v when BI.equal (BI.rem v (BI.of_int 2)) BI.zero (* v % 2 = 0 *) -> x (* A refinement would still be possible here, but has to take non-injectivity into account. *) + | Some v (* when Int64.rem v 2L = 1L *) -> ID.meet x (ID.div c y)) (* Div is ok here, c must be divisible by a and b *) in (refine_by a b, refine_by b a) | MinusA -> meet_non ID.add ID.sub @@ -1536,37 +1536,37 @@ struct let both x = x, x in let m = ID.meet a b in (match op, ID.to_bool c with - | Eq, Some true - | Ne, Some false -> both m (* def. equal: if they compare equal, both values must be from the meet *) - | Eq, Some false - | Ne, Some true -> (* def. unequal *) - (* Both values can not be in the meet together, but it's not sound to exclude the meet from both. - * e.g. a=[0,1], b=[1,2], meet a b = [1,1], but (a != b) does not imply a=[0,0], b=[2,2] since others are possible: a=[1,1], b=[2,2] - * Only if a is a definite value, we can exclude it from b: *) - let excl a b = match ID.to_int a with Some x -> ID.of_excl_list ikind [x] | None -> b in - let a' = excl b a in - let b' = excl a b in - if M.tracing then M.tracel "inv" "inv_bin_int: unequal: %a and %a; ikind: %a; a': %a, b': %a\n" ID.pretty a ID.pretty b d_ikind ikind ID.pretty a' ID.pretty b'; - meet_bin a' b' - | _, _ -> a, b + | Eq, Some true + | Ne, Some false -> both m (* def. equal: if they compare equal, both values must be from the meet *) + | Eq, Some false + | Ne, Some true -> (* def. unequal *) + (* Both values can not be in the meet together, but it's not sound to exclude the meet from both. + * e.g. a=[0,1], b=[1,2], meet a b = [1,1], but (a != b) does not imply a=[0,0], b=[2,2] since others are possible: a=[1,1], b=[2,2] + * Only if a is a definite value, we can exclude it from b: *) + let excl a b = match ID.to_int a with Some x -> ID.of_excl_list ikind [x] | None -> b in + let a' = excl b a in + let b' = excl a b in + if M.tracing then M.tracel "inv" "inv_bin_int: unequal: %a and %a; ikind: %a; a': %a, b': %a\n" ID.pretty a ID.pretty b d_ikind ikind ID.pretty a' ID.pretty b'; + meet_bin a' b' + | _, _ -> a, b ) | Lt | Le | Ge | Gt as op -> let pred x = BI.sub x BI.one in let succ x = BI.add x BI.one in (match ID.minimal a, ID.maximal a, ID.minimal b, ID.maximal b with - | Some l1, Some u1, Some l2, Some u2 -> - (* if M.tracing then M.tracel "inv" "Op: %s, l1: %Ld, u1: %Ld, l2: %Ld, u2: %Ld\n" (show_binop op) l1 u1 l2 u2; *) - (match op, ID.to_bool c with - | Le, Some true - | Gt, Some false -> meet_bin (ID.ending ikind u2) (ID.starting ikind l1) - | Ge, Some true - | Lt, Some false -> meet_bin (ID.starting ikind l2) (ID.ending ikind u1) - | Lt, Some true - | Ge, Some false -> meet_bin (ID.ending ikind (pred u2)) (ID.starting ikind (succ l1)) - | Gt, Some true - | Le, Some false -> meet_bin (ID.starting ikind (succ l2)) (ID.ending ikind (pred u1)) - | _, _ -> a, b) - | _ -> a, b) + | Some l1, Some u1, Some l2, Some u2 -> + (* if M.tracing then M.tracel "inv" "Op: %s, l1: %Ld, u1: %Ld, l2: %Ld, u2: %Ld\n" (show_binop op) l1 u1 l2 u2; *) + (match op, ID.to_bool c with + | Le, Some true + | Gt, Some false -> meet_bin (ID.ending ikind u2) (ID.starting ikind l1) + | Ge, Some true + | Lt, Some false -> meet_bin (ID.starting ikind l2) (ID.ending ikind u1) + | Lt, Some true + | Ge, Some false -> meet_bin (ID.ending ikind (pred u2)) (ID.starting ikind (succ l1)) + | Gt, Some true + | Le, Some false -> meet_bin (ID.starting ikind (succ l2)) (ID.ending ikind (pred u1)) + | _, _ -> a, b) + | _ -> a, b) | BOr | BXor as op-> if M.tracing then M.tracel "inv" "Unhandled operator %a\n" d_binop op; (* Be careful: inv_exp performs a meet on both arguments of the BOr / BXor. *) @@ -1600,15 +1600,15 @@ struct | BinOp (op, e1, e2, _) as e -> if M.tracing then M.tracel "inv" "binop %a with %a %a %a == %a\n" d_exp e VD.pretty (eval e1 st) d_binop op VD.pretty (eval e2 st) ID.pretty c; (match eval e1 st, eval e2 st with - | `Int a, `Int b -> - let ikind = Cilfacade.get_ikind_exp e1 in (* both operands have the same type (except for Shiftlt, Shiftrt)! *) - let a', b' = inv_bin_int (a, b) ikind c op in - if M.tracing then M.tracel "inv" "binop: %a, a': %a, b': %a\n" d_exp e ID.pretty a' ID.pretty b'; - let st' = inv_exp a' e1 st in - let st'' = inv_exp b' e2 st' in - st'' - (* | `Address a, `Address b -> ... *) - | a1, a2 -> fallback ("binop: got abstract values that are not `Int: " ^ sprint VD.pretty a1 ^ " and " ^ sprint VD.pretty a2) st) + | `Int a, `Int b -> + let ikind = Cilfacade.get_ikind_exp e1 in (* both operands have the same type (except for Shiftlt, Shiftrt)! *) + let a', b' = inv_bin_int (a, b) ikind c op in + if M.tracing then M.tracel "inv" "binop: %a, a': %a, b': %a\n" d_exp e ID.pretty a' ID.pretty b'; + let st' = inv_exp a' e1 st in + let st'' = inv_exp b' e2 st' in + st'' + (* | `Address a, `Address b -> ... *) + | a1, a2 -> fallback ("binop: got abstract values that are not `Int: " ^ sprint VD.pretty a1 ^ " and " ^ sprint VD.pretty a2) st) | Lval x -> (* meet x with c *) let t = Cil.unrollType (Cilfacade.typeOfLval x) in (* unroll type to deal with TNamed *) let c' = match t with @@ -1642,18 +1642,18 @@ struct | CastE ((TInt (ik, _)) as t, e) | CastE ((TEnum ({ekind = ik; _ }, _)) as t, e) -> (* Can only meet the t part of an Lval in e with c (unless we meet with all overflow possibilities)! Since there is no good way to do this, we only continue if e has no values outside of t. *) (match eval e st with - | `Int i -> - if ID.leq i (ID.cast_to ik i) then + | `Int i -> + if ID.leq i (ID.cast_to ik i) then match Cilfacade.typeOf e with - | TInt(ik_e, _) - | TEnum ({ekind = ik_e; _ }, _) -> - let c' = ID.cast_to ik_e c in - if M.tracing then M.tracel "inv" "cast: %a from %a to %a: i = %a; cast c = %a to %a = %a\n" d_exp e d_ikind ik_e d_ikind ik ID.pretty i ID.pretty c d_ikind ik_e ID.pretty c'; - inv_exp c' e st - | x -> fallback ("CastE: e did evaluate to `Int, but the type did not match" ^ sprint d_type t) st - else - fallback ("CastE: " ^ sprint d_plainexp e ^ " evaluates to " ^ sprint ID.pretty i ^ " which is bigger than the type it is cast to which is " ^ sprint d_type t) st - | v -> fallback ("CastE: e did not evaluate to `Int, but " ^ sprint VD.pretty v) st) + | TInt(ik_e, _) + | TEnum ({ekind = ik_e; _ }, _) -> + let c' = ID.cast_to ik_e c in + if M.tracing then M.tracel "inv" "cast: %a from %a to %a: i = %a; cast c = %a to %a = %a\n" d_exp e d_ikind ik_e d_ikind ik ID.pretty i ID.pretty c d_ikind ik_e ID.pretty c'; + inv_exp c' e st + | x -> fallback ("CastE: e did evaluate to `Int, but the type did not match" ^ sprint d_type t) st + else + fallback ("CastE: " ^ sprint d_plainexp e ^ " evaluates to " ^ sprint ID.pretty i ^ " which is bigger than the type it is cast to which is " ^ sprint d_type t) st + | v -> fallback ("CastE: e did not evaluate to `Int, but " ^ sprint VD.pretty v) st) | e -> fallback (sprint d_plainexp e ^ " not implemented") st in if eval_bool exp st = Some (not tv) then raise Deadcode (* we already know that the branch is dead *) @@ -1728,7 +1728,7 @@ struct in match is_list_init () with | Some a when (get_bool "exp.list-type") -> - set ~ctx:(Some ctx) (Analyses.ask_of_ctx ctx) ctx.global ctx.local (AD.singleton (Addr.from_var a)) lval_t (`List (ValueDomain.Lists.bot ())) + set ~ctx:(Some ctx) (Analyses.ask_of_ctx ctx) ctx.global ctx.local (AD.singleton (Addr.from_var a)) lval_t (`List (ValueDomain.Lists.bot ())) | _ -> let rval_val = eval_rv (Analyses.ask_of_ctx ctx) ctx.global ctx.local rval in let lval_val = eval_lv (Analyses.ask_of_ctx ctx) ctx.global ctx.local lval in @@ -1743,16 +1743,16 @@ struct AD.is_top xs || AD.exists not_local xs in (match rval_val, lval_val with - | `Address adrs, lval - when (not !GU.global_initialization) && get_bool "kernel" && not_local lval && not (AD.is_top adrs) -> - let find_fps e xs = match Addr.to_var_must e with - | Some x -> x :: xs - | None -> xs - in - let vars = AD.fold find_fps adrs [] in (* filter_map from AD to list *) - let funs = List.filter (fun x -> isFunctionType x.vtype) vars in - List.iter (fun x -> ctx.spawn None x []) funs - | _ -> () + | `Address adrs, lval + when (not !GU.global_initialization) && get_bool "kernel" && not_local lval && not (AD.is_top adrs) -> + let find_fps e xs = match Addr.to_var_must e with + | Some x -> x :: xs + | None -> xs + in + let vars = AD.fold find_fps adrs [] in (* filter_map from AD to list *) + let funs = List.filter (fun x -> isFunctionType x.vtype) vars in + List.iter (fun x -> ctx.spawn None x []) funs + | _ -> () ); match lval with (* this section ensure global variables contain bottom values of the proper type before setting them *) | (Var v, offs) when AD.is_definite lval_val && v.vglob -> @@ -1861,7 +1861,7 @@ struct | _ -> () end; set ~ctx:(Some ctx) ~t_override (Analyses.ask_of_ctx ctx) ctx.global nst (return_var ()) t_override rv - (* lval_raw:None, and rval_raw:None is correct here *) + (* lval_raw:None, and rval_raw:None is correct here *) let vdecl ctx (v:varinfo) = if not (Cil.isArrayType v.vtype) then @@ -2015,45 +2015,6 @@ struct | _ -> [] let assert_fn ctx e should_warn change = - let _ = Hashtbl.iter (fun fun_name map -> - begin - Printf.printf "%s: [" fun_name; - Hashtbl.iter (fun from tox -> Printf.printf "%s -> %s; " from tox) map; - Printf.printf "]\n"; - end - ) !CompareCIL.rename_map in - - let parent_function: fundec = Node.find_fundec ctx.node in - - (*Performs the actual rename on lvals for renamed local variables.*) - let rename_lval lhost offset = - let new_lhost = match lhost with - | Var varinfo -> - varinfo.vname <- CompareCIL.get_local_rename parent_function.svar.vname varinfo.vname; - Var varinfo - | _ -> lhost - in - (new_lhost, offset) - in - - (*Recusivly go through the expression and rename all occurences of local variables. TODO: What happens with global vars*) - let rec rename_exp (exp: exp) = match exp with - | Lval (lhost, offset) -> Lval (rename_lval lhost offset) - | Real e -> Real (rename_exp e) - | Imag e -> Imag (rename_exp e) - | SizeOfE e -> SizeOfE (rename_exp e) - | AlignOfE e -> AlignOfE (rename_exp e) - | UnOp (unop, e, typ) -> UnOp (unop, rename_exp e, typ) - | BinOp (binop, e1, e2, typ) -> BinOp (binop, rename_exp e1, rename_exp e2, typ) - | Question (e1, e2, e3, typ) -> Question (rename_exp e1, rename_exp e2, rename_exp e3, typ) - | CastE (typ, e) -> CastE (typ, rename_exp e) - | AddrOf (lhost, offset) -> AddrOf (rename_lval lhost offset) - | StartOf (lhost, offset) -> StartOf (rename_lval lhost offset) - (*TODO: AddrOfLabel?*) - | _ -> exp - in - - let check_assert e st = match eval_rv (Analyses.ask_of_ctx ctx) ctx.global st e with | `Int v when ID.is_bool v -> @@ -2065,7 +2026,7 @@ struct | `Bot -> `Bot | _ -> `Top in - let expr = sprint d_exp (rename_exp e) in + let expr = sprint d_exp e in let warn warn_fn ?annot msg = if should_warn then if get_bool "dbg.regression" then ( (* This only prints unexpected results (with the difference) as indicated by the comment behind the assert (same as used by the regression test script). *) let loc = !M.current_loc in @@ -2125,9 +2086,6 @@ struct invalidate ~ctx (Analyses.ask_of_ctx ctx) gs st addrs let special ctx (lv:lval option) (f: varinfo) (args: exp list) = - Printf.printf "special: varinfo=%s\n" f.vname; - List.iter (fun x -> ignore @@ Pretty.printf "%a\n" Cil.d_exp x;) args; - let invalidate_ret_lv st = match lv with | Some lv -> if M.tracing then M.tracel "invalidate" "Invalidating lhs %a for function call %s\n" d_plainlval lv f.vname; @@ -2274,7 +2232,7 @@ struct in (* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ctx.ask gs st size); *) set_many ~ctx (Analyses.ask_of_ctx ctx) gs st [(heap_var, TVoid [], `Blob (VD.bot (), eval_int (Analyses.ask_of_ctx ctx) gs st size, true)); - (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), `Address heap_var)] + (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), `Address heap_var)] | _ -> st end | `Calloc (n, size) -> @@ -2287,7 +2245,7 @@ struct else addr 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 (Analyses.ask_of_ctx ctx) gs st [(add_null (AD.from_var heap_var), TVoid [], `Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.one) (`Blob (VD.bot (), eval_int (Analyses.ask_of_ctx ctx) gs st size, false)))); - (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), `Address (add_null (AD.from_var_offset (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset)))))] + (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), `Address (add_null (AD.from_var_offset (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset)))))] | _ -> st end | `Unknown "__goblint_unknown" -> diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml index dc2b63a95f..3533f0e8a2 100644 --- a/src/cdomains/baseDomain.ml +++ b/src/cdomains/baseDomain.ml @@ -108,11 +108,9 @@ struct ++ text ")" let printXml f r = - CPA.iter (fun key value -> key.vname <- (CompareCIL.get_local_rename (!Analyses.currentFunctionName) key.vname)) r.cpa; - let e = XmlUtil.escape in - BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n\n%s\n\n%a\n\n" - (e @@ (CPA.name () ^ "ASSSSSSS")) CPA.printXml r.cpa + BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n\n%s\n\n%a\n\n" + (e @@ (CPA.name ())) CPA.printXml r.cpa (e @@ PartDeps.name ()) PartDeps.printXml r.deps (e @@ WeakUpdates.name ()) WeakUpdates.printXml r.weak (e @@ PrivD.name ()) PrivD.printXml r.priv diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 0d00ac672a..7314427034 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -191,8 +191,6 @@ struct match get_string "result" with | "pretty" -> ignore (fprintf out "%a\n" pretty (Lazy.force table)) | "fast_xml" -> - Printf.printf "%s" (Printexc.get_callstack 15 |> Printexc.raw_backtrace_to_string); - let module SH = BatHashtbl.Make (Basetype.RawStrings) in let file2funs = SH.create 100 in let funs2node = SH.create 100 in diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index d9361ec082..e226f92b99 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -191,7 +191,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = in (*If the following is a method call, we need to check if we have a mapping for that method call. *) - let typ_context, did_context_switch = match b.vtype with + let typ_context = match b.vtype with | TFun(_, _, _, _) -> ( let new_locals = List.find_opt (fun x -> match x with | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname @@ -200,10 +200,10 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = match new_locals with | Some locals -> (*Printf.printf "Performing context switch. New context=%s\n" (context_to_string (locals.parameter_renames, method_contexts));*) - (locals.parameter_renames, method_contexts), true - | None -> ([], method_contexts), false + (locals.parameter_renames, method_contexts) + | None -> ([], method_contexts) ) - | _ -> context, false + | _ -> context in let typeCheck = eq_typ a.vtype b.vtype typ_context in @@ -215,7 +215,6 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = (*a.vname = b.vname*) let result = isNamingOk && typeCheck && attrCheck && a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in - if did_context_switch then Printf.printf "Undo context switch \n"; result (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 25b5f64ccf..e87df4f832 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -47,8 +47,6 @@ module NTH = Hashtbl.Make( * process on their successors. If a node from the old CFG can not be matched, it is added to diff and no further * comparison is done for its successors. The two function entry nodes make up the tuple to start the comparison from. *) let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 fun2 = - let _ = Printf.printf "ComparingCfgs" in - let diff = NH.create 113 in let same = NTH.create 113 in let waitingList : (node * node) t = Queue.create () in @@ -132,7 +130,6 @@ let reexamine f1 f2 (same : unit NTH.t) (diffNodes1 : unit NH.t) (module CfgOld (NTH.to_seq_keys same, NH.to_seq_keys diffNodes1, NH.to_seq_keys diffNodes2) let compareFun (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 fun2 = - let _ = Printf.printf "Comparing funs" in let same, diff = compareCfgs (module CfgOld) (module CfgNew) fun1 fun2 in let unchanged, diffNodes1, diffNodes2 = reexamine fun1 fun2 same diff (module CfgOld) (module CfgNew) in List.of_seq unchanged, List.of_seq diffNodes1, List.of_seq diffNodes2 diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 762d6fbac5..0b1ea5329b 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -102,7 +102,7 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_cont let sizeEqual, local_rename = context_aware_compare a.slocals b.slocals headerContext in let context: context = (local_rename, global_context) in - let _ = Printf.printf "Context=%s\n" (CompareAST.context_to_string context) in + (*let _ = Printf.printf "Context=%s\n" (CompareAST.context_to_string context) in*) let sameDef = unchangedHeader && sizeEqual in if not sameDef then @@ -112,7 +112,6 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * cfg) option) (global_cont | None -> eq_block (a.sbody, a) (b.sbody, b) context, None | Some (cfgOld, cfgNew) -> - Printf.printf "compareCIL.eqF: Compaing 2 cfgs now\n"; let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgForward = struct let next = cfgNew end in let matches, diffNodes1, diffNodes2 = compareFun (module CfgOld) (module CfgNew) a b in @@ -134,8 +133,6 @@ let eq_glob (a: global) (b: global) (cfgs : (cfg * cfg) option) (global_context: | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = - let _ = Printf.printf "Comparing Cil files\n" in - let cfgs = if GobConfig.get_string "incremental.compare" = "cfg" then Some (CfgTools.getCFG oldAST |> fst, CfgTools.getCFG newAST |> fst) else None in From c645c682184e5bcc4df762a565fa040da0d592b9 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Sat, 14 May 2022 15:01:28 +0200 Subject: [PATCH 017/518] cherry picked context -> rename mapping --- src/incremental/compareAST.ml | 230 +++++++++++++++++----------------- src/incremental/compareCFG.ml | 28 ++--- src/incremental/compareCIL.ml | 47 +++---- 3 files changed, 147 insertions(+), 158 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index e226f92b99..36662c8c81 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -5,18 +5,18 @@ type global_type = Fun | Decl | Var and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] -type local_rename = string * string +type local_rename_assumption = string * string (**) -type method_context = {original_method_name: string; new_method_name: string; parameter_renames: (string * string) list} +type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: (string * string) list} -(*context is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type context = (local_rename list) * (method_context list) +(*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) +type rename_mapping = (local_rename_assumption list) * (method_rename_assumption list) -(*Compares two names, being aware of the context. Returns true iff: +(*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) 2. there is no rename for name1 -> name1 = name2*) -let context_aware_name_comparison (name1: string) (name2: string) (context: context) = - let (local_c, method_c) = context in +let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = + let (local_c, method_c) = rename_mapping in let existingAssumption: (string*string) option = List.find_opt (fun x -> match x with (original, now) -> original = name1) local_c in match existingAssumption with @@ -31,8 +31,8 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> List.map (fun x -> match x with (first, second) -> "(" ^ first ^ " -> " ^ second ^ ")") |> String.concat ", ") ^ "]" -let context_to_string (context: context) = - let (local, methods) = context in +let rename_mapping_to_string (rename_mapping: rename_mapping) = + let (local, methods) = rename_mapping in let local_string = string_tuple_to_string local in let methods_string: string = methods |> List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> @@ -59,33 +59,33 @@ let compare_name (a: string) (b: string) = let anon_union = "__anonunion_" in if a = b then true else BatString.(starts_with a anon_struct && starts_with b anon_struct || starts_with a anon_union && starts_with b anon_union) -let rec eq_constant (context: context) (a: constant) (b: constant) = +let rec eq_constant (rename_mapping: rename_mapping) (a: constant) (b: constant) = match a, b with | CInt (val1, kind1, str1), CInt (val2, kind2, str2) -> Cilint.compare_cilint val1 val2 = 0 && kind1 = kind2 (* Ignore string representation, i.e. 0x2 == 2 *) - | CEnum (exp1, str1, enuminfo1), CEnum (exp2, str2, enuminfo2) -> eq_exp exp1 exp2 context (* Ignore name and enuminfo *) + | CEnum (exp1, str1, enuminfo1), CEnum (exp2, str2, enuminfo2) -> eq_exp exp1 exp2 rename_mapping (* Ignore name and enuminfo *) | a, b -> a = b -and eq_exp2 (context: context) (a: exp) (b: exp) = eq_exp a b context +and eq_exp2 (rename_mapping: rename_mapping) (a: exp) (b: exp) = eq_exp a b rename_mapping -and eq_exp (a: exp) (b: exp) (context: context) = +and eq_exp (a: exp) (b: exp) (rename_mapping: rename_mapping) = match a, b with - | Const c1, Const c2 -> eq_constant context c1 c2 - | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 context - | SizeOf typ1, SizeOf typ2 -> eq_typ typ1 typ2 context - | SizeOfE exp1, SizeOfE exp2 -> eq_exp exp1 exp2 context + | Const c1, Const c2 -> eq_constant rename_mapping c1 c2 + | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 rename_mapping + | SizeOf typ1, SizeOf typ2 -> eq_typ typ1 typ2 rename_mapping + | SizeOfE exp1, SizeOfE exp2 -> eq_exp exp1 exp2 rename_mapping | SizeOfStr str1, SizeOfStr str2 -> str1 = str2 (* possibly, having the same length would suffice *) - | AlignOf typ1, AlignOf typ2 -> eq_typ typ1 typ2 context - | AlignOfE exp1, AlignOfE exp2 -> eq_exp exp1 exp2 context - | UnOp (op1, exp1, typ1), UnOp (op2, exp2, typ2) -> op1 == op2 && eq_exp exp1 exp2 context && eq_typ typ1 typ2 context - | BinOp (op1, left1, right1, typ1), BinOp (op2, left2, right2, typ2) -> op1 = op2 && eq_exp left1 left2 context && eq_exp right1 right2 context && eq_typ typ1 typ2 context - | CastE (typ1, exp1), CastE (typ2, exp2) -> eq_typ typ1 typ2 context && eq_exp exp1 exp2 context - | AddrOf lv1, AddrOf lv2 -> eq_lval lv1 lv2 context - | StartOf lv1, StartOf lv2 -> eq_lval lv1 lv2 context + | AlignOf typ1, AlignOf typ2 -> eq_typ typ1 typ2 rename_mapping + | AlignOfE exp1, AlignOfE exp2 -> eq_exp exp1 exp2 rename_mapping + | UnOp (op1, exp1, typ1), UnOp (op2, exp2, typ2) -> op1 == op2 && eq_exp exp1 exp2 rename_mapping && eq_typ typ1 typ2 rename_mapping + | BinOp (op1, left1, right1, typ1), BinOp (op2, left2, right2, typ2) -> op1 = op2 && eq_exp left1 left2 rename_mapping && eq_exp right1 right2 rename_mapping && eq_typ typ1 typ2 rename_mapping + | CastE (typ1, exp1), CastE (typ2, exp2) -> eq_typ typ1 typ2 rename_mapping && eq_exp exp1 exp2 rename_mapping + | AddrOf lv1, AddrOf lv2 -> eq_lval lv1 lv2 rename_mapping + | StartOf lv1, StartOf lv2 -> eq_lval lv1 lv2 rename_mapping | _, _ -> false -and eq_lhost (a: lhost) (b: lhost) (context: context) = match a, b with - Var v1, Var v2 -> eq_varinfo v1 v2 context - | Mem exp1, Mem exp2 -> eq_exp exp1 exp2 context +and eq_lhost (a: lhost) (b: lhost) (rename_mapping: rename_mapping) = match a, b with + Var v1, Var v2 -> eq_varinfo v1 v2 rename_mapping + | Mem exp1, Mem exp2 -> eq_exp exp1 exp2 rename_mapping | _, _ -> false and global_typ_acc: (typ * typ) list ref = ref [] (* TODO: optimize with physical Hashtbl? *) @@ -94,21 +94,21 @@ and mem_typ_acc (a: typ) (b: typ) acc = List.exists (fun p -> match p with (x, y and pretty_length () l = Pretty.num (List.length l) -and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (context: context) = +and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = if Messages.tracing then Messages.tracei "compareast" "eq_typ_acc %a vs %a (%a, %a)\n" d_type a d_type b pretty_length acc pretty_length !global_typ_acc; (* %a makes List.length calls lazy if compareast isn't being traced *) let r = match a, b with - | TPtr (typ1, attr1), TPtr (typ2, attr2) -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 - | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc context && eq_exp lenExp1 lenExp2 context && GobList.equal (eq_attribute context) attr1 attr2 - | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 + | TPtr (typ1, attr1), TPtr (typ2, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && eq_exp lenExp1 lenExp2 rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_args context acc) list1 list2 && varArg1 = varArg2 && - GobList.equal (eq_attribute context) attr1 attr2 + -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_args rename_mapping acc) list1 list2 && varArg1 = varArg2 && + GobList.equal (eq_attribute rename_mapping) attr1 attr2 | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc context && varArg1 = varArg2 && - GobList.equal (eq_attribute context) attr1 attr2 - | TNamed (typinfo1, attr1), TNamed (typeinfo2, attr2) -> eq_typ_acc typinfo1.ttype typeinfo2.ttype acc context && GobList.equal (eq_attribute context) attr1 attr2 (* Ignore tname, treferenced *) - | TNamed (tinf, attr), b -> eq_typ_acc tinf.ttype b acc context (* Ignore tname, treferenced. TODO: dismiss attributes, or not? *) - | a, TNamed (tinf, attr) -> eq_typ_acc a tinf.ttype acc context (* Ignore tname, treferenced . TODO: dismiss attributes, or not? *) + -> eq_typ_acc typ1 typ2 acc rename_mapping && varArg1 = varArg2 && + GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TNamed (typinfo1, attr1), TNamed (typeinfo2, attr2) -> eq_typ_acc typinfo1.ttype typeinfo2.ttype acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 (* Ignore tname, treferenced *) + | TNamed (tinf, attr), b -> eq_typ_acc tinf.ttype b acc rename_mapping (* Ignore tname, treferenced. TODO: dismiss attributes, or not? *) + | a, TNamed (tinf, attr) -> eq_typ_acc a tinf.ttype acc rename_mapping (* Ignore tname, treferenced . TODO: dismiss attributes, or not? *) (* The following two lines are a hack to ensure that anonymous types get the same name and thus, the same typsig *) | TComp (compinfo1, attr1), TComp (compinfo2, attr2) -> if mem_typ_acc a b acc || mem_typ_acc a b !global_typ_acc then ( @@ -117,97 +117,97 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (context: context) = ) else ( let acc = (a, b) :: acc in - let res = eq_compinfo compinfo1 compinfo2 acc context && GobList.equal (eq_attribute context) attr1 attr2 in + let res = eq_compinfo compinfo1 compinfo2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 in if res && compinfo1.cname <> compinfo2.cname then compinfo2.cname <- compinfo1.cname; if res then global_typ_acc := (a, b) :: !global_typ_acc; res ) - | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> let res = eq_enuminfo enuminfo1 enuminfo2 context && GobList.equal (eq_attribute context) attr1 attr2 in (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); res - | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> GobList.equal (eq_attribute context) attr1 attr2 - | TVoid attr1, TVoid attr2 -> GobList.equal (eq_attribute context) attr1 attr2 - | TInt (ik1, attr1), TInt (ik2, attr2) -> ik1 = ik2 && GobList.equal (eq_attribute context) attr1 attr2 - | TFloat (fk1, attr1), TFloat (fk2, attr2) -> fk1 = fk2 && GobList.equal (eq_attribute context) attr1 attr2 + | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> let res = eq_enuminfo enuminfo1 enuminfo2 rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 in (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); res + | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TVoid attr1, TVoid attr2 -> GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TInt (ik1, attr1), TInt (ik2, attr2) -> ik1 = ik2 && GobList.equal (eq_attribute rename_mapping) attr1 attr2 + | TFloat (fk1, attr1), TFloat (fk2, attr2) -> fk1 = fk2 && GobList.equal (eq_attribute rename_mapping) attr1 attr2 | _, _ -> false in if Messages.tracing then Messages.traceu "compareast" "eq_typ_acc %a vs %a\n" d_type a d_type b; r -and eq_typ (a: typ) (b: typ) (context: context) = eq_typ_acc a b [] context +and eq_typ (a: typ) (b: typ) (rename_mapping: rename_mapping) = eq_typ_acc a b [] rename_mapping -and eq_eitems (context: context) (a: string * exp * location) (b: string * exp * location) = match a, b with - (name1, exp1, _l1), (name2, exp2, _l2) -> name1 = name2 && eq_exp exp1 exp2 context +and eq_eitems (rename_mapping: rename_mapping) (a: string * exp * location) (b: string * exp * location) = match a, b with + (name1, exp1, _l1), (name2, exp2, _l2) -> name1 = name2 && eq_exp exp1 exp2 rename_mapping (* Ignore location *) -and eq_enuminfo (a: enuminfo) (b: enuminfo) (context: context) = +and eq_enuminfo (a: enuminfo) (b: enuminfo) (rename_mapping: rename_mapping) = compare_name a.ename b.ename && - GobList.equal (eq_attribute context) a.eattr b.eattr && - GobList.equal (eq_eitems context) a.eitems b.eitems + GobList.equal (eq_attribute rename_mapping) a.eattr b.eattr && + GobList.equal (eq_eitems rename_mapping) a.eitems b.eitems (* Ignore ereferenced *) -and eq_args (context: context) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with +and eq_args (rename_mapping: rename_mapping) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with (name1, typ1, attr1), (name2, typ2, attr2) -> - context_aware_name_comparison name1 name2 context && eq_typ_acc typ1 typ2 acc context && GobList.equal (eq_attribute context) attr1 attr2 + rename_mapping_aware_name_comparison name1 name2 rename_mapping && eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 -and eq_attrparam (context: context) (a: attrparam) (b: attrparam) = match a, b with - | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam context) attrparams1 attrparams2 - | ASizeOf typ1, ASizeOf typ2 -> eq_typ typ1 typ2 context - | ASizeOfE attrparam1, ASizeOfE attrparam2 -> eq_attrparam context attrparam1 attrparam2 +and eq_attrparam (rename_mapping: rename_mapping) (a: attrparam) (b: attrparam) = match a, b with + | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam rename_mapping) attrparams1 attrparams2 + | ASizeOf typ1, ASizeOf typ2 -> eq_typ typ1 typ2 rename_mapping + | ASizeOfE attrparam1, ASizeOfE attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 | ASizeOfS typsig1, ASizeOfS typsig2 -> typsig1 = typsig2 - | AAlignOf typ1, AAlignOf typ2 -> eq_typ typ1 typ2 context - | AAlignOfE attrparam1, AAlignOfE attrparam2 -> eq_attrparam context attrparam1 attrparam2 + | AAlignOf typ1, AAlignOf typ2 -> eq_typ typ1 typ2 rename_mapping + | AAlignOfE attrparam1, AAlignOfE attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 | AAlignOfS typsig1, AAlignOfS typsig2 -> typsig1 = typsig2 - | AUnOp (op1, attrparam1), AUnOp (op2, attrparam2) -> op1 = op2 && eq_attrparam context attrparam1 attrparam2 - | ABinOp (op1, left1, right1), ABinOp (op2, left2, right2) -> op1 = op2 && eq_attrparam context left1 left2 && eq_attrparam context right1 right2 - | ADot (attrparam1, str1), ADot (attrparam2, str2) -> eq_attrparam context attrparam1 attrparam2 && str1 = str2 - | AStar attrparam1, AStar attrparam2 -> eq_attrparam context attrparam1 attrparam2 - | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam context attrparam1 attrparam2 - | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam context left1 left2 && eq_attrparam context right1 right2 - | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> eq_attrparam context left1 left2 && eq_attrparam context middle1 middle2 && eq_attrparam context right1 right2 + | AUnOp (op1, attrparam1), AUnOp (op2, attrparam2) -> op1 = op2 && eq_attrparam rename_mapping attrparam1 attrparam2 + | ABinOp (op1, left1, right1), ABinOp (op2, left2, right2) -> op1 = op2 && eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping right1 right2 + | ADot (attrparam1, str1), ADot (attrparam2, str2) -> eq_attrparam rename_mapping attrparam1 attrparam2 && str1 = str2 + | AStar attrparam1, AStar attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 + | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 + | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping right1 right2 + | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping middle1 middle2 && eq_attrparam rename_mapping right1 right2 | a, b -> a = b -and eq_attribute (context: context) (a: attribute) (b: attribute) = match a, b with - | Attr (name1, params1), Attr (name2, params2) -> name1 = name2 && GobList.equal (eq_attrparam context) params1 params2 +and eq_attribute (rename_mapping: rename_mapping) (a: attribute) (b: attribute) = match a, b with + | Attr (name1, params1), Attr (name2, params2) -> name1 = name2 && GobList.equal (eq_attrparam rename_mapping) params1 params2 -and eq_varinfo2 (context: context) (a: varinfo) (b: varinfo) = eq_varinfo a b context +and eq_varinfo2 (rename_mapping: rename_mapping) (a: varinfo) (b: varinfo) = eq_varinfo a b rename_mapping -and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = +and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*Printf.printf "Comp %s with %s\n" a.vname b.vname;*) - let (_, method_contexts) = context in + let (_, method_rename_mappings) = rename_mapping in - (*When we compare function names, we can directly compare the naming from the context if it exists.*) + (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) let isNamingOk = match b.vtype with | TFun(_, _, _, _) -> ( - let specific_method_context = List.find_opt (fun x -> match x with + let specific_method_rename_mapping = List.find_opt (fun x -> match x with | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname - ) method_contexts in - match specific_method_context with - | Some method_context -> method_context.original_method_name = a.vname && method_context.new_method_name = b.vname + ) method_rename_mappings in + match specific_method_rename_mapping with + | Some method_rename_mapping -> method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname | None -> a.vname = b.vname ) - | _ -> context_aware_name_comparison a.vname b.vname context + | _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping in (*If the following is a method call, we need to check if we have a mapping for that method call. *) - let typ_context = match b.vtype with + let typ_rename_mapping = match b.vtype with | TFun(_, _, _, _) -> ( let new_locals = List.find_opt (fun x -> match x with | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname - ) method_contexts in + ) method_rename_mappings in match new_locals with | Some locals -> - (*Printf.printf "Performing context switch. New context=%s\n" (context_to_string (locals.parameter_renames, method_contexts));*) - (locals.parameter_renames, method_contexts) - | None -> ([], method_contexts) + (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) + (locals.parameter_renames, method_rename_mappings) + | None -> ([], method_rename_mappings) ) - | _ -> context + | _ -> rename_mapping in - let typeCheck = eq_typ a.vtype b.vtype typ_context in - let attrCheck = GobList.equal (eq_attribute context) a.vattr b.vattr in + let typeCheck = eq_typ a.vtype b.vtype typ_rename_mapping in + let attrCheck = GobList.equal (eq_attribute rename_mapping) a.vattr b.vattr in (*let _ = if isNamingOk then a.vname <- b.vname in*) @@ -220,36 +220,36 @@ and eq_varinfo (a: varinfo) (b: varinfo) (context: context) = (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) (* Accumulator is needed because of recursive types: we have to assume that two types we already encountered in a previous step of the recursion are equivalent *) -and eq_compinfo (a: compinfo) (b: compinfo) (acc: (typ * typ) list) (context: context) = +and eq_compinfo (a: compinfo) (b: compinfo) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = a.cstruct = b.cstruct && compare_name a.cname b.cname && - GobList.equal (fun a b-> eq_fieldinfo a b acc context) a.cfields b.cfields && - GobList.equal (eq_attribute context) a.cattr b.cattr && + GobList.equal (fun a b-> eq_fieldinfo a b acc rename_mapping) a.cfields b.cfields && + GobList.equal (eq_attribute rename_mapping) a.cattr b.cattr && a.cdefined = b.cdefined (* Ignore ckey, and ignore creferenced *) -and eq_fieldinfo (a: fieldinfo) (b: fieldinfo) (acc: (typ * typ) list) (context: context) = +and eq_fieldinfo (a: fieldinfo) (b: fieldinfo) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = if Messages.tracing then Messages.tracei "compareast" "fieldinfo %s vs %s\n" a.fname b.fname; - let r = a.fname = b.fname && eq_typ_acc a.ftype b.ftype acc context && a.fbitfield = b.fbitfield && GobList.equal (eq_attribute context) a.fattr b.fattr in + let r = a.fname = b.fname && eq_typ_acc a.ftype b.ftype acc rename_mapping && a.fbitfield = b.fbitfield && GobList.equal (eq_attribute rename_mapping) a.fattr b.fattr in if Messages.tracing then Messages.traceu "compareast" "fieldinfo %s vs %s\n" a.fname b.fname; r -and eq_offset (a: offset) (b: offset) (context: context) = match a, b with +and eq_offset (a: offset) (b: offset) (rename_mapping: rename_mapping) = match a, b with NoOffset, NoOffset -> true - | Field (info1, offset1), Field (info2, offset2) -> eq_fieldinfo info1 info2 [] context && eq_offset offset1 offset2 context - | Index (exp1, offset1), Index (exp2, offset2) -> eq_exp exp1 exp2 context && eq_offset offset1 offset2 context + | Field (info1, offset1), Field (info2, offset2) -> eq_fieldinfo info1 info2 [] rename_mapping && eq_offset offset1 offset2 rename_mapping + | Index (exp1, offset1), Index (exp2, offset2) -> eq_exp exp1 exp2 rename_mapping && eq_offset offset1 offset2 rename_mapping | _, _ -> false -and eq_lval (a: lval) (b: lval) (context: context) = match a, b with - (host1, off1), (host2, off2) -> eq_lhost host1 host2 context && eq_offset off1 off2 context +and eq_lval (a: lval) (b: lval) (rename_mapping: rename_mapping) = match a, b with + (host1, off1), (host2, off2) -> eq_lhost host1 host2 rename_mapping && eq_offset off1 off2 rename_mapping -let eq_instr (context: context) (a: instr) (b: instr) = match a, b with - | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 context && eq_exp exp1 exp2 context +let eq_instr (rename_mapping: rename_mapping) (a: instr) (b: instr) = match a, b with + | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 rename_mapping && eq_exp exp1 exp2 rename_mapping | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> - eq_lval lv1 lv2 context && eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 + eq_lval lv1 lv2 rename_mapping && eq_exp f1 f2 rename_mapping && GobList.equal (eq_exp2 rename_mapping) args1 args2 | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> - eq_exp f1 f2 context && GobList.equal (eq_exp2 context) args1 args2 - | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2 context) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2 context) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) - | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 context + eq_exp f1 f2 rename_mapping && GobList.equal (eq_exp2 rename_mapping) args1 args2 + | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2 rename_mapping) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2 rename_mapping) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) + | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 rename_mapping | _, _ -> false let eq_label (a: label) (b: label) = match a, b with @@ -268,35 +268,35 @@ let eq_stmt_with_location ((a, af): stmt * fundec) ((b, bf): stmt * fundec) = through the cfg and only compares the currently visited node (The cil blocks inside an if statement should not be compared together with its condition to avoid a to early and not precise detection of a changed node inside). Switch, break and continue statements are removed during cfg preparation and therefore need not to be handeled *) -let rec eq_stmtkind ?(cfg_comp = false) ((a, af): stmtkind * fundec) ((b, bf): stmtkind * fundec) (context: context) = - let eq_block' = fun x y -> if cfg_comp then true else eq_block (x, af) (y, bf) context in +let rec eq_stmtkind ?(cfg_comp = false) ((a, af): stmtkind * fundec) ((b, bf): stmtkind * fundec) (rename_mapping: rename_mapping) = + let eq_block' = fun x y -> if cfg_comp then true else eq_block (x, af) (y, bf) rename_mapping in match a, b with - | Instr is1, Instr is2 -> GobList.equal (eq_instr context) is1 is2 - | Return (Some exp1, _l1), Return (Some exp2, _l2) -> eq_exp exp1 exp2 context + | Instr is1, Instr is2 -> GobList.equal (eq_instr rename_mapping) is1 is2 + | Return (Some exp1, _l1), Return (Some exp2, _l2) -> eq_exp exp1 exp2 rename_mapping | Return (None, _l1), Return (None, _l2) -> true | Return _, Return _ -> false | Goto (st1, _l1), Goto (st2, _l2) -> eq_stmt_with_location (!st1, af) (!st2, bf) | Break _, Break _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true | Continue _, Continue _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true - | If (exp1, then1, else1, _l1, _el1), If (exp2, then2, else2, _l2, _el2) -> eq_exp exp1 exp2 context && eq_block' then1 then2 && eq_block' else1 else2 - | Switch (exp1, block1, stmts1, _l1, _el1), Switch (exp2, block2, stmts2, _l2, _el2) -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else eq_exp exp1 exp2 context && eq_block' block1 block2 && GobList.equal (fun a b -> eq_stmt (a,af) (b,bf) context) stmts1 stmts2 + | If (exp1, then1, else1, _l1, _el1), If (exp2, then2, else2, _l2, _el2) -> eq_exp exp1 exp2 rename_mapping && eq_block' then1 then2 && eq_block' else1 else2 + | Switch (exp1, block1, stmts1, _l1, _el1), Switch (exp2, block2, stmts2, _l2, _el2) -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else eq_exp exp1 exp2 rename_mapping && eq_block' block1 block2 && GobList.equal (fun a b -> eq_stmt (a,af) (b,bf) rename_mapping) stmts1 stmts2 | Loop (block1, _l1, _el1, _con1, _br1), Loop (block2, _l2, _el2, _con2, _br2) -> eq_block' block1 block2 | Block block1, Block block2 -> eq_block' block1 block2 | _, _ -> false -and eq_stmt ?(cfg_comp = false) ((a, af): stmt * fundec) ((b, bf): stmt * fundec) (context: context) = +and eq_stmt ?(cfg_comp = false) ((a, af): stmt * fundec) ((b, bf): stmt * fundec) (rename_mapping: rename_mapping) = GobList.equal eq_label a.labels b.labels && - eq_stmtkind ~cfg_comp (a.skind, af) (b.skind, bf) context + eq_stmtkind ~cfg_comp (a.skind, af) (b.skind, bf) rename_mapping -and eq_block ((a, af): Cil.block * fundec) ((b, bf): Cil.block * fundec) (context: context) = - a.battrs = b.battrs && GobList.equal (fun x y -> eq_stmt (x, af) (y, bf) context) a.bstmts b.bstmts +and eq_block ((a, af): Cil.block * fundec) ((b, bf): Cil.block * fundec) (rename_mapping: rename_mapping) = + a.battrs = b.battrs && GobList.equal (fun x y -> eq_stmt (x, af) (y, bf) rename_mapping) a.bstmts b.bstmts -let rec eq_init (a: init) (b: init) (context: context) = match a, b with - | SingleInit e1, SingleInit e2 -> eq_exp e1 e2 context - | CompoundInit (t1, l1), CompoundInit (t2, l2) -> eq_typ t1 t2 context && GobList.equal (fun (o1, i1) (o2, i2) -> eq_offset o1 o2 context && eq_init i1 i2 context) l1 l2 +let rec eq_init (a: init) (b: init) (rename_mapping: rename_mapping) = match a, b with + | SingleInit e1, SingleInit e2 -> eq_exp e1 e2 rename_mapping + | CompoundInit (t1, l1), CompoundInit (t2, l2) -> eq_typ t1 t2 rename_mapping && GobList.equal (fun (o1, i1) (o2, i2) -> eq_offset o1 o2 rename_mapping && eq_init i1 i2 rename_mapping) l1 l2 | _, _ -> false -let eq_initinfo (a: initinfo) (b: initinfo) (context: context) = match a.init, b.init with - | (Some init_a), (Some init_b) -> eq_init init_a init_b context +let eq_initinfo (a: initinfo) (b: initinfo) (rename_mapping: rename_mapping) = match a.init, b.init with + | (Some init_a), (Some init_b) -> eq_init init_a init_b rename_mapping | None, None -> true | _, _ -> false \ No newline at end of file diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 69cdb1a471..e2492de086 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -4,28 +4,28 @@ open Cil include CompareAST let eq_node (x, fun1) (y, fun2) = - let empty_context: context = ([], []) in + let empty_rename_mapping: rename_mapping = ([], []) in match x,y with - | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_context - | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_context - | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar empty_context + | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping + | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping + | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping | _ -> false (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) -let eq_edge x y = - let empty_context: context = ([], []) in +let eq_edge x y = + let empty_rename_mapping: rename_mapping = ([], []) in match x, y with - | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_context && eq_exp rv1 rv2 empty_context - | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_context && GobList.equal (eq_exp2 empty_context) ars1 ars2 + | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping && eq_exp rv1 rv2 empty_rename_mapping + | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 | Proc (Some r1,f1,ars1), Proc (Some r2,f2,ars2) -> - eq_lval r1 r2 empty_context && eq_exp f1 f2 empty_context && GobList.equal (eq_exp2 empty_context) ars1 ars2 - | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar empty_context - | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar empty_context - | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 empty_context && eq_varinfo fd1.svar fd2.svar empty_context - | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 empty_context && b1 = b2 + eq_lval r1 r2 empty_rename_mapping && eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 + | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping + | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar empty_rename_mapping + | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 empty_rename_mapping && eq_varinfo fd1.svar fd2.svar empty_rename_mapping + | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 empty_rename_mapping && b1 = b2 | ASM _, ASM _ -> false | Skip, Skip -> true - | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 empty_context + | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 empty_rename_mapping | _ -> false (* The order of the edges in the list is relevant. Therefore compare them one to one without sorting first *) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 28bd0806b1..40fd0b877a 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -36,7 +36,7 @@ let should_reanalyze (fdec: Cil.fundec) = (* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) -let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = +let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumption list) = let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in if (List.length a.slocals) = (List.length b.slocals) then @@ -47,17 +47,16 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a rename_mapping, holding the rename assumptions *) - let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: (string, string) Hashtbl.t) = match alocals, blocals with + let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: local_rename_assumption list) = match alocals, blocals with | [], [] -> true, rename_mapping | origLocal :: als, nowLocal :: bls -> - if origLocal.vname <> nowLocal.vname then Hashtbl.add rename_mapping origLocal.vname nowLocal.vname; - - (*TODO: maybe optimize this with eq_varinfo*) - rename_mapping_aware_compare als bls rename_mapping + let new_rename_mapping = if origLocal.vname = nowLocal.vname then rename_mapping else rename_mapping @ [(origLocal.vname, nowLocal.vname)] in + (*TODO: also call eq_varinfo*) + rename_mapping_aware_compare als bls new_rename_mapping | _, _ -> false, rename_mapping in - let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (Hashtbl.create 0) in + let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals [] in let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping && GobList.equal (eq_varinfo2 actHeaderRenameMapping) a.sformals b.sformals in @@ -84,13 +83,13 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo in identical, unchangedHeader, diffOpt -let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = match a, b with +let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_ammping: method_rename_assumption list) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_mapping in + let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_ammping in identical, unchangedHeader, diffOpt - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y ([], []), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y ([], []), false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = @@ -105,18 +104,13 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = match old_global, global with | GFun(f, _), GFun (g, _) -> - let renamed_params: (string, string) Hashtbl.t = if (List.length f.sformals) = (List.length g.sformals) then + let renamed_params: (string * string) list = if (List.length f.sformals) = (List.length g.sformals) then List.combine f.sformals g.sformals |> List.filter (fun (original, now) -> not (original.vname = now.vname)) |> - List.map (fun (original, now) -> (original.vname, now.vname)) |> - (fun list -> - let table: (string, string) Hashtbl.t = Hashtbl.create (List.length list) in - List.iter (fun mapping -> Hashtbl.add table (fst mapping) (snd mapping)) list; - table - ) - else Hashtbl.create 0 in - - if not (f.svar.vname = g.svar.vname) || (Hashtbl.length renamed_params) > 0 then + List.map (fun (original, now) -> (original.vname, now.vname)) + else [] in + + if not (f.svar.vname = g.svar.vname) || (List.length renamed_params) > 0 then Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} else None | _, _ -> None @@ -157,16 +151,11 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in - let global_rename_mapping: method_rename_assumptions = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> + let global_rename_mapping: method_rename_assumption list = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> match generate_global_rename_mapping oldMap global with | Some rename_mapping -> current_global_rename_mapping @ [rename_mapping] | None -> current_global_rename_mapping - ) [] |> - (fun mappings -> - let table = Hashtbl.create (List.length mappings) in - List.iter (fun mapping -> Hashtbl.add table mapping.original_method_name mapping) mappings; - table - ) in + ) [] in (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) @@ -181,4 +170,4 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = (** Given an (optional) equality function between [Cil.global]s, an old and a new [Cil.file], this function computes a [change_info], which describes which [global]s are changed, unchanged, removed and added. *) let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = - Stats.time "compareCilFiles" (compareCilFiles ~eq oldAST) newAST \ No newline at end of file + Stats.time "compareCilFiles" (compareCilFiles ~eq oldAST) newAST From aed7a3aa875f6c3482fe2f7db4ffe2d37cfdc18c Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 9 May 2022 16:09:32 +0200 Subject: [PATCH 018/518] Replaced rename mapping lists with Hashtbls for increased performance --- src/incremental/compareAST.ml | 27 +++++++++------------ src/incremental/compareCFG.ml | 4 ++-- src/incremental/compareCIL.ml | 45 ++++++++++++++++++++++------------- 3 files changed, 41 insertions(+), 35 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 36662c8c81..e42e3539d2 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -5,22 +5,21 @@ type global_type = Fun | Decl | Var and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] -type local_rename_assumption = string * string -(**) -type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: (string * string) list} +type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: (string, string) Hashtbl.t} +type method_rename_assumptions = (string, method_rename_assumption) Hashtbl.t (*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type rename_mapping = (local_rename_assumption list) * (method_rename_assumption list) +type rename_mapping = ((string, string) Hashtbl.t) * (method_rename_assumptions) (*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) 2. there is no rename for name1 -> name1 = name2*) let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = let (local_c, method_c) = rename_mapping in - let existingAssumption: (string*string) option = List.find_opt (fun x -> match x with (original, now) -> original = name1) local_c in + let existingAssumption: string option = Hashtbl.find_opt local_c name1 in match existingAssumption with - | Some (original, now) -> + | Some now -> (*Printf.printf "Assumption is: %s -> %s\n" original now;*) now = name2 | None -> @@ -33,11 +32,11 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods) = rename_mapping in - let local_string = string_tuple_to_string local in - let methods_string: string = methods |> + let local_string = string_tuple_to_string (List.of_seq (Hashtbl.to_seq local)) in + let methods_string: string = List.of_seq (Hashtbl.to_seq_values methods) |> List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ - "; renamed_params=" ^ string_tuple_to_string parameter_renames ^ ")") |> + "; renamed_params=" ^ string_tuple_to_string (List.of_seq (Hashtbl.to_seq parameter_renames)) ^ ")") |> String.concat ", " in "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "])" @@ -180,9 +179,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) let isNamingOk = match b.vtype with | TFun(_, _, _, _) -> ( - let specific_method_rename_mapping = List.find_opt (fun x -> match x with - | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname - ) method_rename_mappings in + let specific_method_rename_mapping = Hashtbl.find_opt method_rename_mappings a.vname in match specific_method_rename_mapping with | Some method_rename_mapping -> method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname | None -> a.vname = b.vname @@ -193,15 +190,13 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*If the following is a method call, we need to check if we have a mapping for that method call. *) let typ_rename_mapping = match b.vtype with | TFun(_, _, _, _) -> ( - let new_locals = List.find_opt (fun x -> match x with - | {original_method_name; new_method_name; parameter_renames} -> original_method_name = a.vname && new_method_name = b.vname - ) method_rename_mappings in + let new_locals = Hashtbl.find_opt method_rename_mappings a.vname in match new_locals with | Some locals -> (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) (locals.parameter_renames, method_rename_mappings) - | None -> ([], method_rename_mappings) + | None -> (Hashtbl.create 0, method_rename_mappings) ) | _ -> rename_mapping in diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index e2492de086..4557cb88b3 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -4,7 +4,7 @@ open Cil include CompareAST let eq_node (x, fun1) (y, fun2) = - let empty_rename_mapping: rename_mapping = ([], []) in + let empty_rename_mapping: rename_mapping = (Hashtbl.create 0, Hashtbl.create 0) in match x,y with | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping @@ -13,7 +13,7 @@ let eq_node (x, fun1) (y, fun2) = (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) let eq_edge x y = - let empty_rename_mapping: rename_mapping = ([], []) in + let empty_rename_mapping: rename_mapping = (Hashtbl.create 0, Hashtbl.create 0) in match x, y with | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping && eq_exp rv1 rv2 empty_rename_mapping | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 40fd0b877a..f5817ae76e 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -36,7 +36,7 @@ let should_reanalyze (fdec: Cil.fundec) = (* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) -let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumption list) = +let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in if (List.length a.slocals) = (List.length b.slocals) then @@ -47,16 +47,17 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a rename_mapping, holding the rename assumptions *) - let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: local_rename_assumption list) = match alocals, blocals with + let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: (string, string) Hashtbl.t) = match alocals, blocals with | [], [] -> true, rename_mapping | origLocal :: als, nowLocal :: bls -> - let new_rename_mapping = if origLocal.vname = nowLocal.vname then rename_mapping else rename_mapping @ [(origLocal.vname, nowLocal.vname)] in - (*TODO: also call eq_varinfo*) - rename_mapping_aware_compare als bls new_rename_mapping + if origLocal.vname <> nowLocal.vname then Hashtbl.add rename_mapping origLocal.vname nowLocal.vname; + + (*TODO: maybe optimize this with eq_varinfo*) + rename_mapping_aware_compare als bls rename_mapping | _, _ -> false, rename_mapping in - let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals [] in + let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (Hashtbl.create 0) in let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping && GobList.equal (eq_varinfo2 actHeaderRenameMapping) a.sformals b.sformals in @@ -83,13 +84,13 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo in identical, unchangedHeader, diffOpt -let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_ammping: method_rename_assumption list) = match a, b with +let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_ammping in + let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_mapping in identical, unchangedHeader, diffOpt - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y ([], []), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y ([], []), false, None + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = @@ -104,13 +105,18 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = match old_global, global with | GFun(f, _), GFun (g, _) -> - let renamed_params: (string * string) list = if (List.length f.sformals) = (List.length g.sformals) then + let renamed_params: (string, string) Hashtbl.t = if (List.length f.sformals) = (List.length g.sformals) then List.combine f.sformals g.sformals |> List.filter (fun (original, now) -> not (original.vname = now.vname)) |> - List.map (fun (original, now) -> (original.vname, now.vname)) - else [] in - - if not (f.svar.vname = g.svar.vname) || (List.length renamed_params) > 0 then + List.map (fun (original, now) -> (original.vname, now.vname)) |> + (fun list -> + let table: (string, string) Hashtbl.t = Hashtbl.create (List.length list) in + List.iter (fun mapping -> Hashtbl.add table (fst mapping) (snd mapping)) list; + table + ) + else Hashtbl.create 0 in + + if not (f.svar.vname = g.svar.vname) || (Hashtbl.length renamed_params) > 0 then Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} else None | _, _ -> None @@ -151,11 +157,16 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in - let global_rename_mapping: method_rename_assumption list = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> + let global_rename_mapping: method_rename_assumptions = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> match generate_global_rename_mapping oldMap global with | Some rename_mapping -> current_global_rename_mapping @ [rename_mapping] | None -> current_global_rename_mapping - ) [] in + ) [] |> + (fun mappings -> + let table = Hashtbl.create (List.length mappings) in + List.iter (fun mapping -> Hashtbl.add table mapping.original_method_name mapping) mappings; + table + ) in (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) From 9e95ddbde4805fd32df2d568672e47c4a6a270de Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Sat, 14 May 2022 15:16:43 +0200 Subject: [PATCH 019/518] Old locals are now renamed to the new local names. --- src/incremental/updateCil.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incremental/updateCil.ml b/src/incremental/updateCil.ml index b2655f9d54..2cf28ba329 100644 --- a/src/incremental/updateCil.ml +++ b/src/incremental/updateCil.ml @@ -43,7 +43,7 @@ let update_ids (old_file: file) (ids: max_ids) (new_file: file) (changes: change in let reset_fun (f: fundec) (old_f: fundec) = f.svar.vid <- old_f.svar.vid; - List.iter2 (fun l o_l -> l.vid <- o_l.vid) f.slocals old_f.slocals; + List.iter2 (fun l o_l -> l.vid <- o_l.vid; o_l.vname <- l.vname) f.slocals old_f.slocals; List.iter2 (fun lo o_f -> lo.vid <- o_f.vid) f.sformals old_f.sformals; List.iter2 (fun s o_s -> s.sid <- o_s.sid) f.sallstmts old_f.sallstmts; List.iter (fun s -> store_node_location (Statement s) (Cilfacade.get_stmtLoc s)) f.sallstmts; From 7e89ec2d1ae1fac5d0fd07433df21a3671ca6a3b Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 16 May 2022 13:46:14 +0200 Subject: [PATCH 020/518] Fixed duplicate id tests --- .../04-var-rename/{ => diffs}/08-2_incremental_runs_2.c | 4 ++-- .../04-var-rename/{ => diffs}/08-2_incremental_runs_3.c | 0 .../04-var-rename/{ => diffs}/09-2_ir_with_changes_2.c | 0 .../04-var-rename/{ => diffs}/09-2_ir_with_changes_3.c | 0 4 files changed, 2 insertions(+), 2 deletions(-) rename tests/incremental/04-var-rename/{ => diffs}/08-2_incremental_runs_2.c (92%) rename tests/incremental/04-var-rename/{ => diffs}/08-2_incremental_runs_3.c (100%) rename tests/incremental/04-var-rename/{ => diffs}/09-2_ir_with_changes_2.c (100%) rename tests/incremental/04-var-rename/{ => diffs}/09-2_ir_with_changes_3.c (100%) diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_2.c b/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c similarity index 92% rename from tests/incremental/04-var-rename/08-2_incremental_runs_2.c rename to tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c index 1190fdb14c..43205a976e 100644 --- a/tests/incremental/04-var-rename/08-2_incremental_runs_2.c +++ b/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c @@ -1,8 +1,8 @@ int main() { int varSecondIteration = 0; - + varSecondIteration++; - + assert(varSecondIteration < 10); return 0; } diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_3.c b/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs_3.c rename to tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.c b/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes_2.c rename to tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_3.c b/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes_3.c rename to tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c From e4df2cab546726a25d6a2de42a82981f04c2878b Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 16 May 2022 15:19:32 +0200 Subject: [PATCH 021/518] Added some test cases --- .../05-method-rename/00-simple_rename.c | 10 ++++++++ .../05-method-rename/00-simple_rename.patch | 15 ++++++++++++ .../05-method-rename/01-dependent_rename.c | 14 +++++++++++ .../01-dependent_rename.patch | 21 +++++++++++++++++ .../05-method-rename/02-rename_and_swap.c | 19 +++++++++++++++ .../03-cyclic_rename_dependency.c | 17 ++++++++++++++ .../05-method-rename/04-cyclic_with_swap.c | 16 +++++++++++++ .../05-method-rename/diffs/00-simple_rename.c | 10 ++++++++ .../diffs/01-dependent_rename.c | 14 +++++++++++ .../diffs/02-rename_and_swap.c | 23 +++++++++++++++++++ .../diffs/03-cyclic_rename_dependency.c | 17 ++++++++++++++ .../diffs/04-cyclic_with_swap.c | 20 ++++++++++++++++ 12 files changed, 196 insertions(+) create mode 100644 tests/incremental/05-method-rename/00-simple_rename.c create mode 100644 tests/incremental/05-method-rename/00-simple_rename.patch create mode 100644 tests/incremental/05-method-rename/01-dependent_rename.c create mode 100644 tests/incremental/05-method-rename/01-dependent_rename.patch create mode 100644 tests/incremental/05-method-rename/02-rename_and_swap.c create mode 100644 tests/incremental/05-method-rename/03-cyclic_rename_dependency.c create mode 100644 tests/incremental/05-method-rename/04-cyclic_with_swap.c create mode 100644 tests/incremental/05-method-rename/diffs/00-simple_rename.c create mode 100644 tests/incremental/05-method-rename/diffs/01-dependent_rename.c create mode 100644 tests/incremental/05-method-rename/diffs/02-rename_and_swap.c create mode 100644 tests/incremental/05-method-rename/diffs/03-cyclic_rename_dependency.c create mode 100644 tests/incremental/05-method-rename/diffs/04-cyclic_with_swap.c diff --git a/tests/incremental/05-method-rename/00-simple_rename.c b/tests/incremental/05-method-rename/00-simple_rename.c new file mode 100644 index 0000000000..5d1e6fe872 --- /dev/null +++ b/tests/incremental/05-method-rename/00-simple_rename.c @@ -0,0 +1,10 @@ +#include + +void foo() { + printf("foo"); +} + +int main() { + foo(); + return 0; +} diff --git a/tests/incremental/05-method-rename/00-simple_rename.patch b/tests/incremental/05-method-rename/00-simple_rename.patch new file mode 100644 index 0000000000..407a5a9bbf --- /dev/null +++ b/tests/incremental/05-method-rename/00-simple_rename.patch @@ -0,0 +1,15 @@ +--- tests/incremental/05-method_rename/00-simple_rename.c ++++ tests/incremental/05-method_rename/00-simple_rename.c +@@ -1,10 +1,10 @@ + #include + +-void foo() { ++void bar() { + printf("foo"); + } + + int main() { +- foo(); ++ bar(); + return 0; + } diff --git a/tests/incremental/05-method-rename/01-dependent_rename.c b/tests/incremental/05-method-rename/01-dependent_rename.c new file mode 100644 index 0000000000..66c1a5a634 --- /dev/null +++ b/tests/incremental/05-method-rename/01-dependent_rename.c @@ -0,0 +1,14 @@ +#include + +void fun1() { + printf("fun1"); +} + +void fun2() { + fun1(); +} + +int main() { + fun2(); + return 0; +} diff --git a/tests/incremental/05-method-rename/01-dependent_rename.patch b/tests/incremental/05-method-rename/01-dependent_rename.patch new file mode 100644 index 0000000000..5eedfd814b --- /dev/null +++ b/tests/incremental/05-method-rename/01-dependent_rename.patch @@ -0,0 +1,21 @@ +--- tests/incremental/05-method_rename/01-dependent_rename.c ++++ tests/incremental/05-method_rename/01-dependent_rename.c +@@ -1,14 +1,14 @@ + #include + +-void fun1() { ++void bar1() { + printf("fun1"); + } + +-void fun2() { +- fun1(); ++void bar2() { ++ bar1(); + } + + int main() { +- fun2(); ++ bar2(); + return 0; + } diff --git a/tests/incremental/05-method-rename/02-rename_and_swap.c b/tests/incremental/05-method-rename/02-rename_and_swap.c new file mode 100644 index 0000000000..f62edd44a4 --- /dev/null +++ b/tests/incremental/05-method-rename/02-rename_and_swap.c @@ -0,0 +1,19 @@ +#include + +void foo1() { + printf("foo1"); +} + +void foo2() { + foo1(); +} + +void foo3() { + foo1(); +} + +int main() { + foo2(); + foo3(); + return 0; +} diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.c b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.c new file mode 100644 index 0000000000..2509cfbcd5 --- /dev/null +++ b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.c @@ -0,0 +1,17 @@ +#include + +//Unchanged. + +void foo1(int c) { + if (c < 10) foo2(c + 1); +} + +void foo2(int c) { + if (c < 10) foo1(c + 1); +} + +int main() { + foo1(0); + foo2(0); + return 0; +} diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.c b/tests/incremental/05-method-rename/04-cyclic_with_swap.c new file mode 100644 index 0000000000..74123d5a14 --- /dev/null +++ b/tests/incremental/05-method-rename/04-cyclic_with_swap.c @@ -0,0 +1,16 @@ +#include + +//Changed. + +void foo1(int c) { + if (c < 10) foo2(c + 1); +} + +void foo2(int c) { + if (c < 10) foo1(c + 1); +} + +int main() { + foo1(0); + return 0; +} diff --git a/tests/incremental/05-method-rename/diffs/00-simple_rename.c b/tests/incremental/05-method-rename/diffs/00-simple_rename.c new file mode 100644 index 0000000000..79a05fe8d4 --- /dev/null +++ b/tests/incremental/05-method-rename/diffs/00-simple_rename.c @@ -0,0 +1,10 @@ +#include + +void bar() { + printf("foo"); +} + +int main() { + bar(); + return 0; +} diff --git a/tests/incremental/05-method-rename/diffs/01-dependent_rename.c b/tests/incremental/05-method-rename/diffs/01-dependent_rename.c new file mode 100644 index 0000000000..a2c5d48fea --- /dev/null +++ b/tests/incremental/05-method-rename/diffs/01-dependent_rename.c @@ -0,0 +1,14 @@ +#include + +void bar1() { + printf("fun1"); +} + +void bar2() { + bar1(); +} + +int main() { + bar2(); + return 0; +} diff --git a/tests/incremental/05-method-rename/diffs/02-rename_and_swap.c b/tests/incremental/05-method-rename/diffs/02-rename_and_swap.c new file mode 100644 index 0000000000..eae4b77001 --- /dev/null +++ b/tests/incremental/05-method-rename/diffs/02-rename_and_swap.c @@ -0,0 +1,23 @@ +#include + +void newFun() { + printf("newFun"); +} + +void bar1() { + printf("foo1"); +} + +void foo2() { + bar1(); +} + +void foo3() { + newFun(); +} + +int main() { + foo2(); + foo3(); + return 0; +} diff --git a/tests/incremental/05-method-rename/diffs/03-cyclic_rename_dependency.c b/tests/incremental/05-method-rename/diffs/03-cyclic_rename_dependency.c new file mode 100644 index 0000000000..a720f8025e --- /dev/null +++ b/tests/incremental/05-method-rename/diffs/03-cyclic_rename_dependency.c @@ -0,0 +1,17 @@ +#include + +//Unchanged. + +void bar1(int c) { + if (c < 10) bar2(c + 1); +} + +void bar2(int c) { + if (c < 10) bar1(c + 1); +} + +int main() { + bar1(0); + bar2(0); + return 0; +} diff --git a/tests/incremental/05-method-rename/diffs/04-cyclic_with_swap.c b/tests/incremental/05-method-rename/diffs/04-cyclic_with_swap.c new file mode 100644 index 0000000000..67cb349429 --- /dev/null +++ b/tests/incremental/05-method-rename/diffs/04-cyclic_with_swap.c @@ -0,0 +1,20 @@ +#include + +//Changed. + +void newFun(int c) { + printf("newfun"); +} + +void bar1(int c) { + if (c < 10) bar2(c + 1); +} + +void bar2(int c) { + if (c < 10) newFun(c + 1); +} + +int main() { + bar1(0); + return 0; +} From 2c8641185f6fc90e2c273a98544274ed9f460844 Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 17 May 2022 16:36:59 +0200 Subject: [PATCH 022/518] Added first functions for rename detection. --- src/incremental/detectRenamedFunctions.ml | 43 +++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 src/incremental/detectRenamedFunctions.ml diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml new file mode 100644 index 0000000000..c4fe19674e --- /dev/null +++ b/src/incremental/detectRenamedFunctions.ml @@ -0,0 +1,43 @@ +open Cil +open MyCFG +include CompareAST +include CompareCFG + +(*Maps the function name as keys*) +module FundecMap = Map.Make(String);; + +type functionStatus = Identical | Renamed | Changed | New | Deleted +type results = (fundec, functionStatus) Hashtbl.t + +(*A dependency mapps the function it depends on to the name the function has to be changed to*) +type dependencies = (fundec, string) Hashtbl.t + +type earlyFunctionStatus = Unchanged of dependencies | Unknown + +let getFunctionMap (ast: file) : fundec FundecMap.t = + Cil.foldGlobals ast (fun map global -> + match global with + | GFun (fundec, _) -> FundecMap.add fundec.svar.vname fundec map + | _ -> map + ) FundecMap.empty + +let seperateUnchangedFunctions (oldFunctionMap: fundec FundecMap.t) (newFunctionMap: fundec FundecMap.t) : earlyFunctionStatus FundecMap.t = + FundecMap.map (fun f -> + let matchingNewFundec = FundecMap.find_opt f.svar.vname newFunctionMap in + match matchingNewFundec with + | Some newFun -> + (*Compare if they are similar*) + let result = CompareCIL.eqF f newFun None (Hashtbl.create 0) in + Unknown + | None -> Unknown + ) oldFunctionMap + +let detectRenamedFunctions (oldAST: file) (newAST: file) : results = begin + let oldFunctionMap = getFunctionMap oldAST in + let newFunctionMap = getFunctionMap newAST in + + (*1. detect function which names have not changed*) + let unchangedNameFunctions = FundecMap.map (fun _ fundec -> ) oldFunctionMap in + + Hashtbl.create 0 +end From 182db42f257b333bf6f8853861e69422fcbd23f2 Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 17 May 2022 17:01:29 +0200 Subject: [PATCH 023/518] Replaced Hashtbl in compare functions with Map --- src/incremental/compareAST.ml | 56 ++++++++++++++++++----------------- src/incremental/compareCFG.ml | 6 ++-- src/incremental/compareCIL.ml | 30 ++++++++----------- 3 files changed, 45 insertions(+), 47 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index e42e3539d2..4f268d387a 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -5,24 +5,26 @@ type global_type = Fun | Decl | Var and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] -type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: (string, string) Hashtbl.t} -type method_rename_assumptions = (string, method_rename_assumption) Hashtbl.t +module StringMap = Map.Make(String) + +type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: string StringMap.t} +type method_rename_assumptions = method_rename_assumption StringMap.t (*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type rename_mapping = ((string, string) Hashtbl.t) * (method_rename_assumptions) +type rename_mapping = (string StringMap.t) * (method_rename_assumptions) (*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) 2. there is no rename for name1 -> name1 = name2*) -let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = +let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = let (local_c, method_c) = rename_mapping in - let existingAssumption: string option = Hashtbl.find_opt local_c name1 in + let existingAssumption: string option = StringMap.find_opt name1 local_c in match existingAssumption with - | Some now -> + | Some now -> (*Printf.printf "Assumption is: %s -> %s\n" original now;*) now = name2 - | None -> + | None -> (*Printf.printf "No assumption when %s, %s, %b\n" name1 name2 (name1 = name2);*) name1 = name2 (*Var names differ, but there is no assumption, so this can't be good*) @@ -30,13 +32,13 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> List.map (fun x -> match x with (first, second) -> "(" ^ first ^ " -> " ^ second ^ ")") |> String.concat ", ") ^ "]" -let rename_mapping_to_string (rename_mapping: rename_mapping) = +let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods) = rename_mapping in - let local_string = string_tuple_to_string (List.of_seq (Hashtbl.to_seq local)) in - let methods_string: string = List.of_seq (Hashtbl.to_seq_values methods) |> - List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> - "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ - "; renamed_params=" ^ string_tuple_to_string (List.of_seq (Hashtbl.to_seq parameter_renames)) ^ ")") |> + let local_string = string_tuple_to_string (List.of_seq (StringMap.to_seq local)) in + let methods_string: string = List.of_seq (StringMap.to_seq methods |> Seq.map snd) |> + List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> + "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ + "; renamed_params=" ^ string_tuple_to_string (List.of_seq (StringMap.to_seq parameter_renames)) ^ ")") |> String.concat ", " in "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "])" @@ -58,7 +60,7 @@ let compare_name (a: string) (b: string) = let anon_union = "__anonunion_" in if a = b then true else BatString.(starts_with a anon_struct && starts_with b anon_struct || starts_with a anon_union && starts_with b anon_union) -let rec eq_constant (rename_mapping: rename_mapping) (a: constant) (b: constant) = +let rec eq_constant (rename_mapping: rename_mapping) (a: constant) (b: constant) = match a, b with | CInt (val1, kind1, str1), CInt (val2, kind2, str2) -> Cilint.compare_cilint val1 val2 = 0 && kind1 = kind2 (* Ignore string representation, i.e. 0x2 == 2 *) | CEnum (exp1, str1, enuminfo1), CEnum (exp2, str2, enuminfo2) -> eq_exp exp1 exp2 rename_mapping (* Ignore name and enuminfo *) @@ -66,9 +68,9 @@ let rec eq_constant (rename_mapping: rename_mapping) (a: constant) (b: constant) and eq_exp2 (rename_mapping: rename_mapping) (a: exp) (b: exp) = eq_exp a b rename_mapping -and eq_exp (a: exp) (b: exp) (rename_mapping: rename_mapping) = +and eq_exp (a: exp) (b: exp) (rename_mapping: rename_mapping) = match a, b with - | Const c1, Const c2 -> eq_constant rename_mapping c1 c2 + | Const c1, Const c2 -> eq_constant rename_mapping c1 c2 | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 rename_mapping | SizeOf typ1, SizeOf typ2 -> eq_typ typ1 typ2 rename_mapping | SizeOfE exp1, SizeOfE exp2 -> eq_exp exp1 exp2 rename_mapping @@ -146,7 +148,7 @@ and eq_enuminfo (a: enuminfo) (b: enuminfo) (rename_mapping: rename_mapping) = (* Ignore ereferenced *) and eq_args (rename_mapping: rename_mapping) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with - (name1, typ1, attr1), (name2, typ2, attr2) -> + (name1, typ1, attr1), (name2, typ2, attr2) -> rename_mapping_aware_name_comparison name1 name2 rename_mapping && eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 and eq_attrparam (rename_mapping: rename_mapping) (a: attrparam) (b: attrparam) = match a, b with @@ -171,7 +173,7 @@ and eq_attribute (rename_mapping: rename_mapping) (a: attribute) (b: attribute) and eq_varinfo2 (rename_mapping: rename_mapping) (a: varinfo) (b: varinfo) = eq_varinfo a b rename_mapping -and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = +and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*Printf.printf "Comp %s with %s\n" a.vname b.vname;*) let (_, method_rename_mappings) = rename_mapping in @@ -179,24 +181,24 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) let isNamingOk = match b.vtype with | TFun(_, _, _, _) -> ( - let specific_method_rename_mapping = Hashtbl.find_opt method_rename_mappings a.vname in + let specific_method_rename_mapping = StringMap.find_opt a.vname method_rename_mappings in match specific_method_rename_mapping with | Some method_rename_mapping -> method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname | None -> a.vname = b.vname ) | _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping - in + in (*If the following is a method call, we need to check if we have a mapping for that method call. *) let typ_rename_mapping = match b.vtype with | TFun(_, _, _, _) -> ( - let new_locals = Hashtbl.find_opt method_rename_mappings a.vname in + let new_locals = StringMap.find_opt a.vname method_rename_mappings in match new_locals with - | Some locals -> + | Some locals -> (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) (locals.parameter_renames, method_rename_mappings) - | None -> (Hashtbl.create 0, method_rename_mappings) + | None -> (StringMap.empty, method_rename_mappings) ) | _ -> rename_mapping in @@ -207,7 +209,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*let _ = if isNamingOk then a.vname <- b.vname in*) (*let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in *) - (*a.vname = b.vname*) + (*a.vname = b.vname*) let result = isNamingOk && typeCheck && attrCheck && a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in @@ -239,9 +241,9 @@ and eq_lval (a: lval) (b: lval) (rename_mapping: rename_mapping) = match a, b wi let eq_instr (rename_mapping: rename_mapping) (a: instr) (b: instr) = match a, b with | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 rename_mapping && eq_exp exp1 exp2 rename_mapping - | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> + | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> eq_lval lv1 lv2 rename_mapping && eq_exp f1 f2 rename_mapping && GobList.equal (eq_exp2 rename_mapping) args1 args2 - | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> + | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> eq_exp f1 f2 rename_mapping && GobList.equal (eq_exp2 rename_mapping) args1 args2 | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2 rename_mapping) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2 rename_mapping) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 rename_mapping @@ -294,4 +296,4 @@ let rec eq_init (a: init) (b: init) (rename_mapping: rename_mapping) = match a, let eq_initinfo (a: initinfo) (b: initinfo) (rename_mapping: rename_mapping) = match a.init, b.init with | (Some init_a), (Some init_b) -> eq_init init_a init_b rename_mapping | None, None -> true - | _, _ -> false \ No newline at end of file + | _, _ -> false diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 4557cb88b3..2a52e6eafe 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -4,7 +4,7 @@ open Cil include CompareAST let eq_node (x, fun1) (y, fun2) = - let empty_rename_mapping: rename_mapping = (Hashtbl.create 0, Hashtbl.create 0) in + let empty_rename_mapping: rename_mapping = (StringMap.empty, StringMap.empty) in match x,y with | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping @@ -12,8 +12,8 @@ let eq_node (x, fun1) (y, fun2) = | _ -> false (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) -let eq_edge x y = - let empty_rename_mapping: rename_mapping = (Hashtbl.create 0, Hashtbl.create 0) in +let eq_edge x y = + let empty_rename_mapping: rename_mapping = (StringMap.empty, StringMap.empty) in match x, y with | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping && eq_exp rv1 rv2 empty_rename_mapping | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index f5817ae76e..f6abd0c9f3 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -47,17 +47,17 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a rename_mapping, holding the rename assumptions *) - let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: (string, string) Hashtbl.t) = match alocals, blocals with + let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: string StringMap.t) = match alocals, blocals with | [], [] -> true, rename_mapping | origLocal :: als, nowLocal :: bls -> - if origLocal.vname <> nowLocal.vname then Hashtbl.add rename_mapping origLocal.vname nowLocal.vname; + let new_mapping = if origLocal.vname <> nowLocal.vname then StringMap.add origLocal.vname nowLocal.vname rename_mapping else rename_mapping in (*TODO: maybe optimize this with eq_varinfo*) - rename_mapping_aware_compare als bls rename_mapping + rename_mapping_aware_compare als bls new_mapping | _, _ -> false, rename_mapping in - let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (Hashtbl.create 0) in + let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping && GobList.equal (eq_varinfo2 actHeaderRenameMapping) a.sformals b.sformals in @@ -89,8 +89,8 @@ let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_ let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_mapping in identical, unchangedHeader, diffOpt - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty), false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = @@ -105,18 +105,16 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = match old_global, global with | GFun(f, _), GFun (g, _) -> - let renamed_params: (string, string) Hashtbl.t = if (List.length f.sformals) = (List.length g.sformals) then + let renamed_params: string StringMap.t = if (List.length f.sformals) = (List.length g.sformals) then List.combine f.sformals g.sformals |> List.filter (fun (original, now) -> not (original.vname = now.vname)) |> List.map (fun (original, now) -> (original.vname, now.vname)) |> - (fun list -> - let table: (string, string) Hashtbl.t = Hashtbl.create (List.length list) in - List.iter (fun mapping -> Hashtbl.add table (fst mapping) (snd mapping)) list; - table + (fun list -> + List.fold_left (fun map mapping -> StringMap.add (fst mapping) (snd mapping) map) StringMap.empty list ) - else Hashtbl.create 0 in + else StringMap.empty in - if not (f.svar.vname = g.svar.vname) || (Hashtbl.length renamed_params) > 0 then + if not (f.svar.vname = g.svar.vname) || not (StringMap.is_empty renamed_params) then Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} else None | _, _ -> None @@ -162,10 +160,8 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = | Some rename_mapping -> current_global_rename_mapping @ [rename_mapping] | None -> current_global_rename_mapping ) [] |> - (fun mappings -> - let table = Hashtbl.create (List.length mappings) in - List.iter (fun mapping -> Hashtbl.add table mapping.original_method_name mapping) mappings; - table + (fun mappings -> + List.fold_left (fun map mapping -> StringMap.add mapping.original_method_name mapping map) StringMap.empty mappings ) in (* For each function in the new file, check whether a function with the same name From 11de365781e3ac4a6b1217910d9553bc99936228 Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 17 May 2022 19:30:06 +0200 Subject: [PATCH 024/518] CompareAST functions now propagate updated rename_mappings in their return type --- src/incremental/compareAST.ml | 328 ++++++++++++++++++++-------------- src/incremental/compareCFG.ml | 36 ++-- src/incremental/compareCIL.ml | 12 +- 3 files changed, 224 insertions(+), 152 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 4f268d387a..4834796d2b 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -14,8 +14,8 @@ type method_rename_assumptions = method_rename_assumption StringMap.t type rename_mapping = (string StringMap.t) * (method_rename_assumptions) (*Compares two names, being aware of the rename_mapping. Returns true iff: - 1. there is a rename for name1 -> name2 = rename(name1) - 2. there is no rename for name1 -> name1 = name2*) + 1. there is a rename for name1 -> name2 = rename(name1) + 2. there is no rename for name1 -> name1 = name2*) let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = let (local_c, method_c) = rename_mapping in let existingAssumption: string option = StringMap.find_opt name1 local_c in @@ -28,18 +28,29 @@ let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename (*Printf.printf "No assumption when %s, %s, %b\n" name1 name2 (name1 = name2);*) name1 = name2 (*Var names differ, but there is no assumption, so this can't be good*) +(*Creates the mapping of local renames. If the locals do not match in size, an empty mapping is returned.*) +let create_locals_rename_mapping (originalLocalNames: string list) (updatedLocalNames: string list): string StringMap.t = + if (List.length originalLocalNames) = (List.length updatedLocalNames) then + List.combine originalLocalNames updatedLocalNames |> + List.filter (fun (original, now) -> not (original = now)) |> + List.map (fun (original, now) -> (original, now)) |> + (fun list -> + List.fold_left (fun map mapping -> StringMap.add (fst mapping) (snd mapping) map) StringMap.empty list + ) + else StringMap.empty + let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> - List.map (fun x -> match x with (first, second) -> "(" ^ first ^ " -> " ^ second ^ ")") |> - String.concat ", ") ^ "]" + List.map (fun x -> match x with (first, second) -> "(" ^ first ^ " -> " ^ second ^ ")") |> + String.concat ", ") ^ "]" let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods) = rename_mapping in let local_string = string_tuple_to_string (List.of_seq (StringMap.to_seq local)) in let methods_string: string = List.of_seq (StringMap.to_seq methods |> Seq.map snd) |> - List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> - "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ - "; renamed_params=" ^ string_tuple_to_string (List.of_seq (StringMap.to_seq parameter_renames)) ^ ")") |> - String.concat ", " in + List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> + "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ + "; renamed_params=" ^ string_tuple_to_string (List.of_seq (StringMap.to_seq parameter_renames)) ^ ")") |> + String.concat ", " in "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "])" let identifier_of_global glob = @@ -53,6 +64,20 @@ module GlobalMap = Map.Make(struct type t = global_identifier [@@deriving ord] end) +(*rename mapping forward propagation, takes the result from a call and propagates the rename mapping to the next call. + the second call is only executed if the previous call returned true*) +let (&&>>) (prev_result: bool * rename_mapping) f : bool * rename_mapping = + let (prev_equal, updated_rename_mapping) = prev_result in + if prev_equal then f updated_rename_mapping else false, updated_rename_mapping + +(*Same as && but propagates the rename mapping*) +let (&&>) (prev_result: bool * rename_mapping) (b: bool) : bool * rename_mapping = + let (prev_equal, rename_mapping) = prev_result in + (prev_equal && b, rename_mapping) + +(*Same as Goblist.eq but propagates the rename_mapping*) +let forward_list_equal f l1 l2 (prev_result: rename_mapping) : bool * rename_mapping = + List.fold_left2 (fun (b, r) x y -> if b then f x y r else (b, r)) (true, prev_result) l1 l2 (* hack: CIL generates new type names for anonymous types - we want to ignore these *) let compare_name (a: string) (b: string) = @@ -60,34 +85,35 @@ let compare_name (a: string) (b: string) = let anon_union = "__anonunion_" in if a = b then true else BatString.(starts_with a anon_struct && starts_with b anon_struct || starts_with a anon_union && starts_with b anon_union) -let rec eq_constant (rename_mapping: rename_mapping) (a: constant) (b: constant) = +let rec eq_constant (rename_mapping: rename_mapping) (a: constant) (b: constant) : bool * rename_mapping = match a, b with - | CInt (val1, kind1, str1), CInt (val2, kind2, str2) -> Cilint.compare_cilint val1 val2 = 0 && kind1 = kind2 (* Ignore string representation, i.e. 0x2 == 2 *) + | CInt (val1, kind1, str1), CInt (val2, kind2, str2) -> Cilint.compare_cilint val1 val2 = 0 && kind1 = kind2, rename_mapping (* Ignore string representation, i.e. 0x2 == 2 *) | CEnum (exp1, str1, enuminfo1), CEnum (exp2, str2, enuminfo2) -> eq_exp exp1 exp2 rename_mapping (* Ignore name and enuminfo *) - | a, b -> a = b + | a, b -> a = b, rename_mapping and eq_exp2 (rename_mapping: rename_mapping) (a: exp) (b: exp) = eq_exp a b rename_mapping -and eq_exp (a: exp) (b: exp) (rename_mapping: rename_mapping) = +and eq_exp (a: exp) (b: exp) (rename_mapping: rename_mapping) : bool * rename_mapping = match a, b with | Const c1, Const c2 -> eq_constant rename_mapping c1 c2 | Lval lv1, Lval lv2 -> eq_lval lv1 lv2 rename_mapping | SizeOf typ1, SizeOf typ2 -> eq_typ typ1 typ2 rename_mapping | SizeOfE exp1, SizeOfE exp2 -> eq_exp exp1 exp2 rename_mapping - | SizeOfStr str1, SizeOfStr str2 -> str1 = str2 (* possibly, having the same length would suffice *) + | SizeOfStr str1, SizeOfStr str2 -> str1 = str2, rename_mapping (* possibly, having the same length would suffice *) | AlignOf typ1, AlignOf typ2 -> eq_typ typ1 typ2 rename_mapping | AlignOfE exp1, AlignOfE exp2 -> eq_exp exp1 exp2 rename_mapping - | UnOp (op1, exp1, typ1), UnOp (op2, exp2, typ2) -> op1 == op2 && eq_exp exp1 exp2 rename_mapping && eq_typ typ1 typ2 rename_mapping - | BinOp (op1, left1, right1, typ1), BinOp (op2, left2, right2, typ2) -> op1 = op2 && eq_exp left1 left2 rename_mapping && eq_exp right1 right2 rename_mapping && eq_typ typ1 typ2 rename_mapping - | CastE (typ1, exp1), CastE (typ2, exp2) -> eq_typ typ1 typ2 rename_mapping && eq_exp exp1 exp2 rename_mapping + | UnOp (op1, exp1, typ1), UnOp (op2, exp2, typ2) -> + (op1 == op2, rename_mapping) &&>> eq_exp exp1 exp2 &&>> eq_typ typ1 typ2 + | BinOp (op1, left1, right1, typ1), BinOp (op2, left2, right2, typ2) -> (op1 = op2, rename_mapping) &&>> eq_exp left1 left2 &&>> eq_exp right1 right2 &&>> eq_typ typ1 typ2 + | CastE (typ1, exp1), CastE (typ2, exp2) -> eq_typ typ1 typ2 rename_mapping &&>> eq_exp exp1 exp2 | AddrOf lv1, AddrOf lv2 -> eq_lval lv1 lv2 rename_mapping | StartOf lv1, StartOf lv2 -> eq_lval lv1 lv2 rename_mapping - | _, _ -> false + | _, _ -> false, rename_mapping and eq_lhost (a: lhost) (b: lhost) (rename_mapping: rename_mapping) = match a, b with Var v1, Var v2 -> eq_varinfo v1 v2 rename_mapping | Mem exp1, Mem exp2 -> eq_exp exp1 exp2 rename_mapping - | _, _ -> false + | _, _ -> false, rename_mapping and global_typ_acc: (typ * typ) list ref = ref [] (* TODO: optimize with physical Hashtbl? *) @@ -95,159 +121,191 @@ and mem_typ_acc (a: typ) (b: typ) acc = List.exists (fun p -> match p with (x, y and pretty_length () l = Pretty.num (List.length l) -and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = +and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename_mapping) : bool * rename_mapping = if Messages.tracing then Messages.tracei "compareast" "eq_typ_acc %a vs %a (%a, %a)\n" d_type a d_type b pretty_length acc pretty_length !global_typ_acc; (* %a makes List.length calls lazy if compareast isn't being traced *) - let r = match a, b with - | TPtr (typ1, attr1), TPtr (typ2, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && eq_exp lenExp1 lenExp2 rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_args rename_mapping acc) list1 list2 && varArg1 = varArg2 && - GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) - -> eq_typ_acc typ1 typ2 acc rename_mapping && varArg1 = varArg2 && - GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | TNamed (typinfo1, attr1), TNamed (typeinfo2, attr2) -> eq_typ_acc typinfo1.ttype typeinfo2.ttype acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 (* Ignore tname, treferenced *) + let r, updated_rename_mapping = match a, b with + | TPtr (typ1, attr1), TPtr (typ2, attr2) -> + eq_typ_acc typ1 typ2 acc rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 + | TArray (typ1, (Some lenExp1), attr1), TArray (typ2, (Some lenExp2), attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping &&>> eq_exp lenExp1 lenExp2 &&>> forward_list_equal (eq_attribute) attr1 attr2 + | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 + | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) -> + eq_typ_acc typ1 typ2 acc rename_mapping &&>> + forward_list_equal (eq_args acc) list1 list2 &&> + (varArg1 = varArg2) &&>> + forward_list_equal eq_attribute attr1 attr2 + | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) -> + eq_typ_acc typ1 typ2 acc rename_mapping &&> + (varArg1 = varArg2) &&>> + forward_list_equal eq_attribute attr1 attr2 + | TNamed (typinfo1, attr1), TNamed (typeinfo2, attr2) -> + eq_typ_acc typinfo1.ttype typeinfo2.ttype acc rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 (* Ignore tname, treferenced *) | TNamed (tinf, attr), b -> eq_typ_acc tinf.ttype b acc rename_mapping (* Ignore tname, treferenced. TODO: dismiss attributes, or not? *) | a, TNamed (tinf, attr) -> eq_typ_acc a tinf.ttype acc rename_mapping (* Ignore tname, treferenced . TODO: dismiss attributes, or not? *) (* The following two lines are a hack to ensure that anonymous types get the same name and thus, the same typsig *) | TComp (compinfo1, attr1), TComp (compinfo2, attr2) -> if mem_typ_acc a b acc || mem_typ_acc a b !global_typ_acc then ( if Messages.tracing then Messages.trace "compareast" "in acc\n"; - true + true, rename_mapping ) else ( let acc = (a, b) :: acc in - let res = eq_compinfo compinfo1 compinfo2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 in + let (res, rm) = eq_compinfo compinfo1 compinfo2 acc rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 in if res && compinfo1.cname <> compinfo2.cname then compinfo2.cname <- compinfo1.cname; if res then global_typ_acc := (a, b) :: !global_typ_acc; - res + res, rm ) - | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> let res = eq_enuminfo enuminfo1 enuminfo2 rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 in (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); res - | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | TVoid attr1, TVoid attr2 -> GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | TInt (ik1, attr1), TInt (ik2, attr2) -> ik1 = ik2 && GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | TFloat (fk1, attr1), TFloat (fk2, attr2) -> fk1 = fk2 && GobList.equal (eq_attribute rename_mapping) attr1 attr2 - | _, _ -> false + | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> + let (res, rm) = eq_enuminfo enuminfo1 enuminfo2 rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 in + (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); + res, rm + | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> forward_list_equal eq_attribute attr1 attr2 rename_mapping + | TVoid attr1, TVoid attr2 -> forward_list_equal eq_attribute attr1 attr2 rename_mapping + | TInt (ik1, attr1), TInt (ik2, attr2) -> (ik1 = ik2, rename_mapping) &&>> forward_list_equal eq_attribute attr1 attr2 + | TFloat (fk1, attr1), TFloat (fk2, attr2) -> (fk1 = fk2, rename_mapping) &&>> forward_list_equal eq_attribute attr1 attr2 + | _, _ -> false, rename_mapping in if Messages.tracing then Messages.traceu "compareast" "eq_typ_acc %a vs %a\n" d_type a d_type b; - r + (r, updated_rename_mapping) -and eq_typ (a: typ) (b: typ) (rename_mapping: rename_mapping) = eq_typ_acc a b [] rename_mapping +and eq_typ (a: typ) (b: typ) (rename_mapping: rename_mapping) : bool * rename_mapping = eq_typ_acc a b [] rename_mapping -and eq_eitems (rename_mapping: rename_mapping) (a: string * exp * location) (b: string * exp * location) = match a, b with - (name1, exp1, _l1), (name2, exp2, _l2) -> name1 = name2 && eq_exp exp1 exp2 rename_mapping +and eq_eitems (a: string * exp * location) (b: string * exp * location) (rename_mapping: rename_mapping) = match a, b with + (name1, exp1, _l1), (name2, exp2, _l2) -> (name1 = name2, rename_mapping) &&>> eq_exp exp1 exp2 (* Ignore location *) and eq_enuminfo (a: enuminfo) (b: enuminfo) (rename_mapping: rename_mapping) = - compare_name a.ename b.ename && - GobList.equal (eq_attribute rename_mapping) a.eattr b.eattr && - GobList.equal (eq_eitems rename_mapping) a.eitems b.eitems + (compare_name a.ename b.ename, rename_mapping) &&>> + forward_list_equal eq_attribute a.eattr b.eattr &&>> + forward_list_equal eq_eitems a.eitems b.eitems (* Ignore ereferenced *) -and eq_args (rename_mapping: rename_mapping) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with +and eq_args (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) (rename_mapping: rename_mapping) : bool * rename_mapping = match a, b with (name1, typ1, attr1), (name2, typ2, attr2) -> - rename_mapping_aware_name_comparison name1 name2 rename_mapping && eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 + (rename_mapping_aware_name_comparison name1 name2 rename_mapping, rename_mapping) &&>> + eq_typ_acc typ1 typ2 acc &&>> + forward_list_equal eq_attribute attr1 attr2 -and eq_attrparam (rename_mapping: rename_mapping) (a: attrparam) (b: attrparam) = match a, b with - | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam rename_mapping) attrparams1 attrparams2 +and eq_attrparam (a: attrparam) (b: attrparam) (rename_mapping: rename_mapping) : bool * rename_mapping = match a, b with + | ACons (str1, attrparams1), ACons (str2, attrparams2) -> (str1 = str2, rename_mapping) &&>> forward_list_equal eq_attrparam attrparams1 attrparams2 | ASizeOf typ1, ASizeOf typ2 -> eq_typ typ1 typ2 rename_mapping - | ASizeOfE attrparam1, ASizeOfE attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 - | ASizeOfS typsig1, ASizeOfS typsig2 -> typsig1 = typsig2 + | ASizeOfE attrparam1, ASizeOfE attrparam2 -> eq_attrparam attrparam1 attrparam2 rename_mapping + | ASizeOfS typsig1, ASizeOfS typsig2 -> typsig1 = typsig2, rename_mapping | AAlignOf typ1, AAlignOf typ2 -> eq_typ typ1 typ2 rename_mapping - | AAlignOfE attrparam1, AAlignOfE attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 - | AAlignOfS typsig1, AAlignOfS typsig2 -> typsig1 = typsig2 - | AUnOp (op1, attrparam1), AUnOp (op2, attrparam2) -> op1 = op2 && eq_attrparam rename_mapping attrparam1 attrparam2 - | ABinOp (op1, left1, right1), ABinOp (op2, left2, right2) -> op1 = op2 && eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping right1 right2 - | ADot (attrparam1, str1), ADot (attrparam2, str2) -> eq_attrparam rename_mapping attrparam1 attrparam2 && str1 = str2 - | AStar attrparam1, AStar attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 - | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam rename_mapping attrparam1 attrparam2 - | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping right1 right2 - | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> eq_attrparam rename_mapping left1 left2 && eq_attrparam rename_mapping middle1 middle2 && eq_attrparam rename_mapping right1 right2 - | a, b -> a = b - -and eq_attribute (rename_mapping: rename_mapping) (a: attribute) (b: attribute) = match a, b with - | Attr (name1, params1), Attr (name2, params2) -> name1 = name2 && GobList.equal (eq_attrparam rename_mapping) params1 params2 + | AAlignOfE attrparam1, AAlignOfE attrparam2 -> eq_attrparam attrparam1 attrparam2 rename_mapping + | AAlignOfS typsig1, AAlignOfS typsig2 -> typsig1 = typsig2, rename_mapping + | AUnOp (op1, attrparam1), AUnOp (op2, attrparam2) -> (op1 = op2, rename_mapping) &&>> eq_attrparam attrparam1 attrparam2 + | ABinOp (op1, left1, right1), ABinOp (op2, left2, right2) -> (op1 = op2, rename_mapping) &&>> eq_attrparam left1 left2 &&>> eq_attrparam right1 right2 + | ADot (attrparam1, str1), ADot (attrparam2, str2) -> eq_attrparam attrparam1 attrparam2 rename_mapping &&> (str1 = str2) + | AStar attrparam1, AStar attrparam2 -> eq_attrparam attrparam1 attrparam2 rename_mapping + | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam attrparam1 attrparam2 rename_mapping + | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam left1 left2 rename_mapping &&>> eq_attrparam right1 right2 + | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> + eq_attrparam left1 left2 rename_mapping &&>> + eq_attrparam middle1 middle2 &&>> + eq_attrparam right1 right2 + | a, b -> a = b, rename_mapping + +and eq_attribute (a: attribute) (b: attribute) (rename_mapping: rename_mapping) : bool * rename_mapping = match a, b with + | Attr (name1, params1), Attr (name2, params2) -> (name1 = name2, rename_mapping) &&>> forward_list_equal eq_attrparam params1 params2 and eq_varinfo2 (rename_mapping: rename_mapping) (a: varinfo) (b: varinfo) = eq_varinfo a b rename_mapping -and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = +and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool * rename_mapping = (*Printf.printf "Comp %s with %s\n" a.vname b.vname;*) - let (_, method_rename_mappings) = rename_mapping in + let (locals_renames, method_rename_mappings) = rename_mapping in (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) - let isNamingOk = match b.vtype with - | TFun(_, _, _, _) -> ( + let isNamingOk, updated_method_rename_mappings = match a.vtype, b.vtype with + | TFun(_, aParamSpec, _, _), TFun(_, bParamSpec, _, _) -> ( let specific_method_rename_mapping = StringMap.find_opt a.vname method_rename_mappings in match specific_method_rename_mapping with - | Some method_rename_mapping -> method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname - | None -> a.vname = b.vname + | Some method_rename_mapping -> + let is_naming_ok = method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname in + is_naming_ok, method_rename_mappings + | None -> + if a.vname <> b.vname then + (*Function that extracts the names from the param spec of the TFun*) + let extract_names_from_params param_spec = + Option.map (fun list -> List.map (fun (name, _, _) -> name) list) param_spec |> + Option.value ~default:[] + in + + (*No mapping exists yet. Create one.*) + let aParamNames = extract_names_from_params aParamSpec in + let bParamNames = extract_names_from_params bParamSpec in + + let assumption = + {original_method_name = a.vname; new_method_name = b.vname; parameter_renames = create_locals_rename_mapping aParamNames bParamNames} in + + true, StringMap.add a.vname assumption method_rename_mappings + else true, method_rename_mappings ) - | _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping - in + | _, _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping, method_rename_mappings + in (*If the following is a method call, we need to check if we have a mapping for that method call. *) let typ_rename_mapping = match b.vtype with - | TFun(_, _, _, _) -> ( - let new_locals = StringMap.find_opt a.vname method_rename_mappings in + | TFun(_, _, _, _) -> ( + let new_locals = StringMap.find_opt a.vname updated_method_rename_mappings in match new_locals with - | Some locals -> - (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) - (locals.parameter_renames, method_rename_mappings) - | None -> (StringMap.empty, method_rename_mappings) - ) - | _ -> rename_mapping - in - - let typeCheck = eq_typ a.vtype b.vtype typ_rename_mapping in - let attrCheck = GobList.equal (eq_attribute rename_mapping) a.vattr b.vattr in - - (*let _ = if isNamingOk then a.vname <- b.vname in*) + | Some locals -> + (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) + (locals.parameter_renames, updated_method_rename_mappings) + | None -> (StringMap.empty, updated_method_rename_mappings) + ) + | _ -> (locals_renames, updated_method_rename_mappings) + in - (*let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in *) - (*a.vname = b.vname*) - let result = isNamingOk && typeCheck && attrCheck && - a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in + (*Ignore rename mapping for type check, as it doesn't change anyway*) + let (typeCheck, _) = eq_typ a.vtype b.vtype typ_rename_mapping in - result + (typeCheck, (locals_renames, updated_method_rename_mappings)) &&>> + forward_list_equal eq_attribute a.vattr b.vattr &&> + (a.vstorage = b.vstorage) &&> (a.vglob = b.vglob) &&> (a.vaddrof = b.vaddrof) (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) (* Accumulator is needed because of recursive types: we have to assume that two types we already encountered in a previous step of the recursion are equivalent *) -and eq_compinfo (a: compinfo) (b: compinfo) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = - a.cstruct = b.cstruct && - compare_name a.cname b.cname && - GobList.equal (fun a b-> eq_fieldinfo a b acc rename_mapping) a.cfields b.cfields && - GobList.equal (eq_attribute rename_mapping) a.cattr b.cattr && - a.cdefined = b.cdefined (* Ignore ckey, and ignore creferenced *) +and eq_compinfo (a: compinfo) (b: compinfo) (acc: (typ * typ) list) (rename_mapping: rename_mapping) : bool * rename_mapping = + (a.cstruct = b.cstruct, rename_mapping) &&> + compare_name a.cname b.cname &&>> + forward_list_equal (fun a b -> eq_fieldinfo a b acc) a.cfields b.cfields &&>> + forward_list_equal eq_attribute a.cattr b.cattr &&> + (a.cdefined = b.cdefined) (* Ignore ckey, and ignore creferenced *) and eq_fieldinfo (a: fieldinfo) (b: fieldinfo) (acc: (typ * typ) list) (rename_mapping: rename_mapping) = if Messages.tracing then Messages.tracei "compareast" "fieldinfo %s vs %s\n" a.fname b.fname; - let r = a.fname = b.fname && eq_typ_acc a.ftype b.ftype acc rename_mapping && a.fbitfield = b.fbitfield && GobList.equal (eq_attribute rename_mapping) a.fattr b.fattr in + let (r, rm) = (a.fname = b.fname, rename_mapping) &&>> + eq_typ_acc a.ftype b.ftype acc &&> (a.fbitfield = b.fbitfield) &&>> + forward_list_equal eq_attribute a.fattr b.fattr in if Messages.tracing then Messages.traceu "compareast" "fieldinfo %s vs %s\n" a.fname b.fname; - r + (r, rm) -and eq_offset (a: offset) (b: offset) (rename_mapping: rename_mapping) = match a, b with - NoOffset, NoOffset -> true - | Field (info1, offset1), Field (info2, offset2) -> eq_fieldinfo info1 info2 [] rename_mapping && eq_offset offset1 offset2 rename_mapping - | Index (exp1, offset1), Index (exp2, offset2) -> eq_exp exp1 exp2 rename_mapping && eq_offset offset1 offset2 rename_mapping - | _, _ -> false +and eq_offset (a: offset) (b: offset) (rename_mapping: rename_mapping) : bool * rename_mapping = match a, b with + NoOffset, NoOffset -> true, rename_mapping + | Field (info1, offset1), Field (info2, offset2) -> eq_fieldinfo info1 info2 [] rename_mapping &&>> eq_offset offset1 offset2 + | Index (exp1, offset1), Index (exp2, offset2) -> eq_exp exp1 exp2 rename_mapping &&>> eq_offset offset1 offset2 + | _, _ -> false, rename_mapping -and eq_lval (a: lval) (b: lval) (rename_mapping: rename_mapping) = match a, b with - (host1, off1), (host2, off2) -> eq_lhost host1 host2 rename_mapping && eq_offset off1 off2 rename_mapping +and eq_lval (a: lval) (b: lval) (rename_mapping: rename_mapping) : bool * rename_mapping = match a, b with + (host1, off1), (host2, off2) -> eq_lhost host1 host2 rename_mapping &&>> eq_offset off1 off2 -let eq_instr (rename_mapping: rename_mapping) (a: instr) (b: instr) = match a, b with - | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 rename_mapping && eq_exp exp1 exp2 rename_mapping +let eq_instr (a: instr) (b: instr) (rename_mapping: rename_mapping) = match a, b with + | Set (lv1, exp1, _l1, _el1), Set (lv2, exp2, _l2, _el2) -> eq_lval lv1 lv2 rename_mapping &&>> eq_exp exp1 exp2 | Call (Some lv1, f1, args1, _l1, _el1), Call (Some lv2, f2, args2, _l2, _el2) -> - eq_lval lv1 lv2 rename_mapping && eq_exp f1 f2 rename_mapping && GobList.equal (eq_exp2 rename_mapping) args1 args2 + eq_lval lv1 lv2 rename_mapping &&>> eq_exp f1 f2 &&>> forward_list_equal eq_exp args1 args2 | Call (None, f1, args1, _l1, _el1), Call (None, f2, args2, _l2, _el2) -> - eq_exp f1 f2 rename_mapping && GobList.equal (eq_exp2 rename_mapping) args1 args2 - | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> GobList.equal String.equal tmp1 tmp2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_lval z1 z2 rename_mapping) ci1 ci2 && GobList.equal(fun (x1,y1,z1) (x2,y2,z2)-> x1 = x2 && y1 = y2 && eq_exp z1 z2 rename_mapping) dj1 dj2 && GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) + eq_exp f1 f2 rename_mapping &&>> forward_list_equal eq_exp args1 args2 + | Asm (attr1, tmp1, ci1, dj1, rk1, l1), Asm (attr2, tmp2, ci2, dj2, rk2, l2) -> + (GobList.equal String.equal tmp1 tmp2, rename_mapping) &&>> + forward_list_equal (fun (x1,y1,z1) (x2,y2,z2) x-> (x1 = x2, x) &&> (y1 = y2) &&>> eq_lval z1 z2) ci1 ci2 &&>> + forward_list_equal (fun (x1,y1,z1) (x2,y2,z2) x-> (x1 = x2, x) &&> (y1 = y2) &&>> eq_exp z1 z2) dj1 dj2 &&> + GobList.equal String.equal rk1 rk2(* ignore attributes and locations *) | VarDecl (v1, _l1), VarDecl (v2, _l2) -> eq_varinfo v1 v2 rename_mapping - | _, _ -> false + | _, _ -> false, rename_mapping let eq_label (a: label) (b: label) = match a, b with Label (lb1, _l1, s1), Label (lb2, _l2, s2) -> lb1 = lb2 && s1 = s2 @@ -266,34 +324,38 @@ let eq_stmt_with_location ((a, af): stmt * fundec) ((b, bf): stmt * fundec) = compared together with its condition to avoid a to early and not precise detection of a changed node inside). Switch, break and continue statements are removed during cfg preparation and therefore need not to be handeled *) let rec eq_stmtkind ?(cfg_comp = false) ((a, af): stmtkind * fundec) ((b, bf): stmtkind * fundec) (rename_mapping: rename_mapping) = - let eq_block' = fun x y -> if cfg_comp then true else eq_block (x, af) (y, bf) rename_mapping in + let eq_block' = fun x y rm -> if cfg_comp then true, rm else eq_block (x, af) (y, bf) rm in match a, b with - | Instr is1, Instr is2 -> GobList.equal (eq_instr rename_mapping) is1 is2 + | Instr is1, Instr is2 -> forward_list_equal eq_instr is1 is2 rename_mapping | Return (Some exp1, _l1), Return (Some exp2, _l2) -> eq_exp exp1 exp2 rename_mapping - | Return (None, _l1), Return (None, _l2) -> true - | Return _, Return _ -> false - | Goto (st1, _l1), Goto (st2, _l2) -> eq_stmt_with_location (!st1, af) (!st2, bf) - | Break _, Break _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true - | Continue _, Continue _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true - | If (exp1, then1, else1, _l1, _el1), If (exp2, then2, else2, _l2, _el2) -> eq_exp exp1 exp2 rename_mapping && eq_block' then1 then2 && eq_block' else1 else2 - | Switch (exp1, block1, stmts1, _l1, _el1), Switch (exp2, block2, stmts2, _l2, _el2) -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else eq_exp exp1 exp2 rename_mapping && eq_block' block1 block2 && GobList.equal (fun a b -> eq_stmt (a,af) (b,bf) rename_mapping) stmts1 stmts2 - | Loop (block1, _l1, _el1, _con1, _br1), Loop (block2, _l2, _el2, _con2, _br2) -> eq_block' block1 block2 - | Block block1, Block block2 -> eq_block' block1 block2 - | _, _ -> false + | Return (None, _l1), Return (None, _l2) -> true, rename_mapping + | Return _, Return _ -> false, rename_mapping + | Goto (st1, _l1), Goto (st2, _l2) -> eq_stmt_with_location (!st1, af) (!st2, bf), rename_mapping + | Break _, Break _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true, rename_mapping + | Continue _, Continue _ -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else true, rename_mapping + | If (exp1, then1, else1, _l1, _el1), If (exp2, then2, else2, _l2, _el2) -> eq_exp exp1 exp2 rename_mapping &&>> + eq_block' then1 then2 &&>> + eq_block' else1 else2 + | Switch (exp1, block1, stmts1, _l1, _el1), Switch (exp2, block2, stmts2, _l2, _el2) -> if cfg_comp then failwith "CompareCFG: Invalid stmtkind in CFG" else eq_exp exp1 exp2 rename_mapping &&>> eq_block' block1 block2 &&>> forward_list_equal (fun a b -> eq_stmt (a,af) (b,bf)) stmts1 stmts2 + | Loop (block1, _l1, _el1, _con1, _br1), Loop (block2, _l2, _el2, _con2, _br2) -> eq_block' block1 block2 rename_mapping + | Block block1, Block block2 -> eq_block' block1 block2 rename_mapping + | _, _ -> false, rename_mapping and eq_stmt ?(cfg_comp = false) ((a, af): stmt * fundec) ((b, bf): stmt * fundec) (rename_mapping: rename_mapping) = - GobList.equal eq_label a.labels b.labels && - eq_stmtkind ~cfg_comp (a.skind, af) (b.skind, bf) rename_mapping + (GobList.equal eq_label a.labels b.labels, rename_mapping) &&>> + eq_stmtkind ~cfg_comp (a.skind, af) (b.skind, bf) -and eq_block ((a, af): Cil.block * fundec) ((b, bf): Cil.block * fundec) (rename_mapping: rename_mapping) = - a.battrs = b.battrs && GobList.equal (fun x y -> eq_stmt (x, af) (y, bf) rename_mapping) a.bstmts b.bstmts +and eq_block ((a, af): Cil.block * fundec) ((b, bf): Cil.block * fundec) (rename_mapping: rename_mapping) : bool * rename_mapping = + (a.battrs = b.battrs, rename_mapping) &&>> forward_list_equal (fun x y -> eq_stmt (x, af) (y, bf)) a.bstmts b.bstmts let rec eq_init (a: init) (b: init) (rename_mapping: rename_mapping) = match a, b with | SingleInit e1, SingleInit e2 -> eq_exp e1 e2 rename_mapping - | CompoundInit (t1, l1), CompoundInit (t2, l2) -> eq_typ t1 t2 rename_mapping && GobList.equal (fun (o1, i1) (o2, i2) -> eq_offset o1 o2 rename_mapping && eq_init i1 i2 rename_mapping) l1 l2 - | _, _ -> false + | CompoundInit (t1, l1), CompoundInit (t2, l2) -> + eq_typ t1 t2 rename_mapping &&>> + forward_list_equal (fun (o1, i1) (o2, i2) x -> eq_offset o1 o2 x &&>> eq_init i1 i2) l1 l2 + | _, _ -> false, rename_mapping let eq_initinfo (a: initinfo) (b: initinfo) (rename_mapping: rename_mapping) = match a.init, b.init with | (Some init_a), (Some init_b) -> eq_init init_a init_b rename_mapping - | None, None -> true - | _, _ -> false + | None, None -> true, rename_mapping + | _, _ -> false, rename_mapping diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 2a52e6eafe..4f2c37223f 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -3,30 +3,40 @@ open Queue open Cil include CompareAST -let eq_node (x, fun1) (y, fun2) = +(*Non propagating version of &&>>. Discords the new rename_mapping and alwas propagates the one in prev_result*) +let (&&<>) (prev_result: bool * rename_mapping) f : bool * rename_mapping = + let (prev_equal, prev_rm) = prev_result in + if prev_equal then + let (r, _) = f prev_rm in + (r, prev_rm) + else false, prev_rm + +let eq_node (x, fun1) (y, fun2) : bool = let empty_rename_mapping: rename_mapping = (StringMap.empty, StringMap.empty) in match x,y with - | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping - | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping - | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping + | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping |> fst + | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping |> fst + | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping |> fst | _ -> false (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) let eq_edge x y = let empty_rename_mapping: rename_mapping = (StringMap.empty, StringMap.empty) in - match x, y with - | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping && eq_exp rv1 rv2 empty_rename_mapping - | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 + let (r, _) = match x, y with + | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping &&<> eq_exp rv1 rv2 + | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping &&<> forward_list_equal eq_exp ars1 ars2 | Proc (Some r1,f1,ars1), Proc (Some r2,f2,ars2) -> - eq_lval r1 r2 empty_rename_mapping && eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 + eq_lval r1 r2 empty_rename_mapping &&<> eq_exp f1 f2 &&<> forward_list_equal eq_exp ars1 ars2 | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar empty_rename_mapping - | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 empty_rename_mapping && eq_varinfo fd1.svar fd2.svar empty_rename_mapping - | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 empty_rename_mapping && b1 = b2 - | ASM _, ASM _ -> false - | Skip, Skip -> true + | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 empty_rename_mapping &&<> eq_varinfo fd1.svar fd2.svar + | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 empty_rename_mapping &&> (b1 = b2) + | ASM _, ASM _ -> false, empty_rename_mapping + | Skip, Skip -> true, empty_rename_mapping | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 empty_rename_mapping - | _ -> false + | _ -> false, empty_rename_mapping + in + r (* The order of the edges in the list is relevant. Therefore compare them one to one without sorting first *) let eq_edge_list xs ys = GobList.equal eq_edge xs ys diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index f6abd0c9f3..a62459068d 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -60,7 +60,7 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in - let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping && GobList.equal (eq_varinfo2 actHeaderRenameMapping) a.sformals b.sformals in + let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> forward_list_equal eq_varinfo a.sformals b.sformals in let identical, diffOpt = if should_reanalyze a then false, None @@ -69,12 +69,12 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in let rename_mapping: rename_mapping = (local_rename, global_rename_mapping) in - let sameDef = unchangedHeader && sizeEqual in + let sameDef = unchangedHeader &&> sizeEqual |> fst in if not sameDef then (false, None) else match cfgs with - | None -> eq_block (a.sbody, a) (b.sbody, b) rename_mapping, None + | None -> eq_block (a.sbody, a) (b.sbody, b) rename_mapping |> fst, None | Some (cfgOld, (cfgNew, cfgNewBack)) -> let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in @@ -88,9 +88,9 @@ let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_ | GFun (f,_), GFun (g,_) -> let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_mapping in - identical, unchangedHeader, diffOpt - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty), false, None + identical, unchangedHeader |> fst, diffOpt + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty) |> fst, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty) |> fst, false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = From d900e7e48ed6c90d492212deb3bbc2ed802be120 Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 17 May 2022 19:40:35 +0200 Subject: [PATCH 025/518] eqF now returns the method rename dependencies --- src/incremental/compareCIL.ml | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index a62459068d..8a16eb2d08 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -61,9 +61,9 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> forward_list_equal eq_varinfo a.sformals b.sformals in - let identical, diffOpt = + let identical, diffOpt, rename_mapping = if should_reanalyze a then - false, None + false, None, (StringMap.empty, StringMap.empty) else (* Here the local variables are checked to be equal *) let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in @@ -71,24 +71,26 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo let sameDef = unchangedHeader &&> sizeEqual |> fst in if not sameDef then - (false, None) + (false, None, (StringMap.empty, StringMap.empty)) else match cfgs with - | None -> eq_block (a.sbody, a) (b.sbody, b) rename_mapping |> fst, None + | None -> + let (identical, new_rename_mapping) = eq_block (a.sbody, a) (b.sbody, b) rename_mapping in + identical, None, new_rename_mapping | Some (cfgOld, (cfgNew, cfgNewBack)) -> let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in let matches, diffNodes1 = compareFun (module CfgOld) (module CfgNew) a b in - if diffNodes1 = [] then (true, None) - else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}) + if diffNodes1 = [] then (true, None, (StringMap.empty, StringMap.empty)) + else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, (StringMap.empty, StringMap.empty)) in - identical, unchangedHeader, diffOpt + identical, unchangedHeader |> fst, diffOpt let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = match a, b with | GFun (f,_), GFun (g,_) -> let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_mapping in - identical, unchangedHeader |> fst, diffOpt + identical, unchangedHeader, diffOpt | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty) |> fst, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty) |> fst, false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None From 49caf8c1485fa643f1cb67d6e56531065bdb9106 Mon Sep 17 00:00:00 2001 From: Tim ORtel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 18 May 2022 16:09:17 +0200 Subject: [PATCH 026/518] Implemented rename detection of method. Not tested. --- src/framework/analyses.ml | 2 +- src/incremental/compareCIL.ml | 152 ++-------- src/incremental/compareGlobals.ml | 85 ++++++ src/incremental/detectRenamedFunctions.ml | 266 ++++++++++++++++-- src/incremental/updateCil.ml | 1 + src/solvers/td3.ml | 2 +- src/util/server.ml | 4 +- .../05-method-rename/05-deep_change.c | 18 ++ .../05-method-rename/05-deep_change.json | 3 + .../05-method-rename/05-deep_change.patch | 11 + .../05-method-rename/diffs/05-deep-change.c | 18 ++ 11 files changed, 415 insertions(+), 147 deletions(-) create mode 100644 src/incremental/compareGlobals.ml create mode 100644 tests/incremental/05-method-rename/05-deep_change.c create mode 100644 tests/incremental/05-method-rename/05-deep_change.json create mode 100644 tests/incremental/05-method-rename/05-deep_change.patch create mode 100644 tests/incremental/05-method-rename/diffs/05-deep-change.c diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index a605d8e8ed..1b4969dba7 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -407,7 +407,7 @@ type increment_data = { old_data: analyzed_data option; new_file: Cil.file; - changes: CompareCIL.change_info + changes: CompareGlobals.change_info } let empty_increment_data ?(server=false) file = { diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 8a16eb2d08..c038dd42f5 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -1,94 +1,15 @@ open Cil open MyCFG +open CompareGlobals +include DetectRenamedFunctions include CompareAST include CompareCFG -type nodes_diff = { - unchangedNodes: (node * node) list; - primObsoleteNodes: node list; (** primary obsolete nodes -> all obsolete nodes are reachable from these *) -} - -type unchanged_global = { - old: global; - current: global -} -(** For semantically unchanged globals, still keep old and current version of global for resetting current to old. *) - -type changed_global = { - old: global; - current: global; - unchangedHeader: bool; - diff: nodes_diff option -} - -type change_info = { - mutable changed: changed_global list; - mutable unchanged: unchanged_global list; - mutable removed: global list; - mutable added: global list -} - let empty_change_info () : change_info = {added = []; removed = []; changed = []; unchanged = []} -let should_reanalyze (fdec: Cil.fundec) = - List.mem fdec.svar.vname (GobConfig.get_string_list "incremental.force-reanalyze.funs") - -(* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which - * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is - * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) -let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = - let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in - - if (List.length a.slocals) = (List.length b.slocals) then - List.combine a.slocals b.slocals |> - List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> - List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); - - - (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, - * and as a second a rename_mapping, holding the rename assumptions *) - let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: string StringMap.t) = match alocals, blocals with - | [], [] -> true, rename_mapping - | origLocal :: als, nowLocal :: bls -> - let new_mapping = if origLocal.vname <> nowLocal.vname then StringMap.add origLocal.vname nowLocal.vname rename_mapping else rename_mapping in - - (*TODO: maybe optimize this with eq_varinfo*) - rename_mapping_aware_compare als bls new_mapping - | _, _ -> false, rename_mapping - in - - let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in - let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in - - let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> forward_list_equal eq_varinfo a.sformals b.sformals in - let identical, diffOpt, rename_mapping = - if should_reanalyze a then - false, None, (StringMap.empty, StringMap.empty) - else - (* Here the local variables are checked to be equal *) - let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in - let rename_mapping: rename_mapping = (local_rename, global_rename_mapping) in - - let sameDef = unchangedHeader &&> sizeEqual |> fst in - if not sameDef then - (false, None, (StringMap.empty, StringMap.empty)) - else - match cfgs with - | None -> - let (identical, new_rename_mapping) = eq_block (a.sbody, a) (b.sbody, b) rename_mapping in - identical, None, new_rename_mapping - | Some (cfgOld, (cfgNew, cfgNewBack)) -> - let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in - let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in - let matches, diffNodes1 = compareFun (module CfgOld) (module CfgNew) a b in - if diffNodes1 = [] then (true, None, (StringMap.empty, StringMap.empty)) - else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, (StringMap.empty, StringMap.empty)) - in - identical, unchangedHeader |> fst, diffOpt - -let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = match a, b with +let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_mapping in + let identical, unchangedHeader, diffOpt, _ = CompareGlobals.eqF f g cfgs StringMap.empty in identical, unchangedHeader, diffOpt | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty) |> fst, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) @@ -100,29 +21,6 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = then Some (CfgTools.getCFG oldAST |> fst, CfgTools.getCFG newAST) else None in - let generate_global_rename_mapping map global = - try - let ident = identifier_of_global global in - let old_global = GlobalMap.find ident map in - - match old_global, global with - | GFun(f, _), GFun (g, _) -> - let renamed_params: string StringMap.t = if (List.length f.sformals) = (List.length g.sformals) then - List.combine f.sformals g.sformals |> - List.filter (fun (original, now) -> not (original.vname = now.vname)) |> - List.map (fun (original, now) -> (original.vname, now.vname)) |> - (fun list -> - List.fold_left (fun map mapping -> StringMap.add (fst mapping) (snd mapping) map) StringMap.empty list - ) - else StringMap.empty in - - if not (f.svar.vname = g.svar.vname) || not (StringMap.is_empty renamed_params) then - Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} - else None - | _, _ -> None - with Not_found -> None - in - let addGlobal map global = try let gid = identifier_of_global global in @@ -137,15 +35,21 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let changes = empty_change_info () in global_typ_acc := []; - let findChanges map global global_rename_mapping = + let findChanges map global = try - let ident = identifier_of_global global in - let old_global = GlobalMap.find ident map in - (* Do a (recursive) equal comparison ignoring location information *) - let identical, unchangedHeader, diff = eq old_global global cfgs global_rename_mapping in - if identical - then changes.unchanged <- {current = global; old = old_global} :: changes.unchanged - else changes.changed <- {current = global; old = old_global; unchangedHeader; diff} :: changes.changed + let isGFun = match global with + | GFun _-> false (* set to true later to disable finding changes for funs*) + | _ -> false + in + + if not isGFun then + let ident = identifier_of_global global in + let old_global = GlobalMap.find ident map in + (* Do a (recursive) equal comparison ignoring location information *) + let identical, unchangedHeader, diff = eq old_global global cfgs in + if identical + then changes.unchanged <- {current = global; old = old_global} :: changes.unchanged + else changes.changed <- {current = global; old = old_global; unchangedHeader; diff} :: changes.changed with Not_found -> () (* Global was no variable or function, it does not belong into the map *) in let checkExists map global = @@ -157,19 +61,21 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in - let global_rename_mapping: method_rename_assumptions = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> - match generate_global_rename_mapping oldMap global with - | Some rename_mapping -> current_global_rename_mapping @ [rename_mapping] - | None -> current_global_rename_mapping - ) [] |> - (fun mappings -> - List.fold_left (fun map mapping -> StringMap.add mapping.original_method_name mapping map) StringMap.empty mappings - ) in + let renameDetectionResults = detectRenamedFunctions oldAST newAST in + FundecMap.to_seq renameDetectionResults |> + Seq.iter + (fun (fundec, (functionGlobal, status)) -> + Printf.printf "Function satus of %s is=" fundec.svar.vname; + match status with + | SameName _ -> Printf.printf "Same Name\n"; + | Renamed rd -> Printf.printf "Renamed to %s" rd.nowName; + | ChangedOrNewOrDeleted -> Printf.printf "Changed or new or deleted." + ); (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) Cil.iterGlobals newAST - (fun glob -> findChanges oldMap glob global_rename_mapping); + (fun glob -> findChanges oldMap glob); (* We check whether functions have been added or removed *) Cil.iterGlobals newAST (fun glob -> if not (checkExists oldMap glob) then changes.added <- (glob::changes.added)); diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml new file mode 100644 index 0000000000..e0cde8735a --- /dev/null +++ b/src/incremental/compareGlobals.ml @@ -0,0 +1,85 @@ +open Cil +open MyCFG +include CompareAST +include CompareCFG + +type nodes_diff = { + unchangedNodes: (node * node) list; + primObsoleteNodes: node list; (** primary obsolete nodes -> all obsolete nodes are reachable from these *) +} + +type unchanged_global = { + old: global; + current: global +} +(** For semantically unchanged globals, still keep old and current version of global for resetting current to old. *) + +type changed_global = { + old: global; + current: global; + unchangedHeader: bool; + diff: nodes_diff option +} + +type change_info = { + mutable changed: changed_global list; + mutable unchanged: unchanged_global list; + mutable removed: global list; + mutable added: global list +} + +let should_reanalyze (fdec: Cil.fundec) = + List.mem fdec.svar.vname (GobConfig.get_string_list "incremental.force-reanalyze.funs") + +(* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which + * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is + * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) + let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = + let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in + + if (List.length a.slocals) = (List.length b.slocals) then + List.combine a.slocals b.slocals |> + List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> + List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); + + + (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, + * and as a second a rename_mapping, holding the rename assumptions *) + let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: string StringMap.t) = match alocals, blocals with + | [], [] -> true, rename_mapping + | origLocal :: als, nowLocal :: bls -> + let new_mapping = if origLocal.vname <> nowLocal.vname then StringMap.add origLocal.vname nowLocal.vname rename_mapping else rename_mapping in + + (*TODO: maybe optimize this with eq_varinfo*) + rename_mapping_aware_compare als bls new_mapping + | _, _ -> false, rename_mapping + in + + let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in + let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in + + let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> forward_list_equal eq_varinfo a.sformals b.sformals in + let identical, diffOpt, (_, renamed_method_dependencies) = + if should_reanalyze a then + false, None, (StringMap.empty, StringMap.empty) + else + (* Here the local variables are checked to be equal *) + let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in + let rename_mapping: rename_mapping = (local_rename, global_rename_mapping) in + + let sameDef = unchangedHeader &&> sizeEqual |> fst in + if not sameDef then + (false, None, (StringMap.empty, StringMap.empty)) + else + match cfgs with + | None -> + let (identical, new_rename_mapping) = eq_block (a.sbody, a) (b.sbody, b) rename_mapping in + identical, None, new_rename_mapping + | Some (cfgOld, (cfgNew, cfgNewBack)) -> + let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in + let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in + let matches, diffNodes1 = compareFun (module CfgOld) (module CfgNew) a b in + if diffNodes1 = [] then (true, None, (StringMap.empty, StringMap.empty)) + else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, (StringMap.empty, StringMap.empty)) + in + identical, unchangedHeader |> fst, diffOpt, renamed_method_dependencies diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index c4fe19674e..9ff36b69cd 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -3,41 +3,267 @@ open MyCFG include CompareAST include CompareCFG -(*Maps the function name as keys*) -module FundecMap = Map.Make(String);; +module StringSet = Set.Make(String) -type functionStatus = Identical | Renamed | Changed | New | Deleted -type results = (fundec, functionStatus) Hashtbl.t +type f = fundec * location -(*A dependency mapps the function it depends on to the name the function has to be changed to*) -type dependencies = (fundec, string) Hashtbl.t +type dependencyPointer = {oldName: string; dependencyCount: int} -type earlyFunctionStatus = Unchanged of dependencies | Unknown +module OldFunNameWithDependencyCount = struct + type t = dependencyPointer + let compare x y = Int.compare x.dependencyCount y.dependencyCount +end + +module FundecForMap = struct + type t = Cil.fundec + + let compare x y = Int.compare x.svar.vid y.svar.vid +end + +module DependencyHeap = BatHeap.Make(OldFunNameWithDependencyCount) + +module FundecMap = Map.Make(FundecForMap) + +(*A dependency maps the function it depends on to the name the function has to be changed to*) +type dependencies = string StringMap.t + +(*The dependents map the functions that depend with the name they need it to be changed to*) +type dependents = string StringMap.t + +(*hadWrongAssumption: set to true, if one of the depencies this node had, was wrong. Thus this node is changed.*) +type nodeData = {nowName: string; dependencies: dependencies; dependents: dependents; hadWrongAssumption: bool} + +type renameData = {nowName: string; dependencies: dependencies} + +(*A direct match means that the function name stayed the same and the old and new function match (with contraints defined by dependencies). *) +type earlyFunctionStatus = DirectMatch of dependencies | Changed | Unknown + +(*Renamed: newName * dependencies*) +type functionStatus = SameName of dependencies | Renamed of renameData | ChangedOrNewOrDeleted +type results = functionStatus StringMap.t -let getFunctionMap (ast: file) : fundec FundecMap.t = +type output = global * functionStatus + + +let getFunctionMap (ast: file) : f StringMap.t = Cil.foldGlobals ast (fun map global -> match global with - | GFun (fundec, _) -> FundecMap.add fundec.svar.vname fundec map + | GFun (fundec, location) -> StringMap.add fundec.svar.vname (fundec, location) map | _ -> map - ) FundecMap.empty + ) StringMap.empty + +let getDependencies fromEq = StringMap.map (fun assumption -> assumption.new_method_name) fromEq -let seperateUnchangedFunctions (oldFunctionMap: fundec FundecMap.t) (newFunctionMap: fundec FundecMap.t) : earlyFunctionStatus FundecMap.t = - FundecMap.map (fun f -> - let matchingNewFundec = FundecMap.find_opt f.svar.vname newFunctionMap in +(*Split the functions up in those which have not been renamed, and such which have been renamed, are new or have been deleted*) +let seperateUnchangedFunctions (oldFunctionMap: f StringMap.t) (nowFunctionMap: f StringMap.t) : earlyFunctionStatus StringMap.t = + StringMap.map (fun (f, _) -> + let matchingNewFundec = StringMap.find_opt f.svar.vname nowFunctionMap in match matchingNewFundec with - | Some newFun -> + | Some (newFun, _) -> (*Compare if they are similar*) - let result = CompareCIL.eqF f newFun None (Hashtbl.create 0) in - Unknown + let doMatch, _, _, dependencies = CompareGlobals.eqF f newFun None StringMap.empty in + if doMatch then DirectMatch(getDependencies dependencies) + else Unknown | None -> Unknown ) oldFunctionMap -let detectRenamedFunctions (oldAST: file) (newAST: file) : results = begin +(* +Tries to find a partner for each method that is not a direct match. +Returns the found partner for each unknown function with the rename dependencies or ChangedOrNewOrDeleted if no partner was found. +Use sets instead of lists, because member lookups are faster in sets.*) +let categorizeUnknownFunctions + (unknownFunctions: StringSet.t) + (directMatchFunctions: StringSet.t) + (oldFunctionMap: f StringMap.t) + (nowFunctionMap: f StringMap.t) : functionStatus StringMap.t = + let nowFunctionMapWithoutDirectMatchFunctions = StringMap.filter (fun key _ -> not (StringSet.mem key directMatchFunctions)) nowFunctionMap in + + StringSet.fold (fun functionWithUnknownStatusName map -> + (*The unknown functions directly come from the oldFunctionMap, so there has to be an entry.*) + let (functionWithUnknownStatusFundec, _) = StringMap.find functionWithUnknownStatusName oldFunctionMap in + + (*Find the first match in all new unknown functions: O(all_functions - direct_functions)*) + let foundFunctionMatch = + StringMap.to_seq nowFunctionMapWithoutDirectMatchFunctions |> + Seq.map (fun (name, (f, _)) -> name, f) |> + Seq.find_map (fun (nowFunName, nowFunFundec) -> + let doMatch, _, _, dependencies = CompareGlobals.eqF functionWithUnknownStatusFundec nowFunFundec None StringMap.empty in + if doMatch then Option.some ( + {nowName = nowFunName; dependencies = getDependencies dependencies} + ) else None + ) in + + match foundFunctionMatch with + | Some renameData -> StringMap.add functionWithUnknownStatusName (Renamed(renameData)) map + | None -> StringMap.add functionWithUnknownStatusName ChangedOrNewOrDeleted map + ) unknownFunctions StringMap.empty + + +(*Marks the changed node as changed in the results and also marks all nodes that depend on that node as changed. *) +let rec propagateChangedNode (changedNodeOldName: string) + (nodeMap: nodeData StringMap.t) + (dependencyHeap: DependencyHeap.t) + (currentResults: results) : (nodeData StringMap.t) * (DependencyHeap.t) * (results) = + let resultsWithChangedNode = StringMap.add changedNodeOldName ChangedOrNewOrDeleted currentResults in + let changedNodeData = StringMap.find changedNodeOldName nodeMap in + (*BatHeap does not support removing an element directly. Maybe we should use a different implementation.*) + let dependencyHeapWithoutChangedNode: DependencyHeap.t = + dependencyHeap |> + DependencyHeap.to_list |> + List.filter (fun pointer -> pointer.oldName <> changedNodeOldName) |> + DependencyHeap.of_list in + + changedNodeData.dependents |> + StringMap.to_seq |> + Seq.fold_left (fun (nodeMap, dependencyHeap, currentResults) (dependentName, _) -> + propagateChangedNode dependentName nodeMap dependencyHeap currentResults + ) (nodeMap, dependencyHeapWithoutChangedNode, resultsWithChangedNode) + +(* Takes the node with the currently least dependencies and tries to reduce the graph from that node. + Cyclic dependency graphs are currently not supported. If a cyclic dependency is found, all remaining nodes are marked as changed. + + Function is applied recursivly until no nodes remain in the graph. +*) +let rec reduceNodeGraph (nodeMap: nodeData StringMap.t) (dependencyHeap: DependencyHeap.t) (currentResults: results) : results = + if DependencyHeap.size dependencyHeap = 0 then currentResults + else + let topDependencyPointer = DependencyHeap.find_min dependencyHeap in + let currentNode = StringMap.find topDependencyPointer.oldName nodeMap in + + let newDependencyHeap = DependencyHeap.del_min dependencyHeap in + + if topDependencyPointer.dependencyCount = 0 then + (*Remove this node from the dependecies of the nodes that depend on it. + The nodes that depend on the wrong name are set to be changed.*) + let newNodeMap = currentNode.dependents |> + StringMap.to_seq |> + Seq.fold_left (fun nodeMap (dependingFun, dependingOnName) -> + let dependeeNodeData: nodeData = StringMap.find dependingFun nodeMap in + + (*Remove the dependency of current node from the dependencies of the dependee*) + let newDependencies = dependeeNodeData.dependencies |> + StringMap.filter (fun dependingName _ -> dependingName <> topDependencyPointer.oldName) + in + + let hadWrongAssumption = if currentNode.nowName <> dependingOnName then true + else dependeeNodeData.hadWrongAssumption + in + + let newNodeData = { + nowName = dependeeNodeData.nowName; + dependencies = newDependencies; + dependents = dependeeNodeData.dependents; + hadWrongAssumption = hadWrongAssumption + } in + + (*Replace node data in map*) + let newNodeMap = StringMap.add dependingFun newNodeData nodeMap in + + newNodeMap + + ) nodeMap in + + let status = if currentNode.hadWrongAssumption then ChangedOrNewOrDeleted else Renamed({nowName=currentNode.nowName; dependencies=currentNode.dependencies}) in + + let newResults = StringMap.add topDependencyPointer.oldName status currentResults in + + reduceNodeGraph newNodeMap newDependencyHeap newResults + else + (*Cyclic dependency found. *) + (*Mark all remaining nodes with dependencies as changed.*) + DependencyHeap.to_list dependencyHeap |> + List.fold_left (fun results dependencyPointer -> + StringMap.add dependencyPointer.oldName ChangedOrNewOrDeleted results + ) currentResults + +let detectRenamedFunctions (oldAST: file) (newAST: file) : output FundecMap.t = begin let oldFunctionMap = getFunctionMap oldAST in - let newFunctionMap = getFunctionMap newAST in + let nowFunctionMap = getFunctionMap newAST in (*1. detect function which names have not changed*) - let unchangedNameFunctions = FundecMap.map (fun _ fundec -> ) oldFunctionMap in + let statusForFunction = seperateUnchangedFunctions oldFunctionMap nowFunctionMap in + + let directMatchFunctions, knownChangedFunctions, unknownFunctions, initialCategorization = StringMap.fold ( + fun funName earlyStatus (directMatchFunctions, knownChangedFunctions, unknownFunctions, initialCategorization) -> match earlyStatus with + | DirectMatch d -> ( + StringSet.add funName directMatchFunctions, + knownChangedFunctions, + unknownFunctions, + StringMap.add funName (SameName(d)) initialCategorization + ) + | Changed -> ( + directMatchFunctions, + StringSet.add funName knownChangedFunctions, + unknownFunctions, + StringMap.add funName ChangedOrNewOrDeleted initialCategorization + ) + | Unknown -> ( + directMatchFunctions, + knownChangedFunctions, + StringSet.add funName unknownFunctions, + initialCategorization + ) + ) statusForFunction (StringSet.empty, StringSet.empty, StringSet.empty, StringMap.empty) in + + (*2. get dependencies of those functions we did match in 1. + These function statuses are just early guesses. They still need to be checked and adapted in the graph analysis.*) + let categorizationResults = categorizeUnknownFunctions unknownFunctions directMatchFunctions oldFunctionMap nowFunctionMap in + + (*3. build dependency graph*) + let categorizationMap = StringMap.union (fun _ _ _ -> None) initialCategorization categorizationResults in + + (*dependentsMap>*) + (*Generate the dependents map now, so it does not have to be done when generating the node map*) + let dependentsMap: string StringMap.t StringMap.t = StringMap.fold (fun oldFunName functionStatus dependentsMap -> + (*Go through all dependencies and add itself to the list of dependents*) + let addDependents dependencies = StringMap.fold (fun dependingOn hasToBeNamed dependentsMap -> + let currentDependents = StringMap.find_opt dependingOn dependentsMap |> + Option.value ~default:StringMap.empty in + + let newDependents = StringMap.add oldFunName hasToBeNamed currentDependents in + + StringMap.add dependingOn newDependents dependentsMap + ) dependencies dependentsMap + in + + match functionStatus with + | SameName dependencies -> addDependents dependencies + | Renamed renameData -> addDependents renameData.dependencies + | ChangedOrNewOrDeleted -> dependentsMap + ) categorizationMap StringMap.empty in + + (*The nodes are represented in the node map. The node data contains the nowName, + and the nodes it depends on as well as the nodes that depend on that node. + The dependencyHeap points to the function name with the currently least dependencies.*) + let (nodeMap: nodeData StringMap.t), (dependencyHeap: DependencyHeap.t) = + StringMap.fold (fun oldFunName functionStatus (nodeMap, dependencyHeap) -> + let dependents = StringMap.find_opt oldFunName dependentsMap |> + Option.value ~default:StringMap.empty in + + let getNodeEntry dependencies = {nowName=oldFunName; dependencies = dependencies; dependents = dependents; hadWrongAssumption = false} in + let getDependencyPointer dependencies = {oldName=oldFunName; dependencyCount=StringMap.cardinal dependencies} in + + match functionStatus with + | SameName dependencies -> + ( + StringMap.add oldFunName (getNodeEntry dependencies) nodeMap, + DependencyHeap.add (getDependencyPointer dependencies) dependencyHeap + ) + | Renamed renameData -> + ( + StringMap.add oldFunName (getNodeEntry renameData.dependencies) nodeMap, + DependencyHeap.add (getDependencyPointer renameData.dependencies) dependencyHeap + ) + | ChangedOrNewOrDeleted -> (nodeMap, dependencyHeap) + ) categorizationMap (StringMap.empty, DependencyHeap.empty) in + + + let result = reduceNodeGraph nodeMap dependencyHeap StringMap.empty in + + let x = StringMap.to_seq result |> + Seq.map (fun (oldName, status) -> + let (f, l) = StringMap.find oldName oldFunctionMap in + f, (GFun(f, l), status)) in - Hashtbl.create 0 + FundecMap.add_seq x FundecMap.empty end diff --git a/src/incremental/updateCil.ml b/src/incremental/updateCil.ml index 2cf28ba329..90bca36304 100644 --- a/src/incremental/updateCil.ml +++ b/src/incremental/updateCil.ml @@ -2,6 +2,7 @@ open Cil open CompareCIL open MaxIdUtil open MyCFG +open CompareGlobals module NodeMap = Hashtbl.Make(Node) diff --git a/src/solvers/td3.ml b/src/solvers/td3.ml index 254d2fcd85..a0e95e1d65 100644 --- a/src/solvers/td3.ml +++ b/src/solvers/td3.ml @@ -13,7 +13,7 @@ open Prelude open Analyses open Constraints open Messages -open CompareCIL +open CompareGlobals open Cil module WP = diff --git a/src/util/server.ml b/src/util/server.ml index c9cba4c664..380acf6ebf 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -120,8 +120,8 @@ let reparse (s: t) = (* Only called when the file has not been reparsed, so we can skip the expensive CFG comparison. *) let virtual_changes file = - let eq (glob: Cil.global) _ _ _ = match glob with - | GFun (fdec, _) -> not (CompareCIL.should_reanalyze fdec), false, None + let eq (glob: Cil.global) _ _ = match glob with + | GFun (fdec, _) -> not (CompareGlobals.should_reanalyze fdec), false, None | _ -> true, false, None in CompareCIL.compareCilFiles ~eq file file diff --git a/tests/incremental/05-method-rename/05-deep_change.c b/tests/incremental/05-method-rename/05-deep_change.c new file mode 100644 index 0000000000..80037f934d --- /dev/null +++ b/tests/incremental/05-method-rename/05-deep_change.c @@ -0,0 +1,18 @@ +#include + +void zap() { + printf("zap"); +} + +void bar() { + zap(); +} + +void foo() { + bar(); +} + +int main() { + foo(); + return 0; +} diff --git a/tests/incremental/05-method-rename/05-deep_change.json b/tests/incremental/05-method-rename/05-deep_change.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/05-deep_change.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/05-deep_change.patch b/tests/incremental/05-method-rename/05-deep_change.patch new file mode 100644 index 0000000000..0374da2fb6 --- /dev/null +++ b/tests/incremental/05-method-rename/05-deep_change.patch @@ -0,0 +1,11 @@ +--- tests/incremental/05-method-rename/05-deep_change.c ++++ tests/incremental/05-method-rename/05-deep_change.c +@@ -1,7 +1,7 @@ + #include + + void zap() { +- printf("zap"); ++ printf("drap"); + } + + void bar() { diff --git a/tests/incremental/05-method-rename/diffs/05-deep-change.c b/tests/incremental/05-method-rename/diffs/05-deep-change.c new file mode 100644 index 0000000000..57ad90457b --- /dev/null +++ b/tests/incremental/05-method-rename/diffs/05-deep-change.c @@ -0,0 +1,18 @@ +#include + +void zap() { + printf("drap"); +} + +void bar() { + zap(); +} + +void foo() { + bar(); +} + +int main() { + foo(); + return 0; +} From abef1169bb6315a4dce4f262436c4bb7c21df45c Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 25 May 2022 14:01:22 +0200 Subject: [PATCH 027/518] Removed obsolete method and smaller changes --- src/incremental/detectRenamedFunctions.ml | 31 +++++------------------ 1 file changed, 6 insertions(+), 25 deletions(-) diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 9ff36b69cd..6d7ba79126 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -98,27 +98,6 @@ let categorizeUnknownFunctions | None -> StringMap.add functionWithUnknownStatusName ChangedOrNewOrDeleted map ) unknownFunctions StringMap.empty - -(*Marks the changed node as changed in the results and also marks all nodes that depend on that node as changed. *) -let rec propagateChangedNode (changedNodeOldName: string) - (nodeMap: nodeData StringMap.t) - (dependencyHeap: DependencyHeap.t) - (currentResults: results) : (nodeData StringMap.t) * (DependencyHeap.t) * (results) = - let resultsWithChangedNode = StringMap.add changedNodeOldName ChangedOrNewOrDeleted currentResults in - let changedNodeData = StringMap.find changedNodeOldName nodeMap in - (*BatHeap does not support removing an element directly. Maybe we should use a different implementation.*) - let dependencyHeapWithoutChangedNode: DependencyHeap.t = - dependencyHeap |> - DependencyHeap.to_list |> - List.filter (fun pointer -> pointer.oldName <> changedNodeOldName) |> - DependencyHeap.of_list in - - changedNodeData.dependents |> - StringMap.to_seq |> - Seq.fold_left (fun (nodeMap, dependencyHeap, currentResults) (dependentName, _) -> - propagateChangedNode dependentName nodeMap dependencyHeap currentResults - ) (nodeMap, dependencyHeapWithoutChangedNode, resultsWithChangedNode) - (* Takes the node with the currently least dependencies and tries to reduce the graph from that node. Cyclic dependency graphs are currently not supported. If a cyclic dependency is found, all remaining nodes are marked as changed. @@ -135,9 +114,9 @@ let rec reduceNodeGraph (nodeMap: nodeData StringMap.t) (dependencyHeap: Depende if topDependencyPointer.dependencyCount = 0 then (*Remove this node from the dependecies of the nodes that depend on it. The nodes that depend on the wrong name are set to be changed.*) - let newNodeMap = currentNode.dependents |> + let (newNodeMap, updatedDependencyHeap) = currentNode.dependents |> StringMap.to_seq |> - Seq.fold_left (fun nodeMap (dependingFun, dependingOnName) -> + Seq.fold_left (fun (nodeMap, dependencyHeap) (dependingFun, dependingOnName) -> let dependeeNodeData: nodeData = StringMap.find dependingFun nodeMap in (*Remove the dependency of current node from the dependencies of the dependee*) @@ -145,6 +124,8 @@ let rec reduceNodeGraph (nodeMap: nodeData StringMap.t) (dependencyHeap: Depende StringMap.filter (fun dependingName _ -> dependingName <> topDependencyPointer.oldName) in + (*TODO: Update dependencyheap by decreasing the dependency count by 1*) + let hadWrongAssumption = if currentNode.nowName <> dependingOnName then true else dependeeNodeData.hadWrongAssumption in @@ -159,9 +140,9 @@ let rec reduceNodeGraph (nodeMap: nodeData StringMap.t) (dependencyHeap: Depende (*Replace node data in map*) let newNodeMap = StringMap.add dependingFun newNodeData nodeMap in - newNodeMap + newNodeMap, dependencyHeap - ) nodeMap in + ) (nodeMap, newDependencyHeap) in let status = if currentNode.hadWrongAssumption then ChangedOrNewOrDeleted else Renamed({nowName=currentNode.nowName; dependencies=currentNode.dependencies}) in From b9ad6dbbc29b6752b5d14bd02bfbc8a0f6c4f165 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 25 May 2022 18:30:13 +0200 Subject: [PATCH 028/518] Implemented simple rename detection for methods --- src/incremental/compareCIL.ml | 46 ++- src/incremental/detectRenamedFunctions.ml | 361 ++++++++---------- src/incremental/updateCil.ml | 1 - .../05-method-rename/00-simple_rename.json | 3 + .../05-method-rename/00-simple_rename.patch | 4 +- .../05-method-rename/01-dependent_rename.json | 3 + .../01-dependent_rename.patch | 4 +- 7 files changed, 189 insertions(+), 233 deletions(-) create mode 100644 tests/incremental/05-method-rename/00-simple_rename.json create mode 100644 tests/incremental/05-method-rename/01-dependent_rename.json diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index c038dd42f5..13e1f42069 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -40,7 +40,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let isGFun = match global with | GFun _-> false (* set to true later to disable finding changes for funs*) | _ -> false - in + in if not isGFun then let ident = identifier_of_global global in @@ -52,34 +52,46 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = else changes.changed <- {current = global; old = old_global; unchangedHeader; diff} :: changes.changed with Not_found -> () (* Global was no variable or function, it does not belong into the map *) in - let checkExists map global = - match identifier_of_global global with - | name -> GlobalMap.mem name map - | exception Not_found -> true (* return true, so isn't considered a change *) - in + (* Store a map from functionNames in the old file to the function definition*) let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in - let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in let renameDetectionResults = detectRenamedFunctions oldAST newAST in FundecMap.to_seq renameDetectionResults |> - Seq.iter + Seq.iter (fun (fundec, (functionGlobal, status)) -> - Printf.printf "Function satus of %s is=" fundec.svar.vname; - match status with - | SameName _ -> Printf.printf "Same Name\n"; - | Renamed rd -> Printf.printf "Renamed to %s" rd.nowName; - | ChangedOrNewOrDeleted -> Printf.printf "Changed or new or deleted." - ); + Printf.printf "Function status of %s is=" fundec.svar.vname; + match status with + | Unchanged _ -> Printf.printf "Same Name\n"; + | Added -> Printf.printf "Added\n"; + | Removed -> Printf.printf "Removed\n"; + | Changed _ -> Printf.printf "Changed\n"; + | UnchangedButRenamed toFrom -> + match toFrom with + | GFun (f, _) -> Printf.printf "Renamed to %s\n" f.svar.vname; + | _ -> Printf.printf "TODO"; + ); (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) Cil.iterGlobals newAST (fun glob -> findChanges oldMap glob); - (* We check whether functions have been added or removed *) - Cil.iterGlobals newAST (fun glob -> if not (checkExists oldMap glob) then changes.added <- (glob::changes.added)); - Cil.iterGlobals oldAST (fun glob -> if not (checkExists newMap glob) then changes.removed <- (glob::changes.removed)); + let unchanged, changed, added, removed = FundecMap.fold (fun _ (global, status) (u, c, a, r) -> + match status with + | Unchanged now -> (u @ [{old=global; current=now}], c, a, r) + | UnchangedButRenamed now -> (u @ [{old=global; current=now}], c, a, r) + | Added -> (u, c, a @ [global], r) + | Removed -> (u, c, a, r @ [global]) + | Changed (now, unchangedHeader) -> (u, c @ [{old=global; current=now; unchangedHeader=unchangedHeader; diff=None}], a, r) + ) renameDetectionResults (changes.unchanged, changes.changed, changes.added, changes.removed) + in + + changes.added <- added; + changes.removed <- removed; + changes.changed <- changed; + changes.unchanged <- unchanged; + changes (** Given an (optional) equality function between [Cil.global]s, an old and a new [Cil.file], this function computes a [change_info], diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 6d7ba79126..99bc4a6f68 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -7,43 +7,36 @@ module StringSet = Set.Make(String) type f = fundec * location -type dependencyPointer = {oldName: string; dependencyCount: int} - -module OldFunNameWithDependencyCount = struct - type t = dependencyPointer - let compare x y = Int.compare x.dependencyCount y.dependencyCount -end - module FundecForMap = struct type t = Cil.fundec - let compare x y = Int.compare x.svar.vid y.svar.vid + let compare x y = String.compare x.svar.vname y.svar.vname end -module DependencyHeap = BatHeap.Make(OldFunNameWithDependencyCount) - module FundecMap = Map.Make(FundecForMap) (*A dependency maps the function it depends on to the name the function has to be changed to*) type dependencies = string StringMap.t -(*The dependents map the functions that depend with the name they need it to be changed to*) -type dependents = string StringMap.t - -(*hadWrongAssumption: set to true, if one of the depencies this node had, was wrong. Thus this node is changed.*) -type nodeData = {nowName: string; dependencies: dependencies; dependents: dependents; hadWrongAssumption: bool} - -type renameData = {nowName: string; dependencies: dependencies} +(*Renamed: newName * dependencies; Modified=now*unchangedHeader*) +type functionStatus = SameName of fundec | Renamed of fundec | Created | Deleted | Modified of fundec * bool +type outputFunctionStatus = Unchanged of global | UnchangedButRenamed of global | Added | Removed | Changed of global * bool -(*A direct match means that the function name stayed the same and the old and new function match (with contraints defined by dependencies). *) -type earlyFunctionStatus = DirectMatch of dependencies | Changed | Unknown +type output = global * outputFunctionStatus -(*Renamed: newName * dependencies*) -type functionStatus = SameName of dependencies | Renamed of renameData | ChangedOrNewOrDeleted -type results = functionStatus StringMap.t - -type output = global * functionStatus +let pretty (f: functionStatus) = + match f with + | SameName _ -> "SameName" + | Renamed x -> "Renamed to " ^ x.svar.vname + | Created -> "Added" + | Deleted -> "Removed" + | Modified _ -> "Changed" +let printFundecMap elemToString map = begin + Seq.iter (fun (f, e) -> + ignore@@Pretty.printf "%s->%s;" f.svar.vname (elemToString e); + ) (FundecMap.to_seq map) +end let getFunctionMap (ast: file) : f StringMap.t = Cil.foldGlobals ast (fun map global -> @@ -54,197 +47,143 @@ let getFunctionMap (ast: file) : f StringMap.t = let getDependencies fromEq = StringMap.map (fun assumption -> assumption.new_method_name) fromEq -(*Split the functions up in those which have not been renamed, and such which have been renamed, are new or have been deleted*) -let seperateUnchangedFunctions (oldFunctionMap: f StringMap.t) (nowFunctionMap: f StringMap.t) : earlyFunctionStatus StringMap.t = - StringMap.map (fun (f, _) -> - let matchingNewFundec = StringMap.find_opt f.svar.vname nowFunctionMap in - match matchingNewFundec with - | Some (newFun, _) -> - (*Compare if they are similar*) - let doMatch, _, _, dependencies = CompareGlobals.eqF f newFun None StringMap.empty in - if doMatch then DirectMatch(getDependencies dependencies) - else Unknown - | None -> Unknown - ) oldFunctionMap - -(* -Tries to find a partner for each method that is not a direct match. -Returns the found partner for each unknown function with the rename dependencies or ChangedOrNewOrDeleted if no partner was found. -Use sets instead of lists, because member lookups are faster in sets.*) -let categorizeUnknownFunctions - (unknownFunctions: StringSet.t) - (directMatchFunctions: StringSet.t) - (oldFunctionMap: f StringMap.t) - (nowFunctionMap: f StringMap.t) : functionStatus StringMap.t = - let nowFunctionMapWithoutDirectMatchFunctions = StringMap.filter (fun key _ -> not (StringSet.mem key directMatchFunctions)) nowFunctionMap in - - StringSet.fold (fun functionWithUnknownStatusName map -> - (*The unknown functions directly come from the oldFunctionMap, so there has to be an entry.*) - let (functionWithUnknownStatusFundec, _) = StringMap.find functionWithUnknownStatusName oldFunctionMap in - - (*Find the first match in all new unknown functions: O(all_functions - direct_functions)*) - let foundFunctionMatch = - StringMap.to_seq nowFunctionMapWithoutDirectMatchFunctions |> - Seq.map (fun (name, (f, _)) -> name, f) |> - Seq.find_map (fun (nowFunName, nowFunFundec) -> - let doMatch, _, _, dependencies = CompareGlobals.eqF functionWithUnknownStatusFundec nowFunFundec None StringMap.empty in - if doMatch then Option.some ( - {nowName = nowFunName; dependencies = getDependencies dependencies} - ) else None - ) in - - match foundFunctionMatch with - | Some renameData -> StringMap.add functionWithUnknownStatusName (Renamed(renameData)) map - | None -> StringMap.add functionWithUnknownStatusName ChangedOrNewOrDeleted map - ) unknownFunctions StringMap.empty - -(* Takes the node with the currently least dependencies and tries to reduce the graph from that node. - Cyclic dependency graphs are currently not supported. If a cyclic dependency is found, all remaining nodes are marked as changed. - - Function is applied recursivly until no nodes remain in the graph. -*) -let rec reduceNodeGraph (nodeMap: nodeData StringMap.t) (dependencyHeap: DependencyHeap.t) (currentResults: results) : results = - if DependencyHeap.size dependencyHeap = 0 then currentResults - else - let topDependencyPointer = DependencyHeap.find_min dependencyHeap in - let currentNode = StringMap.find topDependencyPointer.oldName nodeMap in - - let newDependencyHeap = DependencyHeap.del_min dependencyHeap in - - if topDependencyPointer.dependencyCount = 0 then - (*Remove this node from the dependecies of the nodes that depend on it. - The nodes that depend on the wrong name are set to be changed.*) - let (newNodeMap, updatedDependencyHeap) = currentNode.dependents |> - StringMap.to_seq |> - Seq.fold_left (fun (nodeMap, dependencyHeap) (dependingFun, dependingOnName) -> - let dependeeNodeData: nodeData = StringMap.find dependingFun nodeMap in - - (*Remove the dependency of current node from the dependencies of the dependee*) - let newDependencies = dependeeNodeData.dependencies |> - StringMap.filter (fun dependingName _ -> dependingName <> topDependencyPointer.oldName) - in - - (*TODO: Update dependencyheap by decreasing the dependency count by 1*) - - let hadWrongAssumption = if currentNode.nowName <> dependingOnName then true - else dependeeNodeData.hadWrongAssumption - in - - let newNodeData = { - nowName = dependeeNodeData.nowName; - dependencies = newDependencies; - dependents = dependeeNodeData.dependents; - hadWrongAssumption = hadWrongAssumption - } in - - (*Replace node data in map*) - let newNodeMap = StringMap.add dependingFun newNodeData nodeMap in - - newNodeMap, dependencyHeap - - ) (nodeMap, newDependencyHeap) in - - let status = if currentNode.hadWrongAssumption then ChangedOrNewOrDeleted else Renamed({nowName=currentNode.nowName; dependencies=currentNode.dependencies}) in - - let newResults = StringMap.add topDependencyPointer.oldName status currentResults in - - reduceNodeGraph newNodeMap newDependencyHeap newResults +type carryType = { + statusForOldFunction: functionStatus FundecMap.t; + statusForNowFunction: functionStatus FundecMap.t; + methodMapping: fundec FundecMap.t; + reverseMethodMapping: fundec FundecMap.t} + +let registerStatusForOldF f status data = + {statusForOldFunction = FundecMap.add f status data.statusForOldFunction; + statusForNowFunction=data.statusForNowFunction; + methodMapping=data.methodMapping; + reverseMethodMapping=data.reverseMethodMapping} + +let registerStatusForNowF f status data = + {statusForOldFunction = data.statusForOldFunction; + statusForNowFunction=FundecMap.add f status data.statusForNowFunction; + methodMapping=data.methodMapping; + reverseMethodMapping=data.reverseMethodMapping} + +let registerBiStatus (oldF: fundec) (nowF: fundec) (status: functionStatus) data = + {statusForOldFunction=FundecMap.add oldF status data.statusForOldFunction; + statusForNowFunction=FundecMap.add nowF status data.statusForNowFunction; + methodMapping=data.methodMapping; + reverseMethodMapping=data.reverseMethodMapping} + +let registerMapping oldF nowF data = + {statusForOldFunction=data.statusForOldFunction; + statusForNowFunction=data.statusForNowFunction; + methodMapping=FundecMap.add oldF nowF data.methodMapping; + reverseMethodMapping=FundecMap.add nowF oldF data.reverseMethodMapping} + +(*returns true iff for all dependencies it is true, that the dependency has a corresponding function with the new name and matches the without having dependencies itself and the new name is not already present on the old AST. *) +let doAllDependenciesMatch (dependencies: dependencies) (oldFunctionMap: f StringMap.t) (newFunctionMap: f StringMap.t) (data: carryType) : bool * carryType = + StringMap.fold (fun oldName newName (allEqual, data) -> + (*Early cutoff if a previous dependency returned false or the newName is already present in the old map*) + if allEqual && not (StringMap.mem newName oldFunctionMap) then + + let (oldFundec, _) = StringMap.find oldName oldFunctionMap in + + let knownMapping = FundecMap.find_opt oldFundec data.methodMapping in + + (*To avoid inconsitencies, if a function has already been mapped to a function, that mapping is reused again.*) + match knownMapping with + | Some(knownFundec) -> + (*This function has already been mapped*) + knownFundec.svar.vname = newName, data + | None -> + let newFundecOption = StringMap.find_opt newName newFunctionMap in + + match newFundecOption with + | Some((newFundec, _)) -> + let doMatch, _, _, dependencies = CompareGlobals.eqF oldFundec newFundec None StringMap.empty in + + if doMatch && StringMap.is_empty dependencies then + true, registerMapping oldFundec newFundec data + else false, data + + | None -> false, data + else false, data + ) dependencies (true, data) + +(*Check if f has already been assigned a status. If yes do nothing. + If not, check if the function took part in the mapping, then register it to have been renamed. Otherwise register it as the supplied status*) +let assignStatusToUnassignedFunction data f registerStatus statusMap mapping status = + if not (FundecMap.mem f statusMap) then + if (FundecMap.mem f mapping) then + registerStatus f (Renamed(FundecMap.find f mapping)) data else - (*Cyclic dependency found. *) - (*Mark all remaining nodes with dependencies as changed.*) - DependencyHeap.to_list dependencyHeap |> - List.fold_left (fun results dependencyPointer -> - StringMap.add dependencyPointer.oldName ChangedOrNewOrDeleted results - ) currentResults + (*this function has been added/removed*) + registerStatus f status data + else + data let detectRenamedFunctions (oldAST: file) (newAST: file) : output FundecMap.t = begin let oldFunctionMap = getFunctionMap oldAST in let nowFunctionMap = getFunctionMap newAST in - (*1. detect function which names have not changed*) - let statusForFunction = seperateUnchangedFunctions oldFunctionMap nowFunctionMap in - - let directMatchFunctions, knownChangedFunctions, unknownFunctions, initialCategorization = StringMap.fold ( - fun funName earlyStatus (directMatchFunctions, knownChangedFunctions, unknownFunctions, initialCategorization) -> match earlyStatus with - | DirectMatch d -> ( - StringSet.add funName directMatchFunctions, - knownChangedFunctions, - unknownFunctions, - StringMap.add funName (SameName(d)) initialCategorization - ) - | Changed -> ( - directMatchFunctions, - StringSet.add funName knownChangedFunctions, - unknownFunctions, - StringMap.add funName ChangedOrNewOrDeleted initialCategorization - ) - | Unknown -> ( - directMatchFunctions, - knownChangedFunctions, - StringSet.add funName unknownFunctions, - initialCategorization - ) - ) statusForFunction (StringSet.empty, StringSet.empty, StringSet.empty, StringMap.empty) in - - (*2. get dependencies of those functions we did match in 1. - These function statuses are just early guesses. They still need to be checked and adapted in the graph analysis.*) - let categorizationResults = categorizeUnknownFunctions unknownFunctions directMatchFunctions oldFunctionMap nowFunctionMap in - - (*3. build dependency graph*) - let categorizationMap = StringMap.union (fun _ _ _ -> None) initialCategorization categorizationResults in - - (*dependentsMap>*) - (*Generate the dependents map now, so it does not have to be done when generating the node map*) - let dependentsMap: string StringMap.t StringMap.t = StringMap.fold (fun oldFunName functionStatus dependentsMap -> - (*Go through all dependencies and add itself to the list of dependents*) - let addDependents dependencies = StringMap.fold (fun dependingOn hasToBeNamed dependentsMap -> - let currentDependents = StringMap.find_opt dependingOn dependentsMap |> - Option.value ~default:StringMap.empty in - - let newDependents = StringMap.add oldFunName hasToBeNamed currentDependents in - - StringMap.add dependingOn newDependents dependentsMap - ) dependencies dependentsMap - in - - match functionStatus with - | SameName dependencies -> addDependents dependencies - | Renamed renameData -> addDependents renameData.dependencies - | ChangedOrNewOrDeleted -> dependentsMap - ) categorizationMap StringMap.empty in - - (*The nodes are represented in the node map. The node data contains the nowName, - and the nodes it depends on as well as the nodes that depend on that node. - The dependencyHeap points to the function name with the currently least dependencies.*) - let (nodeMap: nodeData StringMap.t), (dependencyHeap: DependencyHeap.t) = - StringMap.fold (fun oldFunName functionStatus (nodeMap, dependencyHeap) -> - let dependents = StringMap.find_opt oldFunName dependentsMap |> - Option.value ~default:StringMap.empty in - - let getNodeEntry dependencies = {nowName=oldFunName; dependencies = dependencies; dependents = dependents; hadWrongAssumption = false} in - let getDependencyPointer dependencies = {oldName=oldFunName; dependencyCount=StringMap.cardinal dependencies} in - - match functionStatus with - | SameName dependencies -> - ( - StringMap.add oldFunName (getNodeEntry dependencies) nodeMap, - DependencyHeap.add (getDependencyPointer dependencies) dependencyHeap - ) - | Renamed renameData -> - ( - StringMap.add oldFunName (getNodeEntry renameData.dependencies) nodeMap, - DependencyHeap.add (getDependencyPointer renameData.dependencies) dependencyHeap - ) - | ChangedOrNewOrDeleted -> (nodeMap, dependencyHeap) - ) categorizationMap (StringMap.empty, DependencyHeap.empty) in - - - let result = reduceNodeGraph nodeMap dependencyHeap StringMap.empty in - - let x = StringMap.to_seq result |> - Seq.map (fun (oldName, status) -> - let (f, l) = StringMap.find oldName oldFunctionMap in - f, (GFun(f, l), status)) in - - FundecMap.add_seq x FundecMap.empty + let initialData: carryType = {statusForOldFunction = FundecMap.empty; + statusForNowFunction = FundecMap.empty; + methodMapping=FundecMap.empty; + reverseMethodMapping=FundecMap.empty} in + + (*Go through all functions, for all that have not been renamed *) + let finalData = + StringMap.fold (fun _ (f, _) (data: carryType) -> + let matchingNewFundec = StringMap.find_opt f.svar.vname nowFunctionMap in + match matchingNewFundec with + | Some (newFun, _) -> + (*Compare if they are similar*) + let doMatch, unchangedHeader, _, dependencies = CompareGlobals.eqF f newFun None StringMap.empty in + + let actDependencies = getDependencies dependencies in + + if doMatch then + let doDependenciesMatch, updatedData = doAllDependenciesMatch actDependencies oldFunctionMap nowFunctionMap data in + if doDependenciesMatch then + registerBiStatus f newFun (SameName(newFun)) updatedData + else + registerStatusForOldF f (Modified(newFun, unchangedHeader)) data |> + registerStatusForNowF newFun (Modified(f, unchangedHeader)) + else + registerStatusForOldF f (Modified(newFun, unchangedHeader)) data |> + registerStatusForNowF newFun (Modified(f, unchangedHeader)) + | None -> data + ) oldFunctionMap initialData |> + (*Now go through all old functions again. Those who have not been assigned a status are removed*) + StringMap.fold (fun _ (f, _) (data: carryType) -> + assignStatusToUnassignedFunction data f registerStatusForOldF data.statusForOldFunction data.methodMapping Deleted + ) oldFunctionMap |> + (*now go through all new functions. Those have have not been assigned a mapping are added.*) + StringMap.fold (fun _ (nowF, _) (data: carryType) -> + assignStatusToUnassignedFunction data nowF registerStatusForNowF data.statusForNowFunction data.reverseMethodMapping Created + ) nowFunctionMap + + in + + (*Map back to GFun and exposed function status*) + let extractOutput funMap invertedFunMap f (s: functionStatus) = + let getGFun f2 map = + let (f, l) = StringMap.find f2.svar.vname map in + GFun(f, l) + in + + let outputS = match s with + | SameName x -> Unchanged(getGFun x invertedFunMap) + | Renamed x -> UnchangedButRenamed(getGFun x invertedFunMap) + | Created -> Added + | Deleted -> Removed + | Modified (x, unchangedHeader) -> Changed(getGFun x invertedFunMap, unchangedHeader) + in + getGFun f funMap, outputS + in + + FundecMap.merge (fun _ a b -> + if Option.is_some a then a + else if Option.is_some b then b + else None + ) + (FundecMap.mapi (extractOutput oldFunctionMap nowFunctionMap) finalData.statusForOldFunction) + (FundecMap.mapi (extractOutput nowFunctionMap oldFunctionMap) finalData.statusForNowFunction) end diff --git a/src/incremental/updateCil.ml b/src/incremental/updateCil.ml index 90bca36304..aa2df5447a 100644 --- a/src/incremental/updateCil.ml +++ b/src/incremental/updateCil.ml @@ -1,5 +1,4 @@ open Cil -open CompareCIL open MaxIdUtil open MyCFG open CompareGlobals diff --git a/tests/incremental/05-method-rename/00-simple_rename.json b/tests/incremental/05-method-rename/00-simple_rename.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/00-simple_rename.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/00-simple_rename.patch b/tests/incremental/05-method-rename/00-simple_rename.patch index 407a5a9bbf..ed7b40014c 100644 --- a/tests/incremental/05-method-rename/00-simple_rename.patch +++ b/tests/incremental/05-method-rename/00-simple_rename.patch @@ -1,5 +1,5 @@ ---- tests/incremental/05-method_rename/00-simple_rename.c -+++ tests/incremental/05-method_rename/00-simple_rename.c +--- tests/incremental/05-method-rename/00-simple_rename.c ++++ tests/incremental/05-method-rename/00-simple_rename.c @@ -1,10 +1,10 @@ #include diff --git a/tests/incremental/05-method-rename/01-dependent_rename.json b/tests/incremental/05-method-rename/01-dependent_rename.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/01-dependent_rename.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/01-dependent_rename.patch b/tests/incremental/05-method-rename/01-dependent_rename.patch index 5eedfd814b..f3a4a9a3f8 100644 --- a/tests/incremental/05-method-rename/01-dependent_rename.patch +++ b/tests/incremental/05-method-rename/01-dependent_rename.patch @@ -1,5 +1,5 @@ ---- tests/incremental/05-method_rename/01-dependent_rename.c -+++ tests/incremental/05-method_rename/01-dependent_rename.c +--- tests/incremental/05-method-rename/01-dependent_rename.c ++++ tests/incremental/05-method-rename/01-dependent_rename.c @@ -1,14 +1,14 @@ #include From 1855a5a16dd3138d2a5cc592e0124db758476811 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 25 May 2022 18:38:07 +0200 Subject: [PATCH 029/518] Added more docu --- src/incremental/detectRenamedFunctions.ml | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 99bc4a6f68..30cb5fb35b 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -10,6 +10,7 @@ type f = fundec * location module FundecForMap = struct type t = Cil.fundec + (*x.svar.uid cannot be used, as they may overlap between old and now AST*) let compare x y = String.compare x.svar.vname y.svar.vname end @@ -47,12 +48,20 @@ let getFunctionMap (ast: file) : f StringMap.t = let getDependencies fromEq = StringMap.map (fun assumption -> assumption.new_method_name) fromEq +(*Data type that holds the important data while checking for renames. + statusForOldFunction: Status we have already figured out for a fundec from oldAST; + statusForNowFunction: see statusForOldFunction; + methodMapping: Mappings from (fundec of old AST) -> (fundec of now AST) we have already figured out to hold. + reverseMethodMapping: see method mapping, but from now -> old + *) type carryType = { statusForOldFunction: functionStatus FundecMap.t; statusForNowFunction: functionStatus FundecMap.t; methodMapping: fundec FundecMap.t; reverseMethodMapping: fundec FundecMap.t} +(*Carry type manipulation functions.*) + let registerStatusForOldF f status data = {statusForOldFunction = FundecMap.add f status data.statusForOldFunction; statusForNowFunction=data.statusForNowFunction; @@ -108,7 +117,7 @@ let doAllDependenciesMatch (dependencies: dependencies) (oldFunctionMap: f Strin ) dependencies (true, data) (*Check if f has already been assigned a status. If yes do nothing. - If not, check if the function took part in the mapping, then register it to have been renamed. Otherwise register it as the supplied status*) + If not, check if the function took part in the mapping, then register it to have been renamed. Otherwise register it as the supplied status.*) let assignStatusToUnassignedFunction data f registerStatus statusMap mapping status = if not (FundecMap.mem f statusMap) then if (FundecMap.mem f mapping) then @@ -151,6 +160,8 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output FundecMap.t = registerStatusForNowF newFun (Modified(f, unchangedHeader)) | None -> data ) oldFunctionMap initialData |> + (*At this point we already know of the functions that have changed and stayed the same. We now assign the correct status to all the functions that + have been mapped. The functions that have not been mapped are added/removed.*) (*Now go through all old functions again. Those who have not been assigned a status are removed*) StringMap.fold (fun _ (f, _) (data: carryType) -> assignStatusToUnassignedFunction data f registerStatusForOldF data.statusForOldFunction data.methodMapping Deleted @@ -162,6 +173,8 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output FundecMap.t = in + (*Done with the analyis, the following just adjusts the output types.*) + (*Map back to GFun and exposed function status*) let extractOutput funMap invertedFunMap f (s: functionStatus) = let getGFun f2 map = @@ -179,6 +192,7 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output FundecMap.t = getGFun f funMap, outputS in + (*Merge together old and now functions*) FundecMap.merge (fun _ a b -> if Option.is_some a then a else if Option.is_some b then b From c71e29ceeea41b8dc45312c4042f1a58c48043e2 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 25 May 2022 18:47:41 +0200 Subject: [PATCH 030/518] Added more test cases for method rename --- .../05-method-rename/06-common_rename.c | 20 ++++++++++++ .../05-method-rename/06-common_rename.json | 3 ++ .../05-method-rename/06-common_rename.patch | 27 ++++++++++++++++ .../07-common_rename_refactored.c | 20 ++++++++++++ .../07-common_rename_refactored.json | 3 ++ .../07-common_rename_refactored.patch | 31 +++++++++++++++++++ .../05-method-rename/diffs/06-common_rename.c | 20 ++++++++++++ .../diffs/07-common_rename_refactored.c | 24 ++++++++++++++ 8 files changed, 148 insertions(+) create mode 100644 tests/incremental/05-method-rename/06-common_rename.c create mode 100644 tests/incremental/05-method-rename/06-common_rename.json create mode 100644 tests/incremental/05-method-rename/06-common_rename.patch create mode 100644 tests/incremental/05-method-rename/07-common_rename_refactored.c create mode 100644 tests/incremental/05-method-rename/07-common_rename_refactored.json create mode 100644 tests/incremental/05-method-rename/07-common_rename_refactored.patch create mode 100644 tests/incremental/05-method-rename/diffs/06-common_rename.c create mode 100644 tests/incremental/05-method-rename/diffs/07-common_rename_refactored.c diff --git a/tests/incremental/05-method-rename/06-common_rename.c b/tests/incremental/05-method-rename/06-common_rename.c new file mode 100644 index 0000000000..ce72a6dda1 --- /dev/null +++ b/tests/incremental/05-method-rename/06-common_rename.c @@ -0,0 +1,20 @@ +#include + +void foo() { + printf("foo"); +} + +void fun1() { + foo(); +} + +void fun2() { + foo(); +} + +int main() { + fun1(); + fun2(); + foo(); + return 0; +} diff --git a/tests/incremental/05-method-rename/06-common_rename.json b/tests/incremental/05-method-rename/06-common_rename.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/06-common_rename.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/06-common_rename.patch b/tests/incremental/05-method-rename/06-common_rename.patch new file mode 100644 index 0000000000..15afbce9ce --- /dev/null +++ b/tests/incremental/05-method-rename/06-common_rename.patch @@ -0,0 +1,27 @@ +--- tests/incremental/05-method-rename/06-common_rename.c ++++ tests/incremental/05-method-rename/06-common_rename.c +@@ -1,20 +1,20 @@ + #include + +-void foo() { ++void bar() { + printf("foo"); + } + + void fun1() { +- foo(); ++ bar(); + } + + void fun2() { +- foo(); ++ bar(); + } + + int main() { + fun1(); + fun2(); +- foo(); ++ bar(); + return 0; + } diff --git a/tests/incremental/05-method-rename/07-common_rename_refactored.c b/tests/incremental/05-method-rename/07-common_rename_refactored.c new file mode 100644 index 0000000000..ce72a6dda1 --- /dev/null +++ b/tests/incremental/05-method-rename/07-common_rename_refactored.c @@ -0,0 +1,20 @@ +#include + +void foo() { + printf("foo"); +} + +void fun1() { + foo(); +} + +void fun2() { + foo(); +} + +int main() { + fun1(); + fun2(); + foo(); + return 0; +} diff --git a/tests/incremental/05-method-rename/07-common_rename_refactored.json b/tests/incremental/05-method-rename/07-common_rename_refactored.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/07-common_rename_refactored.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/07-common_rename_refactored.patch b/tests/incremental/05-method-rename/07-common_rename_refactored.patch new file mode 100644 index 0000000000..4c3d9fa1d6 --- /dev/null +++ b/tests/incremental/05-method-rename/07-common_rename_refactored.patch @@ -0,0 +1,31 @@ +--- tests/incremental/05-method-rename/07-common_rename_refactored.c ++++ tests/incremental/05-method-rename/07-common_rename_refactored.c +@@ -1,20 +1,24 @@ + #include + +-void foo() { ++void bar() { + printf("foo"); + } + ++void baz() { ++ printf("baz"); ++} ++ + void fun1() { +- foo(); ++ bar(); + } + + void fun2() { +- foo(); ++ bar(); + } + + int main() { + fun1(); + fun2(); +- foo(); ++ baz(); + return 0; + } diff --git a/tests/incremental/05-method-rename/diffs/06-common_rename.c b/tests/incremental/05-method-rename/diffs/06-common_rename.c new file mode 100644 index 0000000000..6a96b84747 --- /dev/null +++ b/tests/incremental/05-method-rename/diffs/06-common_rename.c @@ -0,0 +1,20 @@ +#include + +void bar() { + printf("foo"); +} + +void fun1() { + bar(); +} + +void fun2() { + bar(); +} + +int main() { + fun1(); + fun2(); + bar(); + return 0; +} diff --git a/tests/incremental/05-method-rename/diffs/07-common_rename_refactored.c b/tests/incremental/05-method-rename/diffs/07-common_rename_refactored.c new file mode 100644 index 0000000000..170cdfb6de --- /dev/null +++ b/tests/incremental/05-method-rename/diffs/07-common_rename_refactored.c @@ -0,0 +1,24 @@ +#include + +void bar() { + printf("foo"); +} + +void baz() { + printf("baz"); +} + +void fun1() { + bar(); +} + +void fun2() { + bar(); +} + +int main() { + fun1(); + fun2(); + baz(); + return 0; +} From 874519c74ff26839364088b44f88b8823643fd71 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 6 Jun 2022 12:52:15 +0200 Subject: [PATCH 031/518] Added json and patch files for method rename tests. --- .../05-method-rename/02-rename_and_swap.json | 3 +++ .../05-method-rename/02-rename_and_swap.patch | 25 +++++++++++++++++ .../03-cyclic_rename_dependency.json | 3 +++ .../03-cyclic_rename_dependency.patch | 25 +++++++++++++++++ .../05-method-rename/04-cyclic_with_swap.json | 3 +++ .../04-cyclic_with_swap.patch | 27 +++++++++++++++++++ 6 files changed, 86 insertions(+) create mode 100644 tests/incremental/05-method-rename/02-rename_and_swap.json create mode 100644 tests/incremental/05-method-rename/02-rename_and_swap.patch create mode 100644 tests/incremental/05-method-rename/03-cyclic_rename_dependency.json create mode 100644 tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch create mode 100644 tests/incremental/05-method-rename/04-cyclic_with_swap.json create mode 100644 tests/incremental/05-method-rename/04-cyclic_with_swap.patch diff --git a/tests/incremental/05-method-rename/02-rename_and_swap.json b/tests/incremental/05-method-rename/02-rename_and_swap.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/02-rename_and_swap.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/02-rename_and_swap.patch b/tests/incremental/05-method-rename/02-rename_and_swap.patch new file mode 100644 index 0000000000..ab39c2dc4b --- /dev/null +++ b/tests/incremental/05-method-rename/02-rename_and_swap.patch @@ -0,0 +1,25 @@ +--- tests/incremental/05-method-rename/02-rename_and_swap.c ++++ tests/incremental/05-method-rename/02-rename_and_swap.c +@@ -1,15 +1,19 @@ + #include + +-void foo1() { ++void newFun() { ++ printf("newFun"); ++} ++ ++void bar1() { + printf("foo1"); + } + + void foo2() { +- foo1(); ++ bar1(); + } + + void foo3() { +- foo1(); ++ newFun(); + } + + int main() { diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.json b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch new file mode 100644 index 0000000000..ae32544efd --- /dev/null +++ b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch @@ -0,0 +1,25 @@ +--- tests/incremental/05-method-rename/03-cyclic_rename_dependency.c ++++ tests/incremental/05-method-rename/03-cyclic_rename_dependency.c +@@ -2,16 +2,16 @@ + + //Unchanged. + +-void foo1(int c) { +- if (c < 10) foo2(c + 1); ++void bar1(int c) { ++ if (c < 10) bar2(c + 1); + } + +-void foo2(int c) { +- if (c < 10) foo1(c + 1); ++void bar2(int c) { ++ if (c < 10) bar1(c + 1); + } + + int main() { +- foo1(0); +- foo2(0); ++ bar1(0); ++ bar2(0); + return 0; + } diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.json b/tests/incremental/05-method-rename/04-cyclic_with_swap.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/04-cyclic_with_swap.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.patch b/tests/incremental/05-method-rename/04-cyclic_with_swap.patch new file mode 100644 index 0000000000..7e96afd8e0 --- /dev/null +++ b/tests/incremental/05-method-rename/04-cyclic_with_swap.patch @@ -0,0 +1,27 @@ +--- tests/incremental/05-method-rename/04-cyclic_with_swap.c ++++ tests/incremental/05-method-rename/04-cyclic_with_swap.c +@@ -2,15 +2,19 @@ + + //Changed. + +-void foo1(int c) { +- if (c < 10) foo2(c + 1); ++void newFun(int c) { ++ printf("newfun"); + } + +-void foo2(int c) { +- if (c < 10) foo1(c + 1); ++void bar1(int c) { ++ if (c < 10) bar2(c + 1); ++} ++ ++void bar2(int c) { ++ if (c < 10) newFun(c + 1); + } + + int main() { +- foo1(0); ++ bar1(0); + return 0; + } From b75a19f63bf1a604895886b2cc698835accbe0f3 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 6 Jun 2022 15:19:47 +0200 Subject: [PATCH 032/518] Global var renames are now also detected in compareAST --- src/incremental/compareAST.ml | 70 +++++++++++++++---- src/incremental/compareCFG.ml | 4 +- src/incremental/compareCIL.ml | 6 +- src/incremental/compareGlobals.ml | 18 ++--- src/incremental/detectRenamedFunctions.ml | 17 +++-- .../06-glob-var-rename/00-simple_rename.c | 9 +++ .../06-glob-var-rename/00-simple_rename.json | 3 + .../06-glob-var-rename/00-simple_rename.patch | 14 ++++ .../01-duplicate_local_global.c | 14 ++++ .../01-duplicate_local_global.json | 3 + .../01-duplicate_local_global.patch | 21 ++++++ .../diffs/00-simple_rename.c | 9 +++ .../diffs/01-duplicate_local_global.c | 14 ++++ 13 files changed, 166 insertions(+), 36 deletions(-) create mode 100644 tests/incremental/06-glob-var-rename/00-simple_rename.c create mode 100644 tests/incremental/06-glob-var-rename/00-simple_rename.json create mode 100644 tests/incremental/06-glob-var-rename/00-simple_rename.patch create mode 100644 tests/incremental/06-glob-var-rename/01-duplicate_local_global.c create mode 100644 tests/incremental/06-glob-var-rename/01-duplicate_local_global.json create mode 100644 tests/incremental/06-glob-var-rename/01-duplicate_local_global.patch create mode 100644 tests/incremental/06-glob-var-rename/diffs/00-simple_rename.c create mode 100644 tests/incremental/06-glob-var-rename/diffs/01-duplicate_local_global.c diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 4834796d2b..4176c85bf5 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -7,17 +7,30 @@ and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] module StringMap = Map.Make(String) +module VarinfoOrdered = struct + type t = varinfo + + (*x.svar.uid cannot be used, as they may overlap between old and now AST*) + let compare (x: varinfo) (y: varinfo) = String.compare x.vname y.vname +end + + +module VarinfoMap = Map.Make(VarinfoOrdered) + type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: string StringMap.t} type method_rename_assumptions = method_rename_assumption StringMap.t +type glob_var_rename_assumptions = string VarinfoMap.t (*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type rename_mapping = (string StringMap.t) * (method_rename_assumptions) +type rename_mapping = (string StringMap.t) * (method_rename_assumptions) * glob_var_rename_assumptions + +let emptyRenameMapping = (StringMap.empty, StringMap.empty, VarinfoMap.empty) (*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) 2. there is no rename for name1 -> name1 = name2*) let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = - let (local_c, method_c) = rename_mapping in + let (local_c, method_c, _) = rename_mapping in let existingAssumption: string option = StringMap.find_opt name1 local_c in match existingAssumption with @@ -44,14 +57,18 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> String.concat ", ") ^ "]" let rename_mapping_to_string (rename_mapping: rename_mapping) = - let (local, methods) = rename_mapping in + let (local, methods, glob_vars) = rename_mapping in let local_string = string_tuple_to_string (List.of_seq (StringMap.to_seq local)) in let methods_string: string = List.of_seq (StringMap.to_seq methods |> Seq.map snd) |> List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ "; renamed_params=" ^ string_tuple_to_string (List.of_seq (StringMap.to_seq parameter_renames)) ^ ")") |> String.concat ", " in - "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "])" + + let global_var_string: string = string_tuple_to_string (List.of_seq (VarinfoMap.to_seq glob_vars) |> + List.map (fun (v, nowName) -> v.vname, nowName)) in + + "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "]; glob_vars=" ^ global_var_string ^ ")" let identifier_of_global glob = match glob with @@ -215,16 +232,30 @@ and eq_varinfo2 (rename_mapping: rename_mapping) (a: varinfo) (b: varinfo) = eq_ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool * rename_mapping = (*Printf.printf "Comp %s with %s\n" a.vname b.vname;*) - let (locals_renames, method_rename_mappings) = rename_mapping in + let (locals_renames, method_rename_mappings, glob_vars) = rename_mapping in + + let compare_local_and_global_var = fun old_varinfo now_varinfo -> + let is_local = StringMap.mem old_varinfo.vname locals_renames in + if not is_local then + let present_mapping = VarinfoMap.find_opt old_varinfo glob_vars in + + match present_mapping with + | Some (knownNowName) -> now_varinfo.vname = knownNowName, method_rename_mappings, glob_vars + | None -> ( + let update_glob_vars = VarinfoMap.add old_varinfo now_varinfo.vname glob_vars in + true, method_rename_mappings, update_glob_vars + ) + else rename_mapping_aware_name_comparison old_varinfo.vname now_varinfo.vname rename_mapping, method_rename_mappings, glob_vars + in (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) - let isNamingOk, updated_method_rename_mappings = match a.vtype, b.vtype with + let isNamingOk, updated_method_rename_mappings, updatedGlobVarMapping = match a.vtype, b.vtype with | TFun(_, aParamSpec, _, _), TFun(_, bParamSpec, _, _) -> ( let specific_method_rename_mapping = StringMap.find_opt a.vname method_rename_mappings in match specific_method_rename_mapping with | Some method_rename_mapping -> let is_naming_ok = method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname in - is_naming_ok, method_rename_mappings + is_naming_ok, method_rename_mappings, glob_vars | None -> if a.vname <> b.vname then (*Function that extracts the names from the param spec of the TFun*) @@ -240,10 +271,13 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool let assumption = {original_method_name = a.vname; new_method_name = b.vname; parameter_renames = create_locals_rename_mapping aParamNames bParamNames} in - true, StringMap.add a.vname assumption method_rename_mappings - else true, method_rename_mappings + true, StringMap.add a.vname assumption method_rename_mappings, glob_vars + else true, method_rename_mappings, glob_vars ) - | _, _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping, method_rename_mappings + | TInt (_, _), TInt (_, _) -> compare_local_and_global_var a b + | TFloat (_, _), TFloat (_, _) -> compare_local_and_global_var a b + | TPtr (_, _), TPtr(_, _) -> compare_local_and_global_var a b + | _, _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping, method_rename_mappings, glob_vars in (*If the following is a method call, we need to check if we have a mapping for that method call. *) @@ -253,17 +287,23 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool match new_locals with | Some locals -> - (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) - (locals.parameter_renames, updated_method_rename_mappings) - | None -> (StringMap.empty, updated_method_rename_mappings) + (locals.parameter_renames, updated_method_rename_mappings, updatedGlobVarMapping) + | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) ) - | _ -> (locals_renames, updated_method_rename_mappings) + (*| GVar (_, _, _) -> ( + let new_local = VarinfoMap.find_opt a glob_vars in + + match new_local with + | Some now_name -> (StringMap.add a.vname now_name StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) + | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) + )*) + | _ -> (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping) in (*Ignore rename mapping for type check, as it doesn't change anyway*) let (typeCheck, _) = eq_typ a.vtype b.vtype typ_rename_mapping in - (typeCheck, (locals_renames, updated_method_rename_mappings)) &&>> + (typeCheck, (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping)) &&>> forward_list_equal eq_attribute a.vattr b.vattr &&> (a.vstorage = b.vstorage) &&> (a.vglob = b.vglob) &&> (a.vaddrof = b.vaddrof) (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 4f2c37223f..62ea88e875 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -12,7 +12,7 @@ let (&&<>) (prev_result: bool * rename_mapping) f : bool * rename_mapping = else false, prev_rm let eq_node (x, fun1) (y, fun2) : bool = - let empty_rename_mapping: rename_mapping = (StringMap.empty, StringMap.empty) in + let empty_rename_mapping: rename_mapping = emptyRenameMapping in match x,y with | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping |> fst | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping |> fst @@ -21,7 +21,7 @@ let eq_node (x, fun1) (y, fun2) : bool = (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) let eq_edge x y = - let empty_rename_mapping: rename_mapping = (StringMap.empty, StringMap.empty) in + let empty_rename_mapping: rename_mapping = emptyRenameMapping in let (r, _) = match x, y with | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping &&<> eq_exp rv1 rv2 | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping &&<> forward_list_equal eq_exp ars1 ars2 diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 13e1f42069..816ff623be 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -9,11 +9,11 @@ let empty_change_info () : change_info = {added = []; removed = []; changed = [] let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt, _ = CompareGlobals.eqF f g cfgs StringMap.empty in + let identical, unchangedHeader, diffOpt, _, _ = CompareGlobals.eqF f g cfgs StringMap.empty VarinfoMap.empty in identical, unchangedHeader, diffOpt - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty) |> fst, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (StringMap.empty, StringMap.empty) |> fst, false, None + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y emptyRenameMapping |> fst, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y emptyRenameMapping |> fst, false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml index e0cde8735a..c491372314 100644 --- a/src/incremental/compareGlobals.ml +++ b/src/incremental/compareGlobals.ml @@ -34,7 +34,7 @@ let should_reanalyze (fdec: Cil.fundec) = (* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) - let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_rename_mapping: method_rename_assumptions) = + let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_function_rename_mapping: method_rename_assumptions) (global_var_rename_mapping: glob_var_rename_assumptions) = let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in if (List.length a.slocals) = (List.length b.slocals) then @@ -56,20 +56,20 @@ let should_reanalyze (fdec: Cil.fundec) = in let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in - let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in + let actHeaderRenameMapping = (headerRenameMapping, global_function_rename_mapping, global_var_rename_mapping) in let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> forward_list_equal eq_varinfo a.sformals b.sformals in - let identical, diffOpt, (_, renamed_method_dependencies) = + let identical, diffOpt, (_, renamed_method_dependencies, renamed_global_vars_dependencies) = if should_reanalyze a then - false, None, (StringMap.empty, StringMap.empty) + false, None, emptyRenameMapping else (* Here the local variables are checked to be equal *) let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in - let rename_mapping: rename_mapping = (local_rename, global_rename_mapping) in + let rename_mapping: rename_mapping = (local_rename, global_function_rename_mapping, global_var_rename_mapping) in let sameDef = unchangedHeader &&> sizeEqual |> fst in if not sameDef then - (false, None, (StringMap.empty, StringMap.empty)) + (false, None, emptyRenameMapping) else match cfgs with | None -> @@ -79,7 +79,7 @@ let should_reanalyze (fdec: Cil.fundec) = let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in let matches, diffNodes1 = compareFun (module CfgOld) (module CfgNew) a b in - if diffNodes1 = [] then (true, None, (StringMap.empty, StringMap.empty)) - else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, (StringMap.empty, StringMap.empty)) + if diffNodes1 = [] then (true, None, emptyRenameMapping) + else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, emptyRenameMapping) in - identical, unchangedHeader |> fst, diffOpt, renamed_method_dependencies + identical, unchangedHeader |> fst, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 30cb5fb35b..ba6be0dcf1 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -17,7 +17,7 @@ end module FundecMap = Map.Make(FundecForMap) (*A dependency maps the function it depends on to the name the function has to be changed to*) -type dependencies = string StringMap.t +type functionDependencies = string StringMap.t (*Renamed: newName * dependencies; Modified=now*unchangedHeader*) type functionStatus = SameName of fundec | Renamed of fundec | Created | Deleted | Modified of fundec * bool @@ -87,7 +87,7 @@ let registerMapping oldF nowF data = reverseMethodMapping=FundecMap.add nowF oldF data.reverseMethodMapping} (*returns true iff for all dependencies it is true, that the dependency has a corresponding function with the new name and matches the without having dependencies itself and the new name is not already present on the old AST. *) -let doAllDependenciesMatch (dependencies: dependencies) (oldFunctionMap: f StringMap.t) (newFunctionMap: f StringMap.t) (data: carryType) : bool * carryType = +let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_dependencies: glob_var_rename_assumptions) (oldFunctionMap: f StringMap.t) (newFunctionMap: f StringMap.t) (data: carryType) : bool * carryType = StringMap.fold (fun oldName newName (allEqual, data) -> (*Early cutoff if a previous dependency returned false or the newName is already present in the old map*) if allEqual && not (StringMap.mem newName oldFunctionMap) then @@ -106,9 +106,9 @@ let doAllDependenciesMatch (dependencies: dependencies) (oldFunctionMap: f Strin match newFundecOption with | Some((newFundec, _)) -> - let doMatch, _, _, dependencies = CompareGlobals.eqF oldFundec newFundec None StringMap.empty in + let doMatch, _, _, function_dependencies, global_var_dependencies = CompareGlobals.eqF oldFundec newFundec None StringMap.empty VarinfoMap.empty in - if doMatch && StringMap.is_empty dependencies then + if doMatch && StringMap.is_empty function_dependencies && VarinfoMap.is_empty global_var_dependencies then true, registerMapping oldFundec newFundec data else false, data @@ -144,12 +144,15 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output FundecMap.t = match matchingNewFundec with | Some (newFun, _) -> (*Compare if they are similar*) - let doMatch, unchangedHeader, _, dependencies = CompareGlobals.eqF f newFun None StringMap.empty in + let doMatch, unchangedHeader, _, function_dependencies, global_var_dependencies = + CompareGlobals.eqF f newFun None StringMap.empty VarinfoMap.empty in - let actDependencies = getDependencies dependencies in + let _ = Pretty.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in + + let actDependencies = getDependencies function_dependencies in if doMatch then - let doDependenciesMatch, updatedData = doAllDependenciesMatch actDependencies oldFunctionMap nowFunctionMap data in + let doDependenciesMatch, updatedData = doAllDependenciesMatch actDependencies global_var_dependencies oldFunctionMap nowFunctionMap data in if doDependenciesMatch then registerBiStatus f newFun (SameName(newFun)) updatedData else diff --git a/tests/incremental/06-glob-var-rename/00-simple_rename.c b/tests/incremental/06-glob-var-rename/00-simple_rename.c new file mode 100644 index 0000000000..56650e98ed --- /dev/null +++ b/tests/incremental/06-glob-var-rename/00-simple_rename.c @@ -0,0 +1,9 @@ +#include + +int foo = 1; + +int main() { + printf("%d", foo); + + return 0; +} diff --git a/tests/incremental/06-glob-var-rename/00-simple_rename.json b/tests/incremental/06-glob-var-rename/00-simple_rename.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/00-simple_rename.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/06-glob-var-rename/00-simple_rename.patch b/tests/incremental/06-glob-var-rename/00-simple_rename.patch new file mode 100644 index 0000000000..1e0f3b2565 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/00-simple_rename.patch @@ -0,0 +1,14 @@ +--- tests/incremental/06-glob-var-rename/00-simple_rename.c ++++ tests/incremental/06-glob-var-rename/00-simple_rename.c +@@ -1,9 +1,9 @@ + #include + +-int foo = 1; ++int bar = 1; + + int main() { +- printf("%d", foo); ++ printf("%d", bar); + + return 0; + } diff --git a/tests/incremental/06-glob-var-rename/01-duplicate_local_global.c b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.c new file mode 100644 index 0000000000..9ad715e50d --- /dev/null +++ b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.c @@ -0,0 +1,14 @@ +#include + +int foo = 1; + +int main() { + + printf("%d", foo); + + int foo = 2; + + printf("%d", foo); + + return 0; +} diff --git a/tests/incremental/06-glob-var-rename/01-duplicate_local_global.json b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/06-glob-var-rename/01-duplicate_local_global.patch b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.patch new file mode 100644 index 0000000000..1d65c5672a --- /dev/null +++ b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.patch @@ -0,0 +1,21 @@ +--- tests/incremental/06-glob-var-rename/01-duplicate_local_global.c ++++ tests/incremental/06-glob-var-rename/01-duplicate_local_global.c +@@ -1,14 +1,14 @@ + #include + +-int foo = 1; ++int bar = 1; + + int main() { + +- printf("%d", foo); ++ printf("%d", bar); + +- int foo = 2; ++ int bar = 2; + +- printf("%d", foo); ++ printf("%d", bar); + + return 0; + } diff --git a/tests/incremental/06-glob-var-rename/diffs/00-simple_rename.c b/tests/incremental/06-glob-var-rename/diffs/00-simple_rename.c new file mode 100644 index 0000000000..bfe71f0522 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/diffs/00-simple_rename.c @@ -0,0 +1,9 @@ +#include + +int bar = 1; + +int main() { + printf("%d", bar); + + return 0; +} diff --git a/tests/incremental/06-glob-var-rename/diffs/01-duplicate_local_global.c b/tests/incremental/06-glob-var-rename/diffs/01-duplicate_local_global.c new file mode 100644 index 0000000000..0e4ebf3fd7 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/diffs/01-duplicate_local_global.c @@ -0,0 +1,14 @@ +#include + +int bar = 1; + +int main() { + + printf("%d", bar); + + int bar = 2; + + printf("%d", bar); + + return 0; +} From 9e80fc1971b8d2d9895f2de3c46113b5da1badaa Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 7 Jun 2022 14:43:15 +0200 Subject: [PATCH 033/518] Cleaned up and improved detectRenamedFunctions. --- src/incremental/compareAST.ml | 27 +- src/incremental/compareCIL.ml | 11 +- src/incremental/compareGlobals.ml | 20 +- src/incremental/detectRenamedFunctions.ml | 290 ++++++++++++------ .../06-glob-var-rename/02-add_new_gvar.c | 8 + .../06-glob-var-rename/02-add_new_gvar.json | 3 + .../06-glob-var-rename/02-add_new_gvar.patch | 13 + .../diffs/02-add_new_gvar.c | 9 + 8 files changed, 259 insertions(+), 122 deletions(-) create mode 100644 tests/incremental/06-glob-var-rename/02-add_new_gvar.c create mode 100644 tests/incremental/06-glob-var-rename/02-add_new_gvar.json create mode 100644 tests/incremental/06-glob-var-rename/02-add_new_gvar.patch create mode 100644 tests/incremental/06-glob-var-rename/diffs/02-add_new_gvar.c diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 4176c85bf5..598bc03418 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -66,7 +66,7 @@ let rename_mapping_to_string (rename_mapping: rename_mapping) = String.concat ", " in let global_var_string: string = string_tuple_to_string (List.of_seq (VarinfoMap.to_seq glob_vars) |> - List.map (fun (v, nowName) -> v.vname, nowName)) in + List.map (fun (v, nowName) -> v.vname, nowName)) in "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "]; glob_vars=" ^ global_var_string ^ ")" @@ -234,18 +234,19 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool let (locals_renames, method_rename_mappings, glob_vars) = rename_mapping in - let compare_local_and_global_var = fun old_varinfo now_varinfo -> - let is_local = StringMap.mem old_varinfo.vname locals_renames in + let compare_local_and_global_var = + let is_local = StringMap.mem a.vname locals_renames in if not is_local then - let present_mapping = VarinfoMap.find_opt old_varinfo glob_vars in + let present_mapping = VarinfoMap.find_opt a glob_vars in match present_mapping with - | Some (knownNowName) -> now_varinfo.vname = knownNowName, method_rename_mappings, glob_vars - | None -> ( - let update_glob_vars = VarinfoMap.add old_varinfo now_varinfo.vname glob_vars in + | Some (knownNowName) -> + b.vname = knownNowName, method_rename_mappings, glob_vars + | None -> ( + let update_glob_vars = VarinfoMap.add a b.vname glob_vars in true, method_rename_mappings, update_glob_vars ) - else rename_mapping_aware_name_comparison old_varinfo.vname now_varinfo.vname rename_mapping, method_rename_mappings, glob_vars + else rename_mapping_aware_name_comparison a.vname b.vname rename_mapping, method_rename_mappings, glob_vars in (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) @@ -274,9 +275,9 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool true, StringMap.add a.vname assumption method_rename_mappings, glob_vars else true, method_rename_mappings, glob_vars ) - | TInt (_, _), TInt (_, _) -> compare_local_and_global_var a b - | TFloat (_, _), TFloat (_, _) -> compare_local_and_global_var a b - | TPtr (_, _), TPtr(_, _) -> compare_local_and_global_var a b + | TInt (_, _), TInt (_, _) -> compare_local_and_global_var + | TFloat (_, _), TFloat (_, _) -> compare_local_and_global_var + | TPtr (_, _), TPtr(_, _) -> compare_local_and_global_var | _, _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping, method_rename_mappings, glob_vars in @@ -296,14 +297,14 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool match new_local with | Some now_name -> (StringMap.add a.vname now_name StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) - )*) + )*) | _ -> (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping) in (*Ignore rename mapping for type check, as it doesn't change anyway*) let (typeCheck, _) = eq_typ a.vtype b.vtype typ_rename_mapping in - (typeCheck, (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping)) &&>> + (isNamingOk && typeCheck, (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping)) &&>> forward_list_equal eq_attribute a.vattr b.vattr &&> (a.vstorage = b.vstorage) &&> (a.vglob = b.vglob) &&> (a.vaddrof = b.vaddrof) (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 816ff623be..0deca77de2 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -38,7 +38,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let findChanges map global = try let isGFun = match global with - | GFun _-> false (* set to true later to disable finding changes for funs*) + | GFun _-> true (* set to true later to disable finding changes for funs*) | _ -> false in @@ -57,10 +57,10 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let renameDetectionResults = detectRenamedFunctions oldAST newAST in - FundecMap.to_seq renameDetectionResults |> + GlobalElemMap.to_seq renameDetectionResults |> Seq.iter - (fun (fundec, (functionGlobal, status)) -> - Printf.printf "Function status of %s is=" fundec.svar.vname; + (fun (gT, (functionGlobal, status)) -> + Printf.printf "Function status of %s is=" (globalElemName gT); match status with | Unchanged _ -> Printf.printf "Same Name\n"; | Added -> Printf.printf "Added\n"; @@ -69,6 +69,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = | UnchangedButRenamed toFrom -> match toFrom with | GFun (f, _) -> Printf.printf "Renamed to %s\n" f.svar.vname; + | GVar(v, _, _) -> Printf.printf "Renamed to %s\n" v.vname; | _ -> Printf.printf "TODO"; ); @@ -77,7 +78,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = Cil.iterGlobals newAST (fun glob -> findChanges oldMap glob); - let unchanged, changed, added, removed = FundecMap.fold (fun _ (global, status) (u, c, a, r) -> + let unchanged, changed, added, removed = GlobalElemMap.fold (fun _ (global, status) (u, c, a, r) -> match status with | Unchanged now -> (u @ [{old=global; current=now}], c, a, r) | UnchangedButRenamed now -> (u @ [{old=global; current=now}], c, a, r) diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml index c491372314..76a98bd58e 100644 --- a/src/incremental/compareGlobals.ml +++ b/src/incremental/compareGlobals.ml @@ -34,26 +34,26 @@ let should_reanalyze (fdec: Cil.fundec) = (* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) - let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_function_rename_mapping: method_rename_assumptions) (global_var_rename_mapping: glob_var_rename_assumptions) = +let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_function_rename_mapping: method_rename_assumptions) (global_var_rename_mapping: glob_var_rename_assumptions) = let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in if (List.length a.slocals) = (List.length b.slocals) then List.combine a.slocals b.slocals |> - List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> - List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); + List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> + List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a rename_mapping, holding the rename assumptions *) let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: string StringMap.t) = match alocals, blocals with - | [], [] -> true, rename_mapping - | origLocal :: als, nowLocal :: bls -> - let new_mapping = if origLocal.vname <> nowLocal.vname then StringMap.add origLocal.vname nowLocal.vname rename_mapping else rename_mapping in + | [], [] -> true, rename_mapping + | origLocal :: als, nowLocal :: bls -> + let new_mapping = StringMap.add origLocal.vname nowLocal.vname rename_mapping in - (*TODO: maybe optimize this with eq_varinfo*) - rename_mapping_aware_compare als bls new_mapping - | _, _ -> false, rename_mapping - in + (*TODO: maybe optimize this with eq_varinfo*) + rename_mapping_aware_compare als bls new_mapping + | _, _ -> false, rename_mapping + in let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in let actHeaderRenameMapping = (headerRenameMapping, global_function_rename_mapping, global_var_rename_mapping) in diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index ba6be0dcf1..44f64f6d5c 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -1,11 +1,23 @@ open Cil -open MyCFG include CompareAST include CompareCFG module StringSet = Set.Make(String) type f = fundec * location +type v = varinfo * initinfo * location + +type globalElem = Fundec of fundec | GlobalVar of varinfo + +let globalElemName elem = match elem with + | Fundec(f) -> f.svar.vname + | GlobalVar(v) -> v.vname + +module GlobalElemForMap = struct + type t = globalElem + + let compare x y = String.compare (globalElemName x) (globalElemName y) +end module FundecForMap = struct type t = Cil.fundec @@ -16,19 +28,24 @@ end module FundecMap = Map.Make(FundecForMap) +module GlobalElemMap = Map.Make(GlobalElemForMap) + (*A dependency maps the function it depends on to the name the function has to be changed to*) type functionDependencies = string StringMap.t + (*Renamed: newName * dependencies; Modified=now*unchangedHeader*) -type functionStatus = SameName of fundec | Renamed of fundec | Created | Deleted | Modified of fundec * bool +type status = SameName of globalElem | Renamed of globalElem | Created | Deleted | Modified of globalElem * bool type outputFunctionStatus = Unchanged of global | UnchangedButRenamed of global | Added | Removed | Changed of global * bool type output = global * outputFunctionStatus -let pretty (f: functionStatus) = + + +let pretty (f: status) = match f with | SameName _ -> "SameName" - | Renamed x -> "Renamed to " ^ x.svar.vname + | Renamed x -> ("Renamed to " ^ globalElemName x) | Created -> "Added" | Deleted -> "Removed" | Modified _ -> "Changed" @@ -39,103 +56,170 @@ let printFundecMap elemToString map = begin ) (FundecMap.to_seq map) end -let getFunctionMap (ast: file) : f StringMap.t = - Cil.foldGlobals ast (fun map global -> +let getFunctionAndGVarMap (ast: file) : f StringMap.t * v StringMap.t = + Cil.foldGlobals ast (fun (functionMap, gvarMap) global -> match global with - | GFun (fundec, location) -> StringMap.add fundec.svar.vname (fundec, location) map - | _ -> map - ) StringMap.empty + | GFun (fundec, location) -> (StringMap.add fundec.svar.vname (fundec, location) functionMap, gvarMap) + | GVar (varinfo, initinfo, location) -> (functionMap, StringMap.add varinfo.vname (varinfo, initinfo, location) gvarMap) + | _ -> functionMap, gvarMap + ) (StringMap.empty, StringMap.empty) + let getDependencies fromEq = StringMap.map (fun assumption -> assumption.new_method_name) fromEq (*Data type that holds the important data while checking for renames. - statusForOldFunction: Status we have already figured out for a fundec from oldAST; - statusForNowFunction: see statusForOldFunction; - methodMapping: Mappings from (fundec of old AST) -> (fundec of now AST) we have already figured out to hold. - reverseMethodMapping: see method mapping, but from now -> old - *) + statusForOldElem: Status we have already figured out for a fundec from oldAST; + statusForNowElem: see statusForOldElem; + mapping: Mappings from (fundec of old AST) -> (fundec of now AST) we have already figured out to hold. + reversemapping: see method mapping, but from now -> old +*) type carryType = { - statusForOldFunction: functionStatus FundecMap.t; - statusForNowFunction: functionStatus FundecMap.t; - methodMapping: fundec FundecMap.t; - reverseMethodMapping: fundec FundecMap.t} + statusForOldElem: status GlobalElemMap.t; + statusForNowElem: status GlobalElemMap.t; + mapping: globalElem GlobalElemMap.t; + reverseMapping: globalElem GlobalElemMap.t; +} (*Carry type manipulation functions.*) let registerStatusForOldF f status data = - {statusForOldFunction = FundecMap.add f status data.statusForOldFunction; - statusForNowFunction=data.statusForNowFunction; - methodMapping=data.methodMapping; - reverseMethodMapping=data.reverseMethodMapping} + {statusForOldElem = GlobalElemMap.add f status data.statusForOldElem; + statusForNowElem=data.statusForNowElem; + mapping=data.mapping; + reverseMapping=data.reverseMapping; + } let registerStatusForNowF f status data = - {statusForOldFunction = data.statusForOldFunction; - statusForNowFunction=FundecMap.add f status data.statusForNowFunction; - methodMapping=data.methodMapping; - reverseMethodMapping=data.reverseMethodMapping} - -let registerBiStatus (oldF: fundec) (nowF: fundec) (status: functionStatus) data = - {statusForOldFunction=FundecMap.add oldF status data.statusForOldFunction; - statusForNowFunction=FundecMap.add nowF status data.statusForNowFunction; - methodMapping=data.methodMapping; - reverseMethodMapping=data.reverseMethodMapping} + {statusForOldElem = data.statusForOldElem; + statusForNowElem=GlobalElemMap.add f status data.statusForNowElem; + mapping=data.mapping; + reverseMapping=data.reverseMapping; + } + +let registerBiStatus (oldF: globalElem) (nowF: globalElem) (status: status) data = + {statusForOldElem=GlobalElemMap.add oldF status data.statusForOldElem; + statusForNowElem=GlobalElemMap.add nowF status data.statusForNowElem; + mapping=data.mapping; + reverseMapping=data.reverseMapping; + } let registerMapping oldF nowF data = - {statusForOldFunction=data.statusForOldFunction; - statusForNowFunction=data.statusForNowFunction; - methodMapping=FundecMap.add oldF nowF data.methodMapping; - reverseMethodMapping=FundecMap.add nowF oldF data.reverseMethodMapping} + {statusForOldElem=data.statusForOldElem; + statusForNowElem=data.statusForNowElem; + mapping=GlobalElemMap.add oldF nowF data.mapping; + reverseMapping=GlobalElemMap.add nowF oldF data.reverseMapping; + } -(*returns true iff for all dependencies it is true, that the dependency has a corresponding function with the new name and matches the without having dependencies itself and the new name is not already present on the old AST. *) -let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_dependencies: glob_var_rename_assumptions) (oldFunctionMap: f StringMap.t) (newFunctionMap: f StringMap.t) (data: carryType) : bool * carryType = - StringMap.fold (fun oldName newName (allEqual, data) -> - (*Early cutoff if a previous dependency returned false or the newName is already present in the old map*) - if allEqual && not (StringMap.mem newName oldFunctionMap) then +let registerGVarMapping oldV nowV data = { + statusForOldElem=data.statusForOldElem; + statusForNowElem=data.statusForNowElem; + mapping=data.mapping; + reverseMapping=data.reverseMapping; +} - let (oldFundec, _) = StringMap.find oldName oldFunctionMap in - let knownMapping = FundecMap.find_opt oldFundec data.methodMapping in +(*returns true iff for all dependencies it is true, that the dependency has a corresponding function with the new name and matches the without having dependencies itself and the new name is not already present on the old AST. *) +let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_dependencies: glob_var_rename_assumptions) (oldFunctionMap: f StringMap.t) (nowFunctionMap: f StringMap.t) (oldGVarMap: v StringMap.t) (nowGVarMap: v StringMap.t) (data: carryType) : bool * carryType = + + let isConsistent = fun old nowName allEqual getName getGlobal oldMap nowMap getNowOption data -> + (*Early cutoff if a previous dependency returned false. + We never create a mapping between globs where the now name was already part of the old set or the old name is part of the now set. + But only if now and old differ. + *) + if allEqual && (getName old = nowName || (not (StringMap.mem nowName oldMap) && not (StringMap.mem (getName old) nowMap))) then + let globalElem = getGlobal old in + let knownMapping = GlobalElemMap.find_opt globalElem data.mapping in + + (*To avoid inconsitencies, if a function has already been mapped to a function, that mapping is reused again.*) + match knownMapping with + | Some(knownElem) -> + (*This function has already been mapped*) + globalElemName knownElem = nowName, data + | None -> + let nowElemOption = getNowOption nowName in + + match nowElemOption with + | Some(nowElem) -> + let compare = fun old now -> + match (old, now) with + | Fundec(oF), Fundec(nF) -> + let doMatch, _, _, function_dependencies, global_var_dependencies = CompareGlobals.eqF oF nF None StringMap.empty VarinfoMap.empty in + doMatch, function_dependencies, global_var_dependencies + | GlobalVar(oV), GlobalVar(nV) -> + let (equal, (_, function_dependencies, global_var_dependencies)) = eq_varinfo oV nV emptyRenameMapping in + (*eq_varinfo always comes back with a self dependency. We need to filter that out.*) + equal, function_dependencies, (VarinfoMap.filter (fun vi name -> not (vi.vname = oV.vname && name = nowName)) global_var_dependencies) + | _, _ -> failwith "Unknown or incompatible global types" + in + + + let doMatch, function_dependencies, global_var_dependencies = compare globalElem nowElem in + + (*let _ = Printf.printf "%s <-> %s: %b %b %b\n" (getName old) (globalElemName nowElem) doMatch (StringMap.is_empty function_dependencies) (VarinfoMap.is_empty global_var_dependencies) in + + let _ = Printf.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in + *) + if doMatch && StringMap.is_empty function_dependencies && VarinfoMap.is_empty global_var_dependencies then + true, registerMapping globalElem nowElem data + else false, data - (*To avoid inconsitencies, if a function has already been mapped to a function, that mapping is reused again.*) - match knownMapping with - | Some(knownFundec) -> - (*This function has already been mapped*) - knownFundec.svar.vname = newName, data | None -> - let newFundecOption = StringMap.find_opt newName newFunctionMap in - - match newFundecOption with - | Some((newFundec, _)) -> - let doMatch, _, _, function_dependencies, global_var_dependencies = CompareGlobals.eqF oldFundec newFundec None StringMap.empty VarinfoMap.empty in - - if doMatch && StringMap.is_empty function_dependencies && VarinfoMap.is_empty global_var_dependencies then - true, registerMapping oldFundec newFundec data - else false, data + false, data + else false, data + in - | None -> false, data - else false, data - ) dependencies (true, data) + StringMap.fold (fun oldName nowName (allEqual, data) -> + let (old, _) = StringMap.find oldName oldFunctionMap in + isConsistent + old + nowName + allEqual + (fun x -> x.svar.vname) + (fun x -> Fundec(x)) + oldFunctionMap + nowFunctionMap + (fun x -> + Option.bind (StringMap.find_opt x nowFunctionMap) (fun (x, _) -> Some(Fundec(x))) + ) + data + ) dependencies (true, data) |> + VarinfoMap.fold (fun oldVarinfo nowName (allEqual, data) -> + isConsistent + oldVarinfo + nowName + allEqual + (fun x -> x.vname) + (fun x -> GlobalVar(x)) + oldGVarMap + nowGVarMap + (fun x -> + Option.bind (StringMap.find_opt x nowGVarMap) (fun (x, _, _) -> Some(GlobalVar(x))) + ) + data + ) + global_var_dependencies (*Check if f has already been assigned a status. If yes do nothing. If not, check if the function took part in the mapping, then register it to have been renamed. Otherwise register it as the supplied status.*) -let assignStatusToUnassignedFunction data f registerStatus statusMap mapping status = - if not (FundecMap.mem f statusMap) then - if (FundecMap.mem f mapping) then - registerStatus f (Renamed(FundecMap.find f mapping)) data +let assignStatusToUnassignedElem data f registerStatus statusMap mapping status = + if not (GlobalElemMap.mem f statusMap) then + if (GlobalElemMap.mem f mapping) then + registerStatus f (Renamed (GlobalElemMap.find f mapping)) data else (*this function has been added/removed*) registerStatus f status data else data -let detectRenamedFunctions (oldAST: file) (newAST: file) : output FundecMap.t = begin - let oldFunctionMap = getFunctionMap oldAST in - let nowFunctionMap = getFunctionMap newAST in +let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap.t = begin + let oldFunctionMap, oldGVarMap = getFunctionAndGVarMap oldAST in + let nowFunctionMap, nowGVarMap = getFunctionAndGVarMap newAST in - let initialData: carryType = {statusForOldFunction = FundecMap.empty; - statusForNowFunction = FundecMap.empty; - methodMapping=FundecMap.empty; - reverseMethodMapping=FundecMap.empty} in + let initialData: carryType = {statusForOldElem = GlobalElemMap.empty; + statusForNowElem = GlobalElemMap.empty; + mapping=GlobalElemMap.empty; + reverseMapping=GlobalElemMap.empty; + } in (*Go through all functions, for all that have not been renamed *) let finalData = @@ -145,62 +229,80 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output FundecMap.t = | Some (newFun, _) -> (*Compare if they are similar*) let doMatch, unchangedHeader, _, function_dependencies, global_var_dependencies = - CompareGlobals.eqF f newFun None StringMap.empty VarinfoMap.empty in + CompareGlobals.eqF f newFun None StringMap.empty VarinfoMap.empty in + + let _ = Pretty.printf "%s <-> %s: %b %s\n" f.svar.vname newFun.svar.vname doMatch (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in + + let _ = Pretty.printf "old locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) f.slocals)) in + let _ = Pretty.printf "now locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) newFun.slocals)) in - let _ = Pretty.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in let actDependencies = getDependencies function_dependencies in + let oldG = Fundec(f) in + let nowG = Fundec(newFun) in + + if doMatch then - let doDependenciesMatch, updatedData = doAllDependenciesMatch actDependencies global_var_dependencies oldFunctionMap nowFunctionMap data in + let doDependenciesMatch, updatedData = doAllDependenciesMatch actDependencies global_var_dependencies oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap data in if doDependenciesMatch then - registerBiStatus f newFun (SameName(newFun)) updatedData + registerBiStatus oldG nowG (SameName(oldG)) updatedData else - registerStatusForOldF f (Modified(newFun, unchangedHeader)) data |> - registerStatusForNowF newFun (Modified(f, unchangedHeader)) + registerStatusForOldF oldG (Modified(nowG, unchangedHeader)) data |> + registerStatusForNowF nowG (Modified(oldG, unchangedHeader)) else - registerStatusForOldF f (Modified(newFun, unchangedHeader)) data |> - registerStatusForNowF newFun (Modified(f, unchangedHeader)) + registerStatusForOldF oldG (Modified(nowG, unchangedHeader)) data |> + registerStatusForNowF nowG (Modified(oldG, unchangedHeader)) | None -> data ) oldFunctionMap initialData |> (*At this point we already know of the functions that have changed and stayed the same. We now assign the correct status to all the functions that have been mapped. The functions that have not been mapped are added/removed.*) (*Now go through all old functions again. Those who have not been assigned a status are removed*) StringMap.fold (fun _ (f, _) (data: carryType) -> - assignStatusToUnassignedFunction data f registerStatusForOldF data.statusForOldFunction data.methodMapping Deleted + assignStatusToUnassignedElem data (Fundec(f)) registerStatusForOldF data.statusForOldElem data.mapping Deleted ) oldFunctionMap |> (*now go through all new functions. Those have have not been assigned a mapping are added.*) StringMap.fold (fun _ (nowF, _) (data: carryType) -> - assignStatusToUnassignedFunction data nowF registerStatusForNowF data.statusForNowFunction data.reverseMethodMapping Created - ) nowFunctionMap - + assignStatusToUnassignedElem data (Fundec(nowF)) registerStatusForNowF data.statusForNowElem data.reverseMapping Created + ) nowFunctionMap |> + StringMap.fold (fun _ (v, _, _) data -> + assignStatusToUnassignedElem data (GlobalVar(v)) registerStatusForOldF data.statusForOldElem data.mapping Deleted + ) oldGVarMap |> + StringMap.fold (fun _ (nowV, _, _) (data: carryType) -> + assignStatusToUnassignedElem data (GlobalVar(nowV)) registerStatusForNowF data.statusForNowElem data.reverseMapping Created + ) nowGVarMap in (*Done with the analyis, the following just adjusts the output types.*) (*Map back to GFun and exposed function status*) - let extractOutput funMap invertedFunMap f (s: functionStatus) = - let getGFun f2 map = - let (f, l) = StringMap.find f2.svar.vname map in - GFun(f, l) + let extractOutput funMap invertedFunMap gvarMap invertedGvarMap f (s: status) = + let getGlobal gT fundecMap gVarMap = + match gT with + | Fundec(f2) -> + let (f, l) = StringMap.find f2.svar.vname fundecMap in + GFun(f, l) + | GlobalVar(v2) -> + let (v, i, l) = StringMap.find v2.vname gVarMap in + GVar(v, i, l) in let outputS = match s with - | SameName x -> Unchanged(getGFun x invertedFunMap) - | Renamed x -> UnchangedButRenamed(getGFun x invertedFunMap) + | SameName x -> Unchanged(getGlobal x invertedFunMap invertedGvarMap) + | Renamed x -> UnchangedButRenamed(getGlobal x invertedFunMap invertedGvarMap) | Created -> Added | Deleted -> Removed - | Modified (x, unchangedHeader) -> Changed(getGFun x invertedFunMap, unchangedHeader) + | Modified (x, unchangedHeader) -> Changed(getGlobal x invertedFunMap invertedGvarMap, unchangedHeader) in - getGFun f funMap, outputS + getGlobal f funMap gvarMap, outputS in (*Merge together old and now functions*) - FundecMap.merge (fun _ a b -> + GlobalElemMap.merge (fun _ a b -> if Option.is_some a then a else if Option.is_some b then b else None ) - (FundecMap.mapi (extractOutput oldFunctionMap nowFunctionMap) finalData.statusForOldFunction) - (FundecMap.mapi (extractOutput nowFunctionMap oldFunctionMap) finalData.statusForNowFunction) + (GlobalElemMap.mapi (extractOutput oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap) finalData.statusForOldElem) + (GlobalElemMap.mapi (extractOutput nowFunctionMap oldFunctionMap nowGVarMap oldGVarMap) finalData.statusForNowElem) end diff --git a/tests/incremental/06-glob-var-rename/02-add_new_gvar.c b/tests/incremental/06-glob-var-rename/02-add_new_gvar.c new file mode 100644 index 0000000000..5efe319981 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/02-add_new_gvar.c @@ -0,0 +1,8 @@ +#include + +int myVar = 1; + +int main() { + printf("%d", myVar); + printf("%d", myVar); +} diff --git a/tests/incremental/06-glob-var-rename/02-add_new_gvar.json b/tests/incremental/06-glob-var-rename/02-add_new_gvar.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/02-add_new_gvar.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/06-glob-var-rename/02-add_new_gvar.patch b/tests/incremental/06-glob-var-rename/02-add_new_gvar.patch new file mode 100644 index 0000000000..f0c145107a --- /dev/null +++ b/tests/incremental/06-glob-var-rename/02-add_new_gvar.patch @@ -0,0 +1,13 @@ +--- tests/incremental/06-glob-var-rename/02-add_new_gvar.c ++++ tests/incremental/06-glob-var-rename/02-add_new_gvar.c +@@ -1,8 +1,9 @@ + #include + + int myVar = 1; ++int foo = 1; + + int main() { + printf("%d", myVar); +- printf("%d", myVar); ++ printf("%d", foo); + } diff --git a/tests/incremental/06-glob-var-rename/diffs/02-add_new_gvar.c b/tests/incremental/06-glob-var-rename/diffs/02-add_new_gvar.c new file mode 100644 index 0000000000..3841a59b11 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/diffs/02-add_new_gvar.c @@ -0,0 +1,9 @@ +#include + +int myVar = 1; +int foo = 1; + +int main() { + printf("%d", myVar); + printf("%d", foo); +} From fae1e5e2964d5961aa371390e3360e6e9a14dba9 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 8 Jun 2022 14:07:17 +0200 Subject: [PATCH 034/518] Moved multiple incremental run tests to subdirectory. --- .../{ => multiple_incremental_runs}/08-2_incremental_runs.json | 0 .../{ => multiple_incremental_runs}/08-2_incremental_runs_1.c | 0 .../{ => multiple_incremental_runs}/08-2_incremental_runs_1.patch | 0 .../{ => multiple_incremental_runs}/08-2_incremental_runs_2.patch | 0 .../{ => multiple_incremental_runs}/09-2_ir_with_changes.json | 0 .../{ => multiple_incremental_runs}/09-2_ir_with_changes_1.c | 0 .../{ => multiple_incremental_runs}/09-2_ir_with_changes_1.patch | 0 .../{ => multiple_incremental_runs}/09-2_ir_with_changes_2.patch | 0 8 files changed, 0 insertions(+), 0 deletions(-) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/08-2_incremental_runs.json (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/08-2_incremental_runs_1.c (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/08-2_incremental_runs_1.patch (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/08-2_incremental_runs_2.patch (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/09-2_ir_with_changes.json (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/09-2_ir_with_changes_1.c (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/09-2_ir_with_changes_1.patch (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/09-2_ir_with_changes_2.patch (100%) diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs.json b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs.json similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs.json rename to tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs.json diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_1.c b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.c similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs_1.c rename to tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.c diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_1.patch b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.patch similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs_1.patch rename to tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.patch diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_2.patch b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_2.patch similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs_2.patch rename to tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_2.patch diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes.json b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes.json similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes.json rename to tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes.json diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_1.c b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.c similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes_1.c rename to tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.c diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.patch similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch rename to tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.patch diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_2.patch similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch rename to tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_2.patch From 0c6b9c42902ba3e12792311ff430b77f485bb6fb Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 8 Jun 2022 14:07:17 +0200 Subject: [PATCH 035/518] Moved multiple incremental run tests to subdirectory. --- .../{ => multiple_incremental_runs}/08-2_incremental_runs.json | 0 .../{ => multiple_incremental_runs}/08-2_incremental_runs_1.c | 0 .../{ => multiple_incremental_runs}/08-2_incremental_runs_1.patch | 0 .../{ => multiple_incremental_runs}/08-2_incremental_runs_2.patch | 0 .../{ => multiple_incremental_runs}/09-2_ir_with_changes.json | 0 .../{ => multiple_incremental_runs}/09-2_ir_with_changes_1.c | 0 .../{ => multiple_incremental_runs}/09-2_ir_with_changes_1.patch | 0 .../{ => multiple_incremental_runs}/09-2_ir_with_changes_2.patch | 0 8 files changed, 0 insertions(+), 0 deletions(-) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/08-2_incremental_runs.json (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/08-2_incremental_runs_1.c (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/08-2_incremental_runs_1.patch (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/08-2_incremental_runs_2.patch (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/09-2_ir_with_changes.json (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/09-2_ir_with_changes_1.c (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/09-2_ir_with_changes_1.patch (100%) rename tests/incremental/04-var-rename/{ => multiple_incremental_runs}/09-2_ir_with_changes_2.patch (100%) diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs.json b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs.json similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs.json rename to tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs.json diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_1.c b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.c similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs_1.c rename to tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.c diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_1.patch b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.patch similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs_1.patch rename to tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.patch diff --git a/tests/incremental/04-var-rename/08-2_incremental_runs_2.patch b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_2.patch similarity index 100% rename from tests/incremental/04-var-rename/08-2_incremental_runs_2.patch rename to tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_2.patch diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes.json b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes.json similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes.json rename to tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes.json diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_1.c b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.c similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes_1.c rename to tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.c diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.patch similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes_1.patch rename to tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.patch diff --git a/tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_2.patch similarity index 100% rename from tests/incremental/04-var-rename/09-2_ir_with_changes_2.patch rename to tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_2.patch From a9a2e65d68b7e2b4689639a1e4e9c42f63316169 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 14 Jun 2022 19:31:58 +0200 Subject: [PATCH 036/518] Now also uses VarinfoMap for method rename assumptions --- src/incremental/compareAST.ml | 23 +++++++--------------- src/incremental/compareCIL.ml | 2 +- src/incremental/detectRenamedFunctions.ml | 24 ++++++++--------------- src/util/cilMaps.ml | 20 +++++++++++++++++++ 4 files changed, 36 insertions(+), 33 deletions(-) create mode 100644 src/util/cilMaps.ml diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 598bc03418..43388c9bad 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -1,4 +1,5 @@ open Cil +open CilMaps (* global_type and global_t are implicitly used by GlobalMap to keep GVarDecl apart from GVar and GFun, so do not remove! *) type global_type = Fun | Decl | Var @@ -7,24 +8,14 @@ and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] module StringMap = Map.Make(String) -module VarinfoOrdered = struct - type t = varinfo - - (*x.svar.uid cannot be used, as they may overlap between old and now AST*) - let compare (x: varinfo) (y: varinfo) = String.compare x.vname y.vname -end - - -module VarinfoMap = Map.Make(VarinfoOrdered) - type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: string StringMap.t} -type method_rename_assumptions = method_rename_assumption StringMap.t +type method_rename_assumptions = method_rename_assumption VarinfoMap.t type glob_var_rename_assumptions = string VarinfoMap.t (*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) type rename_mapping = (string StringMap.t) * (method_rename_assumptions) * glob_var_rename_assumptions -let emptyRenameMapping = (StringMap.empty, StringMap.empty, VarinfoMap.empty) +let emptyRenameMapping = (StringMap.empty, VarinfoMap.empty, VarinfoMap.empty) (*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) @@ -59,7 +50,7 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods, glob_vars) = rename_mapping in let local_string = string_tuple_to_string (List.of_seq (StringMap.to_seq local)) in - let methods_string: string = List.of_seq (StringMap.to_seq methods |> Seq.map snd) |> + let methods_string: string = List.of_seq (VarinfoMap.to_seq methods |> Seq.map snd) |> List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ "; renamed_params=" ^ string_tuple_to_string (List.of_seq (StringMap.to_seq parameter_renames)) ^ ")") |> @@ -252,7 +243,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) let isNamingOk, updated_method_rename_mappings, updatedGlobVarMapping = match a.vtype, b.vtype with | TFun(_, aParamSpec, _, _), TFun(_, bParamSpec, _, _) -> ( - let specific_method_rename_mapping = StringMap.find_opt a.vname method_rename_mappings in + let specific_method_rename_mapping = VarinfoMap.find_opt a method_rename_mappings in match specific_method_rename_mapping with | Some method_rename_mapping -> let is_naming_ok = method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname in @@ -272,7 +263,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool let assumption = {original_method_name = a.vname; new_method_name = b.vname; parameter_renames = create_locals_rename_mapping aParamNames bParamNames} in - true, StringMap.add a.vname assumption method_rename_mappings, glob_vars + true, VarinfoMap.add a assumption method_rename_mappings, glob_vars else true, method_rename_mappings, glob_vars ) | TInt (_, _), TInt (_, _) -> compare_local_and_global_var @@ -284,7 +275,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool (*If the following is a method call, we need to check if we have a mapping for that method call. *) let typ_rename_mapping = match b.vtype with | TFun(_, _, _, _) -> ( - let new_locals = StringMap.find_opt a.vname updated_method_rename_mappings in + let new_locals = VarinfoMap.find_opt a updated_method_rename_mappings in match new_locals with | Some locals -> diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 0deca77de2..9e3475e665 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -9,7 +9,7 @@ let empty_change_info () : change_info = {added = []; removed = []; changed = [] let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt, _, _ = CompareGlobals.eqF f g cfgs StringMap.empty VarinfoMap.empty in + let identical, unchangedHeader, diffOpt, _, _ = CompareGlobals.eqF f g cfgs VarinfoMap.empty VarinfoMap.empty in identical, unchangedHeader, diffOpt | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y emptyRenameMapping |> fst, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 44f64f6d5c..11222849a6 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -1,6 +1,7 @@ open Cil include CompareAST include CompareCFG +open CilMaps module StringSet = Set.Make(String) @@ -19,19 +20,10 @@ module GlobalElemForMap = struct let compare x y = String.compare (globalElemName x) (globalElemName y) end -module FundecForMap = struct - type t = Cil.fundec - - (*x.svar.uid cannot be used, as they may overlap between old and now AST*) - let compare x y = String.compare x.svar.vname y.svar.vname -end - -module FundecMap = Map.Make(FundecForMap) - module GlobalElemMap = Map.Make(GlobalElemForMap) (*A dependency maps the function it depends on to the name the function has to be changed to*) -type functionDependencies = string StringMap.t +type functionDependencies = string VarinfoMap.t (*Renamed: newName * dependencies; Modified=now*unchangedHeader*) @@ -65,7 +57,7 @@ let getFunctionAndGVarMap (ast: file) : f StringMap.t * v StringMap.t = ) (StringMap.empty, StringMap.empty) -let getDependencies fromEq = StringMap.map (fun assumption -> assumption.new_method_name) fromEq +let getDependencies fromEq = VarinfoMap.map (fun assumption -> assumption.new_method_name) fromEq (*Data type that holds the important data while checking for renames. statusForOldElem: Status we have already figured out for a fundec from oldAST; @@ -143,7 +135,7 @@ let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_depe let compare = fun old now -> match (old, now) with | Fundec(oF), Fundec(nF) -> - let doMatch, _, _, function_dependencies, global_var_dependencies = CompareGlobals.eqF oF nF None StringMap.empty VarinfoMap.empty in + let doMatch, _, _, function_dependencies, global_var_dependencies = CompareGlobals.eqF oF nF None VarinfoMap.empty VarinfoMap.empty in doMatch, function_dependencies, global_var_dependencies | GlobalVar(oV), GlobalVar(nV) -> let (equal, (_, function_dependencies, global_var_dependencies)) = eq_varinfo oV nV emptyRenameMapping in @@ -159,7 +151,7 @@ let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_depe let _ = Printf.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in *) - if doMatch && StringMap.is_empty function_dependencies && VarinfoMap.is_empty global_var_dependencies then + if doMatch && VarinfoMap.is_empty function_dependencies && VarinfoMap.is_empty global_var_dependencies then true, registerMapping globalElem nowElem data else false, data @@ -168,8 +160,8 @@ let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_depe else false, data in - StringMap.fold (fun oldName nowName (allEqual, data) -> - let (old, _) = StringMap.find oldName oldFunctionMap in + VarinfoMap.fold (fun old nowName (allEqual, data) -> + let (old, _) = StringMap.find old.vname oldFunctionMap in isConsistent old nowName @@ -229,7 +221,7 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap. | Some (newFun, _) -> (*Compare if they are similar*) let doMatch, unchangedHeader, _, function_dependencies, global_var_dependencies = - CompareGlobals.eqF f newFun None StringMap.empty VarinfoMap.empty in + CompareGlobals.eqF f newFun None VarinfoMap.empty VarinfoMap.empty in let _ = Pretty.printf "%s <-> %s: %b %s\n" f.svar.vname newFun.svar.vname doMatch (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in diff --git a/src/util/cilMaps.ml b/src/util/cilMaps.ml new file mode 100644 index 0000000000..5a23328151 --- /dev/null +++ b/src/util/cilMaps.ml @@ -0,0 +1,20 @@ +open Cil + +module FundecForMap = struct + type t = Cil.fundec + + (*x.svar.uid cannot be used, as they may overlap between old and now AST*) + let compare x y = String.compare x.svar.vname y.svar.vname +end + +module FundecMap = Map.Make(FundecForMap) + +module VarinfoOrdered = struct + type t = varinfo + + (*x.svar.uid cannot be used, as they may overlap between old and now AST*) + let compare (x: varinfo) (y: varinfo) = String.compare x.vname y.vname +end + + +module VarinfoMap = Map.Make(VarinfoOrdered) From ed605ff3fd0606248b71423a906da977b1d9ac88 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 14 Jun 2022 19:34:19 +0200 Subject: [PATCH 037/518] Now uses varinfo#vGlob to check if a variable is global --- src/incremental/compareAST.ml | 3 +-- src/incremental/compareCIL.ml | 1 + 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 43388c9bad..a6af65fcde 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -226,8 +226,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool let (locals_renames, method_rename_mappings, glob_vars) = rename_mapping in let compare_local_and_global_var = - let is_local = StringMap.mem a.vname locals_renames in - if not is_local then + if a.vglob then let present_mapping = VarinfoMap.find_opt a glob_vars in match present_mapping with diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 9e3475e665..4a9452dc4e 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -4,6 +4,7 @@ open CompareGlobals include DetectRenamedFunctions include CompareAST include CompareCFG +open CilMaps let empty_change_info () : change_info = {added = []; removed = []; changed = []; unchanged = []} From 3b60fb7754de74efa98cf1afbe45dd2535d5e208 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:07:27 +0200 Subject: [PATCH 038/518] Removed unused currentFunctionName global state. --- src/framework/analyses.ml | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 506d350d5a..5a8a1f51c9 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -8,8 +8,6 @@ open GobConfig module GU = Goblintutil module M = Messages -let currentFunctionName: string ref = ref "" - (** Analysis starts from lists of functions: start functions, exit functions, and * other functions. *) type fundecs = fundec list * fundec list * fundec list @@ -143,9 +141,6 @@ struct See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) let loc = UpdateCil.getLoc n in - let parentNode = Node.find_fundec n in - currentFunctionName.contents <- RenameMapping.show_varinfo parentNode.svar; - BatPrintf.fprintf f "\n" (Node.show_id n) loc.file loc.line loc.byte loc.column; BatPrintf.fprintf f "%a\n" Range.printXml v in From e9494eb21a4fccf1c2e1ca61a6aa157b2960cb15 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:10:14 +0200 Subject: [PATCH 039/518] Removed useless global state cherry pick --- src/framework/analyses.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 1b4969dba7..de19700109 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -8,8 +8,6 @@ open GobConfig module GU = Goblintutil module M = Messages -let currentFunctionName: string ref = ref "" - (** Analysis starts from lists of functions: start functions, exit functions, and * other functions. *) type fundecs = fundec list * fundec list * fundec list From 1eae9c326a5e8f45aa2740f8bf9ab1d010af6411 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:18:37 +0200 Subject: [PATCH 040/518] Removed nothing test case --- tests/incremental/04-var-rename/00-unused_rename.patch | 8 -------- tests/incremental/04-var-rename/01-nothing.c | 4 ---- tests/incremental/04-var-rename/01-nothing.json | 3 --- tests/incremental/04-var-rename/01-nothing.patch | 8 -------- .../{00-unused_rename.c => 01-unused_rename.c} | 0 .../{00-unused_rename.json => 01-unused_rename.json} | 0 tests/incremental/04-var-rename/01-unused_rename.patch | 8 ++++++++ tests/incremental/04-var-rename/diffs/01-nothing.c | 5 ----- .../diffs/{00-unused_rename.c => 01-unused_rename.c} | 0 9 files changed, 8 insertions(+), 28 deletions(-) delete mode 100644 tests/incremental/04-var-rename/00-unused_rename.patch delete mode 100644 tests/incremental/04-var-rename/01-nothing.c delete mode 100644 tests/incremental/04-var-rename/01-nothing.json delete mode 100644 tests/incremental/04-var-rename/01-nothing.patch rename tests/incremental/04-var-rename/{00-unused_rename.c => 01-unused_rename.c} (100%) rename tests/incremental/04-var-rename/{00-unused_rename.json => 01-unused_rename.json} (100%) create mode 100644 tests/incremental/04-var-rename/01-unused_rename.patch delete mode 100644 tests/incremental/04-var-rename/diffs/01-nothing.c rename tests/incremental/04-var-rename/diffs/{00-unused_rename.c => 01-unused_rename.c} (100%) diff --git a/tests/incremental/04-var-rename/00-unused_rename.patch b/tests/incremental/04-var-rename/00-unused_rename.patch deleted file mode 100644 index d3d15e3bc7..0000000000 --- a/tests/incremental/04-var-rename/00-unused_rename.patch +++ /dev/null @@ -1,8 +0,0 @@ ---- tests/incremental/04-var-rename/00-unused_rename.c -+++ tests/incremental/04-var-rename/00-unused_rename.c -@@ -1,4 +1,4 @@ - int main() { -- int a = 0; -+ int b = 0; - return 0; - } diff --git a/tests/incremental/04-var-rename/01-nothing.c b/tests/incremental/04-var-rename/01-nothing.c deleted file mode 100644 index 3dc9c8f6e6..0000000000 --- a/tests/incremental/04-var-rename/01-nothing.c +++ /dev/null @@ -1,4 +0,0 @@ -int main() { - int x = 0; - return 0; -} diff --git a/tests/incremental/04-var-rename/01-nothing.json b/tests/incremental/04-var-rename/01-nothing.json deleted file mode 100644 index 544b7b4ddd..0000000000 --- a/tests/incremental/04-var-rename/01-nothing.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/01-nothing.patch b/tests/incremental/04-var-rename/01-nothing.patch deleted file mode 100644 index 663c19abfc..0000000000 --- a/tests/incremental/04-var-rename/01-nothing.patch +++ /dev/null @@ -1,8 +0,0 @@ ---- tests/incremental/04-var-rename/01-nothing.c -+++ tests/incremental/04-var-rename/01-nothing.c -@@ -1,4 +1,5 @@ - int main() { - int x = 0; -+ - return 0; - } diff --git a/tests/incremental/04-var-rename/00-unused_rename.c b/tests/incremental/04-var-rename/01-unused_rename.c similarity index 100% rename from tests/incremental/04-var-rename/00-unused_rename.c rename to tests/incremental/04-var-rename/01-unused_rename.c diff --git a/tests/incremental/04-var-rename/00-unused_rename.json b/tests/incremental/04-var-rename/01-unused_rename.json similarity index 100% rename from tests/incremental/04-var-rename/00-unused_rename.json rename to tests/incremental/04-var-rename/01-unused_rename.json diff --git a/tests/incremental/04-var-rename/01-unused_rename.patch b/tests/incremental/04-var-rename/01-unused_rename.patch new file mode 100644 index 0000000000..977470ad53 --- /dev/null +++ b/tests/incremental/04-var-rename/01-unused_rename.patch @@ -0,0 +1,8 @@ +--- tests/incremental/04-var-rename/01-unused_rename.c ++++ tests/incremental/04-var-rename/01-unused_rename.c +@@ -1,4 +1,4 @@ + int main() { +- int a = 0; ++ int b = 0; + return 0; + } diff --git a/tests/incremental/04-var-rename/diffs/01-nothing.c b/tests/incremental/04-var-rename/diffs/01-nothing.c deleted file mode 100644 index 3c9e6cafd7..0000000000 --- a/tests/incremental/04-var-rename/diffs/01-nothing.c +++ /dev/null @@ -1,5 +0,0 @@ -int main() { - int x = 0; - - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/00-unused_rename.c b/tests/incremental/04-var-rename/diffs/01-unused_rename.c similarity index 100% rename from tests/incremental/04-var-rename/diffs/00-unused_rename.c rename to tests/incremental/04-var-rename/diffs/01-unused_rename.c From 192129905f66a52b9e0c56a8775333250be5d4df Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:19:12 +0200 Subject: [PATCH 041/518] Fixed analysis.ml --- src/framework/analyses.ml | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index de19700109..355344d89e 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -151,9 +151,6 @@ struct See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) let loc = UpdateCil.getLoc n in - let parentNode = Node.find_fundec n in - currentFunctionName.contents <- parentNode.svar.vname; - BatPrintf.fprintf f "\n" (Node.show_id n) loc.file loc.line loc.byte loc.column; BatPrintf.fprintf f "%a\n" Range.printXml v in From fd691c5570a19d92551b84b7155acac988584558 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:18:37 +0200 Subject: [PATCH 042/518] Removed nothing test case --- tests/incremental/04-var-rename/00-unused_rename.patch | 8 -------- tests/incremental/04-var-rename/01-nothing.c | 4 ---- tests/incremental/04-var-rename/01-nothing.json | 3 --- tests/incremental/04-var-rename/01-nothing.patch | 8 -------- .../{00-unused_rename.c => 01-unused_rename.c} | 0 .../{00-unused_rename.json => 01-unused_rename.json} | 0 tests/incremental/04-var-rename/01-unused_rename.patch | 8 ++++++++ tests/incremental/04-var-rename/diffs/01-nothing.c | 5 ----- .../diffs/{00-unused_rename.c => 01-unused_rename.c} | 0 9 files changed, 8 insertions(+), 28 deletions(-) delete mode 100644 tests/incremental/04-var-rename/00-unused_rename.patch delete mode 100644 tests/incremental/04-var-rename/01-nothing.c delete mode 100644 tests/incremental/04-var-rename/01-nothing.json delete mode 100644 tests/incremental/04-var-rename/01-nothing.patch rename tests/incremental/04-var-rename/{00-unused_rename.c => 01-unused_rename.c} (100%) rename tests/incremental/04-var-rename/{00-unused_rename.json => 01-unused_rename.json} (100%) create mode 100644 tests/incremental/04-var-rename/01-unused_rename.patch delete mode 100644 tests/incremental/04-var-rename/diffs/01-nothing.c rename tests/incremental/04-var-rename/diffs/{00-unused_rename.c => 01-unused_rename.c} (100%) diff --git a/tests/incremental/04-var-rename/00-unused_rename.patch b/tests/incremental/04-var-rename/00-unused_rename.patch deleted file mode 100644 index d3d15e3bc7..0000000000 --- a/tests/incremental/04-var-rename/00-unused_rename.patch +++ /dev/null @@ -1,8 +0,0 @@ ---- tests/incremental/04-var-rename/00-unused_rename.c -+++ tests/incremental/04-var-rename/00-unused_rename.c -@@ -1,4 +1,4 @@ - int main() { -- int a = 0; -+ int b = 0; - return 0; - } diff --git a/tests/incremental/04-var-rename/01-nothing.c b/tests/incremental/04-var-rename/01-nothing.c deleted file mode 100644 index 3dc9c8f6e6..0000000000 --- a/tests/incremental/04-var-rename/01-nothing.c +++ /dev/null @@ -1,4 +0,0 @@ -int main() { - int x = 0; - return 0; -} diff --git a/tests/incremental/04-var-rename/01-nothing.json b/tests/incremental/04-var-rename/01-nothing.json deleted file mode 100644 index 544b7b4ddd..0000000000 --- a/tests/incremental/04-var-rename/01-nothing.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/01-nothing.patch b/tests/incremental/04-var-rename/01-nothing.patch deleted file mode 100644 index 663c19abfc..0000000000 --- a/tests/incremental/04-var-rename/01-nothing.patch +++ /dev/null @@ -1,8 +0,0 @@ ---- tests/incremental/04-var-rename/01-nothing.c -+++ tests/incremental/04-var-rename/01-nothing.c -@@ -1,4 +1,5 @@ - int main() { - int x = 0; -+ - return 0; - } diff --git a/tests/incremental/04-var-rename/00-unused_rename.c b/tests/incremental/04-var-rename/01-unused_rename.c similarity index 100% rename from tests/incremental/04-var-rename/00-unused_rename.c rename to tests/incremental/04-var-rename/01-unused_rename.c diff --git a/tests/incremental/04-var-rename/00-unused_rename.json b/tests/incremental/04-var-rename/01-unused_rename.json similarity index 100% rename from tests/incremental/04-var-rename/00-unused_rename.json rename to tests/incremental/04-var-rename/01-unused_rename.json diff --git a/tests/incremental/04-var-rename/01-unused_rename.patch b/tests/incremental/04-var-rename/01-unused_rename.patch new file mode 100644 index 0000000000..977470ad53 --- /dev/null +++ b/tests/incremental/04-var-rename/01-unused_rename.patch @@ -0,0 +1,8 @@ +--- tests/incremental/04-var-rename/01-unused_rename.c ++++ tests/incremental/04-var-rename/01-unused_rename.c +@@ -1,4 +1,4 @@ + int main() { +- int a = 0; ++ int b = 0; + return 0; + } diff --git a/tests/incremental/04-var-rename/diffs/01-nothing.c b/tests/incremental/04-var-rename/diffs/01-nothing.c deleted file mode 100644 index 3c9e6cafd7..0000000000 --- a/tests/incremental/04-var-rename/diffs/01-nothing.c +++ /dev/null @@ -1,5 +0,0 @@ -int main() { - int x = 0; - - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/00-unused_rename.c b/tests/incremental/04-var-rename/diffs/01-unused_rename.c similarity index 100% rename from tests/incremental/04-var-rename/diffs/00-unused_rename.c rename to tests/incremental/04-var-rename/diffs/01-unused_rename.c From 686a3da496760afd2320eb825e396f06f81ff62e Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:48:29 +0200 Subject: [PATCH 043/518] Added include assert to tests. Removed useless test.c --- .../incremental/04-var-rename/04-renamed_assert.c | 2 ++ .../04-var-rename/diffs/04-renamed_assert.c | 2 ++ .../08-2_incremental_runs_1.c | 2 ++ .../09-2_ir_with_changes_1.c | 2 ++ tests/incremental/04-var-rename/test.c | 15 --------------- 5 files changed, 8 insertions(+), 15 deletions(-) delete mode 100644 tests/incremental/04-var-rename/test.c diff --git a/tests/incremental/04-var-rename/04-renamed_assert.c b/tests/incremental/04-var-rename/04-renamed_assert.c index 55d83e7229..4a4a9e7f21 100644 --- a/tests/incremental/04-var-rename/04-renamed_assert.c +++ b/tests/incremental/04-var-rename/04-renamed_assert.c @@ -1,3 +1,5 @@ +#include + int main() { int myVar = 0; diff --git a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c index 8f74e36a13..642609580c 100644 --- a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c +++ b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c @@ -1,3 +1,5 @@ +#include + int main() { int j = 0; diff --git a/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.c b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.c index d9b5afdd19..e522ad239a 100644 --- a/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.c +++ b/tests/incremental/04-var-rename/multiple_incremental_runs/08-2_incremental_runs_1.c @@ -1,3 +1,5 @@ +#include + int main() { int varFirstIteration = 0; diff --git a/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.c b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.c index 535d3c21fc..e50f6d9beb 100644 --- a/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.c +++ b/tests/incremental/04-var-rename/multiple_incremental_runs/09-2_ir_with_changes_1.c @@ -1,3 +1,5 @@ +#include + void foo() { int fooOne = 1; fooOne++; diff --git a/tests/incremental/04-var-rename/test.c b/tests/incremental/04-var-rename/test.c deleted file mode 100644 index f51eb0d6f7..0000000000 --- a/tests/incremental/04-var-rename/test.c +++ /dev/null @@ -1,15 +0,0 @@ -void foo() { - int i = 0; - - for(int i = 0; i < 10; i++); -} - -void bar() { - int i = 0; -} - -int main() { - foo(); - bar(); - return 0; -} \ No newline at end of file From 0a0ee34aea61364808da4be56542a68dc7cd2a27 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:49:45 +0200 Subject: [PATCH 044/518] Replaced tupletostring with fancy syntax. --- src/incremental/compareAST.ml | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 2b72de178e..42e019b86d 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -26,17 +26,13 @@ let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename (*Printf.printf "No assumption when %s, %s, %b\n" name1 name2 (name1 = name2);*) name1 = name2 (*Var names differ, but there is no assumption, so this can't be good*) -let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> - List.map (fun x -> match x with (first, second) -> "(" ^ first ^ " -> " ^ second ^ ")") |> - String.concat ", ") ^ "]" - let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods) = rename_mapping in - let local_string = string_tuple_to_string (List.of_seq (Hashtbl.to_seq local)) in + let local_string = [%show: (string * string) list] (List.of_seq (Hashtbl.to_seq local)) in let methods_string: string = List.of_seq (Hashtbl.to_seq_values methods) |> List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ - "; renamed_params=" ^ string_tuple_to_string (List.of_seq (Hashtbl.to_seq parameter_renames)) ^ ")") |> + "; renamed_params=" ^ [%show: (string * string) list] (List.of_seq (Hashtbl.to_seq parameter_renames)) ^ ")") |> String.concat ", " in "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "])" From 8b28e892257fc473331fd57da797775f752237ca Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:52:56 +0200 Subject: [PATCH 045/518] Hashtbl.add is now replaced by Hashtbl.replace in many places. --- src/incremental/compareCIL.ml | 52 +++++++++++++++++------------------ 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 77fd210f73..197f61e123 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -41,21 +41,21 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo if (List.length a.slocals) = (List.length b.slocals) then List.combine a.slocals b.slocals |> - List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> - List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); + List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> + List.iter (fun pair -> match pair with (a, b) -> Hashtbl.replace local_rename_map a b); (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a rename_mapping, holding the rename assumptions *) let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: (string, string) Hashtbl.t) = match alocals, blocals with - | [], [] -> true, rename_mapping - | origLocal :: als, nowLocal :: bls -> - if origLocal.vname <> nowLocal.vname then Hashtbl.add rename_mapping origLocal.vname nowLocal.vname; + | [], [] -> true, rename_mapping + | origLocal :: als, nowLocal :: bls -> + if origLocal.vname <> nowLocal.vname then Hashtbl.replace rename_mapping origLocal.vname nowLocal.vname; - (*TODO: maybe optimize this with eq_varinfo*) - rename_mapping_aware_compare als bls rename_mapping - | _, _ -> false, rename_mapping - in + (*TODO: maybe optimize this with eq_varinfo*) + rename_mapping_aware_compare als bls rename_mapping + | _, _ -> false, rename_mapping + in let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (Hashtbl.create 0) in let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in @@ -104,22 +104,22 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let old_global = GlobalMap.find ident map in match old_global, global with - | GFun(f, _), GFun (g, _) -> - let renamed_params: (string, string) Hashtbl.t = if (List.length f.sformals) = (List.length g.sformals) then + | GFun(f, _), GFun (g, _) -> + let renamed_params: (string, string) Hashtbl.t = if (List.length f.sformals) = (List.length g.sformals) then List.combine f.sformals g.sformals |> List.filter (fun (original, now) -> not (original.vname = now.vname)) |> List.map (fun (original, now) -> (original.vname, now.vname)) |> - (fun list -> - let table: (string, string) Hashtbl.t = Hashtbl.create (List.length list) in - List.iter (fun mapping -> Hashtbl.add table (fst mapping) (snd mapping)) list; - table + (fun list -> + let table: (string, string) Hashtbl.t = Hashtbl.create (List.length list) in + List.iter (fun mapping -> Hashtbl.add table (fst mapping) (snd mapping)) list; + table ) else Hashtbl.create 0 in - if not (f.svar.vname = g.svar.vname) || (Hashtbl.length renamed_params) > 0 then - Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} - else None - | _, _ -> None + if not (f.svar.vname = g.svar.vname) || (Hashtbl.length renamed_params) > 0 then + Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} + else None + | _, _ -> None with Not_found -> None in @@ -158,15 +158,15 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in let global_rename_mapping: method_rename_assumptions = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> - match generate_global_rename_mapping oldMap global with + match generate_global_rename_mapping oldMap global with | Some rename_mapping -> current_global_rename_mapping @ [rename_mapping] | None -> current_global_rename_mapping - ) [] |> - (fun mappings -> - let table = Hashtbl.create (List.length mappings) in - List.iter (fun mapping -> Hashtbl.add table mapping.original_method_name mapping) mappings; - table - ) in + ) [] |> + (fun mappings -> + let table = Hashtbl.create (List.length mappings) in + List.iter (fun mapping -> Hashtbl.replace table mapping.original_method_name mapping) mappings; + table + ) in (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) From 77bd92632fca62725fe90bd16b89e95741b4061e Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:55:21 +0200 Subject: [PATCH 046/518] List optimization. --- src/incremental/compareCIL.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 197f61e123..780bfaccf3 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -159,7 +159,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let global_rename_mapping: method_rename_assumptions = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> match generate_global_rename_mapping oldMap global with - | Some rename_mapping -> current_global_rename_mapping @ [rename_mapping] + | Some rename_mapping -> rename_mapping::current_global_rename_mapping | None -> current_global_rename_mapping ) [] |> (fun mappings -> From 938fcb0bc02943ceef3cc3d0f128dd9b7b15ad8a Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Fri, 17 Jun 2022 15:50:16 +0200 Subject: [PATCH 047/518] Removed compinfo and enum rename hack from compareAST and replaced it with a functional alternative --- src/incremental/compareAST.ml | 56 ++++++++++++++++------- src/incremental/compareCIL.ml | 5 +- src/incremental/compareGlobals.ml | 12 ++--- src/incremental/detectRenamedFunctions.ml | 35 ++++++++++---- src/incremental/updateCil.ml | 2 + 5 files changed, 78 insertions(+), 32 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 598bc03418..4e017707d8 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -21,16 +21,19 @@ type method_rename_assumption = {original_method_name: string; new_method_name: type method_rename_assumptions = method_rename_assumption StringMap.t type glob_var_rename_assumptions = string VarinfoMap.t +(*On a successful match, these compinfo and enuminfo names have to be set to the snd element of the tuple. *) +type renamesOnSuccess = (compinfo * compinfo) list * (enuminfo * enuminfo) list + (*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type rename_mapping = (string StringMap.t) * (method_rename_assumptions) * glob_var_rename_assumptions +type rename_mapping = (string StringMap.t) * (method_rename_assumptions) * glob_var_rename_assumptions * renamesOnSuccess -let emptyRenameMapping = (StringMap.empty, StringMap.empty, VarinfoMap.empty) +let emptyRenameMapping: rename_mapping = (StringMap.empty, StringMap.empty, VarinfoMap.empty, ([], [])) (*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) 2. there is no rename for name1 -> name1 = name2*) let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = - let (local_c, method_c, _) = rename_mapping in + let (local_c, method_c, _, _) = rename_mapping in let existingAssumption: string option = StringMap.find_opt name1 local_c in match existingAssumption with @@ -57,7 +60,7 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> String.concat ", ") ^ "]" let rename_mapping_to_string (rename_mapping: rename_mapping) = - let (local, methods, glob_vars) = rename_mapping in + let (local, methods, glob_vars, _) = rename_mapping in let local_string = string_tuple_to_string (List.of_seq (StringMap.to_seq local)) in let methods_string: string = List.of_seq (StringMap.to_seq methods |> Seq.map snd) |> List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> @@ -139,6 +142,21 @@ and mem_typ_acc (a: typ) (b: typ) acc = List.exists (fun p -> match p with (x, y and pretty_length () l = Pretty.num (List.length l) and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename_mapping) : bool * rename_mapping = + (* Registers a compinfo rename or a enum rename*) + let register_rename_on_success = fun rename_mapping compinfo_option enum_option -> + let maybeAddTuple = fun list option -> + Option.value ~default:list (Option.bind option (fun elem -> Some(elem :: list))) + in + + let (a, b, c, renames_on_success) = rename_mapping in + let (compinfoRenames, enumRenames) = renames_on_success in + + let updatedCompinfoRenames = maybeAddTuple compinfoRenames compinfo_option in + let updatedEnumRenames = maybeAddTuple enumRenames enum_option in + + a, b, c, (updatedCompinfoRenames, updatedEnumRenames) + in + if Messages.tracing then Messages.tracei "compareast" "eq_typ_acc %a vs %a (%a, %a)\n" d_type a d_type b pretty_length acc pretty_length !global_typ_acc; (* %a makes List.length calls lazy if compareast isn't being traced *) let r, updated_rename_mapping = match a, b with | TPtr (typ1, attr1), TPtr (typ2, attr2) -> @@ -167,16 +185,22 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename else ( let acc = (a, b) :: acc in let (res, rm) = eq_compinfo compinfo1 compinfo2 acc rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 in - if res && compinfo1.cname <> compinfo2.cname then - compinfo2.cname <- compinfo1.cname; + let updated_rm: rename_mapping = if res && compinfo1.cname <> compinfo2.cname then + (* This renaming now only takes place when the comparison was successful.*) + (*compinfo2.cname <- compinfo1.cname;*) + + register_rename_on_success rm (Some((compinfo2, compinfo1))) None + else rm + in if res then global_typ_acc := (a, b) :: !global_typ_acc; - res, rm + res, updated_rm ) | TEnum (enuminfo1, attr1), TEnum (enuminfo2, attr2) -> let (res, rm) = eq_enuminfo enuminfo1 enuminfo2 rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 in - (if res && enuminfo1.ename <> enuminfo2.ename then enuminfo2.ename <- enuminfo1.ename); - res, rm + if res && enuminfo1.ename <> enuminfo2.ename then + res, register_rename_on_success rm None (Some((enuminfo2, enuminfo1))) + else res, rm | TBuiltin_va_list attr1, TBuiltin_va_list attr2 -> forward_list_equal eq_attribute attr1 attr2 rename_mapping | TVoid attr1, TVoid attr2 -> forward_list_equal eq_attribute attr1 attr2 rename_mapping | TInt (ik1, attr1), TInt (ik2, attr2) -> (ik1 = ik2, rename_mapping) &&>> forward_list_equal eq_attribute attr1 attr2 @@ -232,7 +256,7 @@ and eq_varinfo2 (rename_mapping: rename_mapping) (a: varinfo) (b: varinfo) = eq_ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool * rename_mapping = (*Printf.printf "Comp %s with %s\n" a.vname b.vname;*) - let (locals_renames, method_rename_mappings, glob_vars) = rename_mapping in + let (locals_renames, method_rename_mappings, glob_vars, renames_on_success) = rename_mapping in let compare_local_and_global_var = let is_local = StringMap.mem a.vname locals_renames in @@ -288,8 +312,8 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool match new_locals with | Some locals -> - (locals.parameter_renames, updated_method_rename_mappings, updatedGlobVarMapping) - | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) + (locals.parameter_renames, updated_method_rename_mappings, updatedGlobVarMapping, renames_on_success) + | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping, renames_on_success) ) (*| GVar (_, _, _) -> ( let new_local = VarinfoMap.find_opt a glob_vars in @@ -298,13 +322,13 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool | Some now_name -> (StringMap.add a.vname now_name StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) )*) - | _ -> (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping) + | _ -> (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping, renames_on_success) in - (*Ignore rename mapping for type check, as it doesn't change anyway*) - let (typeCheck, _) = eq_typ a.vtype b.vtype typ_rename_mapping in + (*Ignore rename mapping for type check, as it doesn't change anyway. We only need the renames_on_success*) + let (typeCheck, (_, _, _, updated_renames_on_success)) = eq_typ a.vtype b.vtype typ_rename_mapping in - (isNamingOk && typeCheck, (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping)) &&>> + (isNamingOk && typeCheck, (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping, updated_renames_on_success)) &&>> forward_list_equal eq_attribute a.vattr b.vattr &&> (a.vstorage = b.vstorage) &&> (a.vglob = b.vglob) &&> (a.vaddrof = b.vaddrof) (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 0deca77de2..7acb59b258 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -9,7 +9,10 @@ let empty_change_info () : change_info = {added = []; removed = []; changed = [] let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt, _, _ = CompareGlobals.eqF f g cfgs StringMap.empty VarinfoMap.empty in + let identical, unchangedHeader, diffOpt, _, _, renamesOnSuccess = CompareGlobals.eqF f g cfgs StringMap.empty VarinfoMap.empty in + (*Perform renames no matter what.*) + let _ = performRenames renamesOnSuccess in + identical, unchangedHeader, diffOpt | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y emptyRenameMapping |> fst, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml index 76a98bd58e..cac98eefda 100644 --- a/src/incremental/compareGlobals.ml +++ b/src/incremental/compareGlobals.ml @@ -56,18 +56,18 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo in let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in - let actHeaderRenameMapping = (headerRenameMapping, global_function_rename_mapping, global_var_rename_mapping) in + let actHeaderRenameMapping: rename_mapping = (headerRenameMapping, global_function_rename_mapping, global_var_rename_mapping, ([], [])) in - let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> forward_list_equal eq_varinfo a.sformals b.sformals in - let identical, diffOpt, (_, renamed_method_dependencies, renamed_global_vars_dependencies) = + let (unchangedHeader, (_, _, _, renamesOnSuccessHeader)) = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> forward_list_equal eq_varinfo a.sformals b.sformals in + let identical, diffOpt, (_, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess) = if should_reanalyze a then false, None, emptyRenameMapping else (* Here the local variables are checked to be equal *) let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in - let rename_mapping: rename_mapping = (local_rename, global_function_rename_mapping, global_var_rename_mapping) in + let rename_mapping: rename_mapping = (local_rename, global_function_rename_mapping, global_var_rename_mapping, renamesOnSuccessHeader) in - let sameDef = unchangedHeader &&> sizeEqual |> fst in + let sameDef = unchangedHeader && sizeEqual in if not sameDef then (false, None, emptyRenameMapping) else @@ -82,4 +82,4 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo if diffNodes1 = [] then (true, None, emptyRenameMapping) else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, emptyRenameMapping) in - identical, unchangedHeader |> fst, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies + identical, unchangedHeader, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 44f64f6d5c..f0fc490257 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -64,6 +64,12 @@ let getFunctionAndGVarMap (ast: file) : f StringMap.t * v StringMap.t = | _ -> functionMap, gvarMap ) (StringMap.empty, StringMap.empty) +let performRenames (renamesOnSuccess: renamesOnSuccess) = + begin + let (compinfoRenames, enumRenames) = renamesOnSuccess in + List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname) compinfoRenames; + List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; + end let getDependencies fromEq = StringMap.map (fun assumption -> assumption.new_method_name) fromEq @@ -119,7 +125,12 @@ let registerGVarMapping oldV nowV data = { (*returns true iff for all dependencies it is true, that the dependency has a corresponding function with the new name and matches the without having dependencies itself and the new name is not already present on the old AST. *) -let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_dependencies: glob_var_rename_assumptions) (oldFunctionMap: f StringMap.t) (nowFunctionMap: f StringMap.t) (oldGVarMap: v StringMap.t) (nowGVarMap: v StringMap.t) (data: carryType) : bool * carryType = +let doAllDependenciesMatch (dependencies: functionDependencies) +(global_var_dependencies: glob_var_rename_assumptions) +(oldFunctionMap: f StringMap.t) +(nowFunctionMap: f StringMap.t) +(oldGVarMap: v StringMap.t) +(nowGVarMap: v StringMap.t) (data: carryType) : bool * carryType = let isConsistent = fun old nowName allEqual getName getGlobal oldMap nowMap getNowOption data -> (*Early cutoff if a previous dependency returned false. @@ -143,23 +154,24 @@ let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_depe let compare = fun old now -> match (old, now) with | Fundec(oF), Fundec(nF) -> - let doMatch, _, _, function_dependencies, global_var_dependencies = CompareGlobals.eqF oF nF None StringMap.empty VarinfoMap.empty in - doMatch, function_dependencies, global_var_dependencies + let doMatch, _, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF oF nF None StringMap.empty VarinfoMap.empty in + doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess | GlobalVar(oV), GlobalVar(nV) -> - let (equal, (_, function_dependencies, global_var_dependencies)) = eq_varinfo oV nV emptyRenameMapping in + let (equal, (_, function_dependencies, global_var_dependencies, renamesOnSuccess)) = eq_varinfo oV nV emptyRenameMapping in (*eq_varinfo always comes back with a self dependency. We need to filter that out.*) - equal, function_dependencies, (VarinfoMap.filter (fun vi name -> not (vi.vname = oV.vname && name = nowName)) global_var_dependencies) + equal, function_dependencies, (VarinfoMap.filter (fun vi name -> not (vi.vname = oV.vname && name = nowName)) global_var_dependencies), renamesOnSuccess | _, _ -> failwith "Unknown or incompatible global types" in - let doMatch, function_dependencies, global_var_dependencies = compare globalElem nowElem in + let doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess = compare globalElem nowElem in (*let _ = Printf.printf "%s <-> %s: %b %b %b\n" (getName old) (globalElemName nowElem) doMatch (StringMap.is_empty function_dependencies) (VarinfoMap.is_empty global_var_dependencies) in let _ = Printf.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in *) if doMatch && StringMap.is_empty function_dependencies && VarinfoMap.is_empty global_var_dependencies then + let _ = performRenames renamesOnSuccess in true, registerMapping globalElem nowElem data else false, data @@ -228,13 +240,18 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap. match matchingNewFundec with | Some (newFun, _) -> (*Compare if they are similar*) - let doMatch, unchangedHeader, _, function_dependencies, global_var_dependencies = + let doMatch, unchangedHeader, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f newFun None StringMap.empty VarinfoMap.empty in - let _ = Pretty.printf "%s <-> %s: %b %s\n" f.svar.vname newFun.svar.vname doMatch (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in + (*Before renamesOnSuccess, functions with the same name have always been compared. + In this comparison, the renaming on compinfo and enum was always performed, no matter if the comparison + was a success or not. This call mimics this behaviour.*) + let _ = performRenames renamesOnSuccess in + + (*let _ = Pretty.printf "%s <-> %s: %b %s\n" f.svar.vname newFun.svar.vname doMatch (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in let _ = Pretty.printf "old locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) f.slocals)) in - let _ = Pretty.printf "now locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) newFun.slocals)) in + let _ = Pretty.printf "now locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) newFun.slocals)) in*) let actDependencies = getDependencies function_dependencies in diff --git a/src/incremental/updateCil.ml b/src/incremental/updateCil.ml index aa2df5447a..5aa756804a 100644 --- a/src/incremental/updateCil.ml +++ b/src/incremental/updateCil.ml @@ -42,6 +42,7 @@ let update_ids (old_file: file) (ids: max_ids) (new_file: file) (changes: change target.svar <- src.svar; in let reset_fun (f: fundec) (old_f: fundec) = + old_f.svar.vname <- f.svar.vname; f.svar.vid <- old_f.svar.vid; List.iter2 (fun l o_l -> l.vid <- o_l.vid; o_l.vname <- l.vname) f.slocals old_f.slocals; List.iter2 (fun lo o_f -> lo.vid <- o_f.vid) f.sformals old_f.sformals; @@ -58,6 +59,7 @@ let update_ids (old_file: file) (ids: max_ids) (new_file: file) (changes: change in let reset_var (v: varinfo) (old_v: varinfo)= v.vid <- old_v.vid; + old_v.vname <- v.vname; update_vid_max v.vid; in let reset_globals (glob: unchanged_global) = From 7371dc97fb56692403273856c200c42204f16381 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 20 Jun 2022 15:32:25 +0200 Subject: [PATCH 048/518] method_rename_assumptions now uses varinfo map instead of string hashtable. --- src/incremental/compareAST.ml | 61 ++++++++++++++++++----------------- src/incremental/compareCFG.ml | 7 ++-- src/incremental/compareCIL.ml | 50 +++++++++++++--------------- src/util/cilMaps.ml | 11 +++++++ 4 files changed, 70 insertions(+), 59 deletions(-) create mode 100644 src/util/cilMaps.ml diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 42e019b86d..e8e17d8f97 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -1,22 +1,25 @@ open Cil +open CilMaps (* global_type and global_t are implicitly used by GlobalMap to keep GVarDecl apart from GVar and GFun, so do not remove! *) type global_type = Fun | Decl | Var and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] -type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: (string, string) Hashtbl.t} -type method_rename_assumptions = (string, method_rename_assumption) Hashtbl.t +module StringMap = Map.Make(String) + +type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: string StringMap.t} +type method_rename_assumptions = method_rename_assumption VarinfoMap.t (*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type rename_mapping = ((string, string) Hashtbl.t) * (method_rename_assumptions) +type rename_mapping = (string StringMap.t) * (method_rename_assumptions) (*Compares two names, being aware of the rename_mapping. Returns true iff: - 1. there is a rename for name1 -> name2 = rename(name1) - 2. there is no rename for name1 -> name1 = name2*) + 1. there is a rename for name1 -> name2 = rename(name1) + 2. there is no rename for name1 -> name1 = name2*) let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = let (local_c, method_c) = rename_mapping in - let existingAssumption: string option = Hashtbl.find_opt local_c name1 in + let existingAssumption: string option = StringMap.find_opt name1 local_c in match existingAssumption with | Some now -> @@ -28,12 +31,12 @@ let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods) = rename_mapping in - let local_string = [%show: (string * string) list] (List.of_seq (Hashtbl.to_seq local)) in - let methods_string: string = List.of_seq (Hashtbl.to_seq_values methods) |> - List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> - "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ - "; renamed_params=" ^ [%show: (string * string) list] (List.of_seq (Hashtbl.to_seq parameter_renames)) ^ ")") |> - String.concat ", " in + let local_string = [%show: (string * string) list] (List.of_seq (StringMap.to_seq local)) in + let methods_string: string = List.of_seq (VarinfoMap.to_seq methods |> Seq.map snd) |> + List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> + "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ + "; renamed_params=" ^ [%show: (string * string) list] (List.of_seq (StringMap.to_seq parameter_renames)) ^ ")") |> + String.concat ", " in "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "])" let identifier_of_global glob = @@ -101,7 +104,7 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_args rename_mapping acc) list1 list2 && varArg1 = varArg2 && - GobList.equal (eq_attribute rename_mapping) attr1 attr2 + GobList.equal (eq_attribute rename_mapping) attr1 attr2 | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping && varArg1 = varArg2 && GobList.equal (eq_attribute rename_mapping) attr1 attr2 @@ -147,7 +150,7 @@ and eq_enuminfo (a: enuminfo) (b: enuminfo) (rename_mapping: rename_mapping) = and eq_args (rename_mapping: rename_mapping) (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) = match a, b with (name1, typ1, attr1), (name2, typ2, attr2) -> - rename_mapping_aware_name_comparison name1 name2 rename_mapping && eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 + rename_mapping_aware_name_comparison name1 name2 rename_mapping && eq_typ_acc typ1 typ2 acc rename_mapping && GobList.equal (eq_attribute rename_mapping) attr1 attr2 and eq_attrparam (rename_mapping: rename_mapping) (a: attrparam) (b: attrparam) = match a, b with | ACons (str1, attrparams1), ACons (str2, attrparams2) -> str1 = str2 && GobList.equal (eq_attrparam rename_mapping) attrparams1 attrparams2 @@ -179,37 +182,37 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) = (*When we compare function names, we can directly compare the naming from the rename_mapping if it exists.*) let isNamingOk = match b.vtype with | TFun(_, _, _, _) -> ( - let specific_method_rename_mapping = Hashtbl.find_opt method_rename_mappings a.vname in + let specific_method_rename_mapping = VarinfoMap.find_opt a method_rename_mappings in match specific_method_rename_mapping with - | Some method_rename_mapping -> method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname - | None -> a.vname = b.vname + | Some method_rename_mapping -> method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname + | None -> a.vname = b.vname ) | _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping - in + in (*If the following is a method call, we need to check if we have a mapping for that method call. *) let typ_rename_mapping = match b.vtype with - | TFun(_, _, _, _) -> ( - let new_locals = Hashtbl.find_opt method_rename_mappings a.vname in + | TFun(_, _, _, _) -> ( + let new_locals = VarinfoMap.find_opt a method_rename_mappings in match new_locals with - | Some locals -> - (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) - (locals.parameter_renames, method_rename_mappings) - | None -> (Hashtbl.create 0, method_rename_mappings) - ) - | _ -> rename_mapping - in + | Some locals -> + (*Printf.printf "Performing rename_mapping switch. New rename_mapping=%s\n" (rename_mapping_to_string (locals.parameter_renames, method_rename_mappings));*) + (locals.parameter_renames, method_rename_mappings) + | None -> (StringMap.empty, method_rename_mappings) + ) + | _ -> rename_mapping + in let typeCheck = eq_typ a.vtype b.vtype typ_rename_mapping in let attrCheck = GobList.equal (eq_attribute rename_mapping) a.vattr b.vattr in - (*let _ = if isNamingOk then a.vname <- b.vname in*) + (*let _ = if isNamingOk then a.vname <- b.vname in*) (*let _ = Printf.printf "Comparing vars: %s = %s\n" a.vname b.vname in *) (*a.vname = b.vname*) let result = isNamingOk && typeCheck && attrCheck && - a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in + a.vstorage = b.vstorage && a.vglob = b.vglob && a.vaddrof = b.vaddrof in result (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 4557cb88b3..78a182a291 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -1,10 +1,11 @@ open MyCFG open Queue open Cil +open CilMaps include CompareAST let eq_node (x, fun1) (y, fun2) = - let empty_rename_mapping: rename_mapping = (Hashtbl.create 0, Hashtbl.create 0) in + let empty_rename_mapping: rename_mapping = (StringMap.empty, VarinfoMap.empty) in match x,y with | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping @@ -12,8 +13,8 @@ let eq_node (x, fun1) (y, fun2) = | _ -> false (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) -let eq_edge x y = - let empty_rename_mapping: rename_mapping = (Hashtbl.create 0, Hashtbl.create 0) in +let eq_edge x y = + let empty_rename_mapping: rename_mapping = (StringMap.empty, VarinfoMap.empty) in match x, y with | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping && eq_exp rv1 rv2 empty_rename_mapping | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping && GobList.equal (eq_exp2 empty_rename_mapping) ars1 ars2 diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 780bfaccf3..474cbcb5b3 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -1,5 +1,6 @@ open Cil open MyCFG +open CilMaps include CompareAST include CompareCFG @@ -47,17 +48,17 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a rename_mapping, holding the rename assumptions *) - let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: (string, string) Hashtbl.t) = match alocals, blocals with + let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: string StringMap.t) = match alocals, blocals with | [], [] -> true, rename_mapping | origLocal :: als, nowLocal :: bls -> - if origLocal.vname <> nowLocal.vname then Hashtbl.replace rename_mapping origLocal.vname nowLocal.vname; + let new_mapping = StringMap.add origLocal.vname nowLocal.vname rename_mapping in (*TODO: maybe optimize this with eq_varinfo*) - rename_mapping_aware_compare als bls rename_mapping + rename_mapping_aware_compare als bls new_mapping | _, _ -> false, rename_mapping in - let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (Hashtbl.create 0) in + let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in let actHeaderRenameMapping = (headerRenameMapping, global_rename_mapping) in let unchangedHeader = eq_varinfo a.svar b.svar actHeaderRenameMapping && GobList.equal (eq_varinfo2 actHeaderRenameMapping) a.sformals b.sformals in @@ -89,8 +90,8 @@ let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) (global_ let identical, unchangedHeader, diffOpt = eqF f g cfgs global_rename_mapping in identical, unchangedHeader, diffOpt - | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (Hashtbl.create 0, Hashtbl.create 0), false, None + | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y (StringMap.empty, VarinfoMap.empty), false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) + | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y (StringMap.empty, VarinfoMap.empty), false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = @@ -105,19 +106,18 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = match old_global, global with | GFun(f, _), GFun (g, _) -> - let renamed_params: (string, string) Hashtbl.t = if (List.length f.sformals) = (List.length g.sformals) then - List.combine f.sformals g.sformals |> - List.filter (fun (original, now) -> not (original.vname = now.vname)) |> - List.map (fun (original, now) -> (original.vname, now.vname)) |> - (fun list -> - let table: (string, string) Hashtbl.t = Hashtbl.create (List.length list) in - List.iter (fun mapping -> Hashtbl.add table (fst mapping) (snd mapping)) list; - table - ) - else Hashtbl.create 0 in - - if not (f.svar.vname = g.svar.vname) || (Hashtbl.length renamed_params) > 0 then - Some {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params} + let renamed_params: string StringMap.t = if (List.length f.sformals) = (List.length g.sformals) then + let mappings = List.combine f.sformals g.sformals |> + List.filter (fun (original, now) -> not (original.vname = now.vname)) |> + List.map (fun (original, now) -> (original.vname, now.vname)) |> + List.to_seq + in + + StringMap.add_seq mappings StringMap.empty + else StringMap.empty in + + if not (f.svar.vname = g.svar.vname) || (StringMap.cardinal renamed_params) > 0 then + Some (f.svar, {original_method_name=f.svar.vname; new_method_name=g.svar.vname; parameter_renames=renamed_params}) else None | _, _ -> None with Not_found -> None @@ -157,16 +157,12 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in - let global_rename_mapping: method_rename_assumptions = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption list) global -> + let global_rename_mapping: method_rename_assumptions = Cil.foldGlobals newAST (fun (current_global_rename_mapping: method_rename_assumption VarinfoMap.t) global -> match generate_global_rename_mapping oldMap global with - | Some rename_mapping -> rename_mapping::current_global_rename_mapping + | Some (funVar, rename_mapping) -> VarinfoMap.add funVar rename_mapping current_global_rename_mapping | None -> current_global_rename_mapping - ) [] |> - (fun mappings -> - let table = Hashtbl.create (List.length mappings) in - List.iter (fun mapping -> Hashtbl.replace table mapping.original_method_name mapping) mappings; - table - ) in + ) VarinfoMap.empty + in (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) diff --git a/src/util/cilMaps.ml b/src/util/cilMaps.ml new file mode 100644 index 0000000000..d776020fc2 --- /dev/null +++ b/src/util/cilMaps.ml @@ -0,0 +1,11 @@ +open Cil + +module VarinfoOrdered = struct + type t = varinfo + + (*x.svar.uid cannot be used, as they may overlap between old and now AST*) + let compare (x: varinfo) (y: varinfo) = String.compare x.vname y.vname +end + + +module VarinfoMap = Map.Make(VarinfoOrdered) From 7b320c993fd001d480d279a5d796b483fb50303b Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 20 Jun 2022 16:03:23 +0200 Subject: [PATCH 049/518] Removed RenameMapping. --- src/analyses/apron/apronAnalysis.apron.ml | 2 +- src/analyses/arinc.ml | 14 ++-- src/analyses/spec.ml | 2 +- src/cdomains/basetype.ml | 4 +- src/cdomains/lval.ml | 4 +- src/cdomains/symbLocksDomain.ml | 2 +- src/framework/analyses.ml | 14 ++-- src/framework/constraints.ml | 6 +- src/framework/node.ml | 16 ++-- src/incremental/renameMapping.ml | 94 ----------------------- 10 files changed, 32 insertions(+), 126 deletions(-) delete mode 100644 src/incremental/renameMapping.ml diff --git a/src/analyses/apron/apronAnalysis.apron.ml b/src/analyses/apron/apronAnalysis.apron.ml index 3dacf59ab6..09b86e9615 100644 --- a/src/analyses/apron/apronAnalysis.apron.ml +++ b/src/analyses/apron/apronAnalysis.apron.ml @@ -146,7 +146,7 @@ struct if !GU.global_initialization && e = MyCFG.unknown_exp then st (* ignore extern inits because there's no body before assign, so the apron env is empty... *) else ( - if M.tracing then M.traceli "apron" "assign %a = %a\n" RenameMapping.d_lval lv d_exp e; + if M.tracing then M.traceli "apron" "assign %a = %a\n" d_lval lv d_exp e; let ask = Analyses.ask_of_ctx ctx in let r = assign_to_global_wrapper ask ctx.global ctx.sideg st lv (fun st v -> assign_from_globals_wrapper ask ctx.global st e (fun apr' e' -> diff --git a/src/analyses/arinc.ml b/src/analyses/arinc.ml index 79974d8434..8397e8d63e 100644 --- a/src/analyses/arinc.ml +++ b/src/analyses/arinc.ml @@ -137,7 +137,7 @@ struct let return_code_is_success z = Cilint.is_zero_cilint z || Cilint.compare_cilint z Cilint.one_cilint = 0 let str_return_code i = if return_code_is_success i then "SUCCESS" else "ERROR" let str_return_dlval (v,o as dlval) = - sprint RenameMapping.d_lval (Lval.CilLval.to_lval dlval) ^ "_" ^ string_of_int v.vdecl.line |> + sprint d_lval (Lval.CilLval.to_lval dlval) ^ "_" ^ string_of_int v.vdecl.line |> Str.global_replace (Str.regexp "[^a-zA-Z0-9]") "_" let add_return_dlval env kind dlval = ArincUtil.add_return_var env.procid kind (str_return_dlval dlval) @@ -152,17 +152,17 @@ struct | a when not (Queries.LS.is_top a) && Queries.LS.cardinal a > 0 -> let top_elt = (dummyFunDec.svar, `NoOffset) in let a' = if Queries.LS.mem top_elt a then ( - M.debug "mayPointTo: query result for %a contains TOP!" RenameMapping.d_exp exp; (* UNSOUND *) + M.debug "mayPointTo: query result for %a contains TOP!" d_exp exp; (* UNSOUND *) Queries.LS.remove top_elt a ) else a in Queries.LS.elements a' | v -> - M.debug "mayPointTo: query result for %a is %a" RenameMapping.d_exp exp Queries.LS.pretty v; + M.debug "mayPointTo: query result for %a is %a" d_exp exp Queries.LS.pretty v; (*failwith "mayPointTo"*) [] let iterMayPointTo ctx exp f = mayPointTo ctx exp |> List.iter f - let debugMayPointTo ctx exp = M.debug "%a mayPointTo %a" RenameMapping.d_exp exp (Pretty.d_list ", " Lval.CilLval.pretty) (mayPointTo ctx exp) + let debugMayPointTo ctx exp = M.debug "%a mayPointTo %a" d_exp exp (Pretty.d_list ", " Lval.CilLval.pretty) (mayPointTo ctx exp) (* transfer functions *) @@ -184,7 +184,7 @@ struct let edges_added = ref false in let f dlval = (* M.debug @@ "assign: MayPointTo " ^ sprint d_plainlval lval ^ ": " ^ sprint d_plainexp (Lval.CilLval.to_exp dlval); *) - let is_ret_type = try is_return_code_type @@ Lval.CilLval.to_exp dlval with Cilfacade.TypeOfError Index_NonArray -> M.debug "assign: Cilfacade.typeOf %a threw exception Errormsg.Error \"Bug: typeOffset: Index on a non-array\". Will assume this is a return type to remain sound." RenameMapping.d_exp (Lval.CilLval.to_exp dlval); true in + let is_ret_type = try is_return_code_type @@ Lval.CilLval.to_exp dlval with Cilfacade.TypeOfError Index_NonArray -> M.debug "assign: Cilfacade.typeOf %a threw exception Errormsg.Error \"Bug: typeOffset: Index on a non-array\". Will assume this is a return type to remain sound." d_exp (Lval.CilLval.to_exp dlval); true in if (not is_ret_type) || Lval.CilLval.has_index dlval then () else let dlval = global_dlval dlval "assign" in edges_added := true; @@ -320,7 +320,7 @@ struct let is_creating_fun = startsWith (Functions.prefix^"Create") f.vname in if M.tracing && is_arinc_fun then ( (* M.tracel "arinc" "found %s(%s)\n" f.vname args_str *) - M.debug "found %s(%a) in %s" f.vname (Pretty.d_list ", " RenameMapping.d_exp) arglist env.fundec.svar.vname + M.debug "found %s(%a) in %s" f.vname (Pretty.d_list ", " d_exp) arglist env.fundec.svar.vname ); let is_error_handler = env.pname = pname_ErrorHandler in let eval_int exp = @@ -339,7 +339,7 @@ struct (* call assign for all analyses (we only need base)! *) | AddrOf lval -> ctx.emit (Assign {lval; exp = mkAddrOf @@ var id}) (* TODO not needed for the given code, but we could use Queries.MayPointTo exp in this case *) - | _ -> failwith @@ "Could not assign id. Expected &id. Found "^sprint RenameMapping.d_exp exp + | _ -> failwith @@ "Could not assign id. Expected &id. Found "^sprint d_exp exp in let assign_id_by_name resource_type name id = assign_id id (get_id (resource_type, eval_str name)) diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml index 9fcfd7bb61..38be505f5d 100644 --- a/src/analyses/spec.ml +++ b/src/analyses/spec.ml @@ -256,7 +256,7 @@ struct D.warn @@ "changed pointer "^D.string_of_key k1^" (no longer safe)"; (* saveOpened ~unknown:true k1 *) m |> D.unknown k1 | _ -> (* no change in D for other things *) - M.debug "assign (none in D): %a = %a [%a]" RenameMapping.d_lval lval d_exp rval d_plainexp rval; + M.debug "assign (none in D): %a = %a [%a]" d_lval lval d_exp rval d_plainexp rval; m (* diff --git a/src/cdomains/basetype.ml b/src/cdomains/basetype.ml index 263e61f130..d2c5f2b3be 100644 --- a/src/cdomains/basetype.ml +++ b/src/cdomains/basetype.ml @@ -26,8 +26,8 @@ struct let show x = if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo x then let description = RichVarinfo.BiVarinfoMap.Collection.describe_varinfo x in - "(" ^ RenameMapping.show_varinfo x ^ ", " ^ description ^ ")" - else RenameMapping.show_varinfo x + "(" ^ x.vname ^ ", " ^ description ^ ")" + else x.vname let pretty () x = Pretty.text (show x) type group = Global | Local | Parameter | Temp [@@deriving show { with_path = false }] let (%) = Batteries.(%) diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 6d10606f26..d13cbe9f93 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -223,8 +223,8 @@ struct let short_addr (x, o) = if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo x then let description = RichVarinfo.BiVarinfoMap.Collection.describe_varinfo x in - "(" ^ RenameMapping.show_varinfo x ^ ", " ^ description ^ ")" ^ short_offs o - else RenameMapping.show_varinfo x ^ short_offs o + "(" ^ x.vname ^ ", " ^ description ^ ")" ^ short_offs o + else x.vname ^ short_offs o let show = function | Addr (x, o)-> short_addr (x, o) diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index 454b7c666e..1471749871 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -184,7 +184,7 @@ struct let ee_to_str x = match x with - | EVar v -> RenameMapping.show_varinfo v + | EVar v -> v.vname | EAddr -> "&" | EDeref -> "*" | EField f -> f.fname diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 5a8a1f51c9..63e149ef7a 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -31,7 +31,7 @@ struct let printXml f n = let l = Node.location n in - BatPrintf.fprintf f "\n" (Node.show_id n) l.file (RenameMapping.show_varinfo (Node.find_fundec n).svar) l.line l.byte l.column + BatPrintf.fprintf f "\n" (Node.show_id n) l.file (Node.find_fundec n).svar.vname l.line l.byte l.column let var_id = Node.show_id end @@ -105,7 +105,7 @@ struct See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) let x = UpdateCil.getLoc a in let f = Node.find_fundec a in - CilType.Location.show x ^ "(" ^ RenameMapping.show_varinfo f.svar ^ ")" + CilType.Location.show x ^ "(" ^ f.svar.vname ^ ")" include Printable.SimpleShow ( struct @@ -179,9 +179,9 @@ struct let module SH = BatHashtbl.Make (Basetype.RawStrings) in let file2funs = SH.create 100 in let funs2node = SH.create 100 in - iter (fun n _ -> SH.add funs2node (RenameMapping.show_varinfo (Node.find_fundec n).svar) n) (Lazy.force table); + iter (fun n _ -> SH.add funs2node (Node.find_fundec n).svar.vname n) (Lazy.force table); iterGlobals file (function - | GFun (fd,loc) -> SH.add file2funs loc.file (RenameMapping.show_varinfo fd.svar) + | GFun (fd,loc) -> SH.add file2funs loc.file fd.svar.vname | _ -> () ); let p_node f n = BatPrintf.fprintf f "%s" (Node.show_id n) in @@ -227,9 +227,9 @@ struct let module SH = BatHashtbl.Make (Basetype.RawStrings) in let file2funs = SH.create 100 in let funs2node = SH.create 100 in - iter (fun n _ -> SH.add funs2node (RenameMapping.show_varinfo (Node.find_fundec n).svar) n) (Lazy.force table); + iter (fun n _ -> SH.add funs2node (Node.find_fundec n).svar.vname n) (Lazy.force table); iterGlobals file (function - | GFun (fd,loc) -> SH.add file2funs loc.file (RenameMapping.show_varinfo fd.svar) + | GFun (fd,loc) -> SH.add file2funs loc.file fd.svar.vname | _ -> () ); let p_enum p f xs = BatEnum.print ~first:"[\n " ~last:"\n]" ~sep:",\n " p f xs in @@ -519,7 +519,7 @@ struct your analysis to be path sensitive, do override this. To obtain a behavior where all paths are kept apart, set this to D.equal x y *) - let call_descr f _ = RenameMapping.show_varinfo f.svar + let call_descr f _ = f.svar.vname (* prettier name for equation variables --- currently base can do this and MCP just forwards it to Base.*) diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index aac3e5b644..209f89423e 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -363,7 +363,7 @@ struct if ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.context.widen" ~keepAttr:"widen" ~removeAttr:"no-widen" f then ( let v_old = M.find f.svar m in (* S.D.bot () if not found *) let v_new = S.D.widen v_old (S.D.join v_old v_cur) in - Messages.(if tracing && not (S.D.equal v_old v_new) then tracel "widen-context" "enter results in new context for function %s\n" (RenameMapping.show_varinfo f.svar)); + Messages.(if tracing && not (S.D.equal v_old v_new) then tracel "widen-context" "enter results in new context for function %s\n" f.svar.vname); v_new, M.add f.svar v_new m ) else @@ -501,7 +501,7 @@ struct ignore (getl (Function fd, c)) | exception Not_found -> (* unknown function *) - M.error ~category:Imprecise ~tags:[Category Unsound] "Created a thread from unknown function %s" (RenameMapping.show_varinfo f) + M.error ~category:Imprecise ~tags:[Category Unsound] "Created a thread from unknown function %s" f.vname (* actual implementation (e.g. invalidation) is done by threadenter *) ) ds in @@ -631,7 +631,7 @@ struct let one_function f = match Cilfacade.find_varinfo_fundec f with | fd when LibraryFunctions.use_special f.vname -> - M.warn "Using special for defined function %s" (RenameMapping.show_varinfo f); + M.warn "Using special for defined function %s" f.vname; tf_special_call ctx lv f args | fd -> tf_normal_call ctx lv e fd args getl sidel getg sideg diff --git a/src/framework/node.ml b/src/framework/node.ml index cc1d32a018..84f8dea1ea 100644 --- a/src/framework/node.ml +++ b/src/framework/node.ml @@ -22,21 +22,21 @@ let name () = "node" (** Pretty node plainly with entire stmt. *) let pretty_plain () = function | Statement s -> text "Statement " ++ dn_stmt () s - | Function f -> text "Function " ++ text (RenameMapping.show_varinfo f.svar) - | FunctionEntry f -> text "FunctionEntry " ++ text (RenameMapping.show_varinfo f.svar) + | Function f -> text "Function " ++ text (f.svar.vname) + | FunctionEntry f -> text "FunctionEntry " ++ text (f.svar.vname) (* TODO: remove this? *) (** Pretty node plainly with stmt location. *) let pretty_plain_short () = function | Statement s -> text "Statement @ " ++ CilType.Location.pretty () (Cilfacade.get_stmtLoc s) - | Function f -> text "Function " ++ text (RenameMapping.show_varinfo f.svar) - | FunctionEntry f -> text "FunctionEntry " ++ text (RenameMapping.show_varinfo f.svar) + | Function f -> text "Function " ++ text (f.svar.vname) + | FunctionEntry f -> text "FunctionEntry " ++ text (f.svar.vname) (** Pretty node for solver variable tracing with short stmt. *) let pretty_trace () = function | Statement stmt -> dprintf "node %d \"%a\"" stmt.sid Cilfacade.stmt_pretty_short stmt - | Function fd -> dprintf "call of %s" (RenameMapping.show_varinfo fd.svar) - | FunctionEntry fd -> dprintf "entry state of %s" (RenameMapping.show_varinfo fd.svar) + | Function fd -> dprintf "call of %s" (fd.svar.vname) + | FunctionEntry fd -> dprintf "entry state of %s" (fd.svar.vname) (** Output functions for Printable interface *) let pretty () x = pretty_trace () x @@ -56,8 +56,8 @@ let show_id = function (** Show node label for CFG. *) let show_cfg = function | Statement stmt -> string_of_int stmt.sid (* doesn't use this but defaults to no label and uses ID from show_id instead *) - | Function fd -> "return of " ^ (RenameMapping.show_varinfo fd.svar) ^ "()" - | FunctionEntry fd -> (RenameMapping.show_varinfo fd.svar) ^ "()" + | Function fd -> "return of " ^ (fd.svar.vname) ^ "()" + | FunctionEntry fd -> (fd.svar.vname) ^ "()" let location (node: t) = diff --git a/src/incremental/renameMapping.ml b/src/incremental/renameMapping.ml deleted file mode 100644 index e3f332e555..0000000000 --- a/src/incremental/renameMapping.ml +++ /dev/null @@ -1,94 +0,0 @@ -open Cil - -(* - This file remembers which varinfos were renamed in the process of incremental analysis. - If the functions of this file are used to pretty print varinfos and their names, the correct updated name - will be shown instead of the old varinfo name that was used when the analysis result was created. - - The rename entries are filled up by CompareAST.ml while the comparison takes place. -*) - -module IncrementallyUpdatedVarinfoMap = Hashtbl.Make (CilType.Varinfo) - -(*Mapps a varinfo to its updated name*) -let renamedVarinfoMap: string IncrementallyUpdatedVarinfoMap.t ref = ref (IncrementallyUpdatedVarinfoMap.create 100) - -let get_old_or_updated_varinfo_name (old_varinfo: varinfo) = - let r: string option = IncrementallyUpdatedVarinfoMap.find_opt !renamedVarinfoMap old_varinfo in - Option.value r ~default:old_varinfo.vname - -let store_update_varinfo_name (old_varinfo: varinfo) (new_name: string) = - IncrementallyUpdatedVarinfoMap.add !renamedVarinfoMap old_varinfo new_name - -(* - Incremental rename aware version of show. Returns the renamed name of the varinfo if it has been updated by an incremental build, or vname if nothing has changed. - - Dev Note: Putting this into CilType.Varinfo results in a cyclic dependency. It should not be put into CilType anyway, as CilType only defines types based on the types themselves, not implement any logic based on other components outside its own definitions. So I think it's cleaner this way. -*) -let show_varinfo = get_old_or_updated_varinfo_name - -(*in original Cil v.vname is hardcoded*) -let pVDeclImpl () (v:varinfo) (pType) (pAttrs) = - (* First the storage modifiers *) - Pretty.(text (if v.vinline then "__inline " else "") - ++ d_storage () v.vstorage - ++ (pType (Some (Pretty.text (show_varinfo v))) () v.vtype) - ++ Pretty.text " " - ++ pAttrs () v.vattr) - -class incremental_printer : Cil.cilPrinter = object(self) - inherit Cil.defaultCilPrinterClass - method! pVar (v:varinfo) = Pretty.text (show_varinfo v) - - (* variable declaration *) - method! pVDecl () (v:varinfo) = pVDeclImpl () v self#pType self#pAttrs -end;; - -class plain_incremental_printer : Cil.cilPrinter = object(self) - inherit Cil.plainCilPrinterClass - method! pVar (v:varinfo) = Pretty.text (show_varinfo v) - - method! pVDecl () (v:varinfo) = pVDeclImpl () v self#pType self#pAttrs -end;; - -let incremental_aware_printer = new incremental_printer -let plain_incremental_aware_printer = new plain_incremental_printer - -let d_exp () e = printExp incremental_aware_printer () e - -let d_lval () l = printLval incremental_aware_printer () l - -let d_stmt () s = printStmt incremental_aware_printer () s - -(* A hack to allow forward reference of d_exp. Copy from Cil. *) -let pd_exp : (unit -> exp -> Pretty.doc) ref = - ref (fun _ -> failwith "") - -let _ = pd_exp := d_exp - -let pd_lval : (unit -> lval -> Pretty.doc) ref = ref (fun _ -> failwith "") -let _ = pd_lval := d_lval - -let pd_stmt : (unit -> stmt -> Pretty.doc) ref = ref (fun _ -> failwith "") -let _ = pd_stmt := d_stmt - -(*Fixme: Im a copy of Cil.dn_obj but Cil.dn_obj is not exported. So export Cil.dn_obj and then replace me.*) -let dn_obj (func: unit -> 'a -> Pretty.doc) : (unit -> 'a -> Pretty.doc) = - begin - (* construct the closure to return *) - let theFunc () (obj:'a) : Pretty.doc = - begin - let prevStyle = !lineDirectiveStyle in - lineDirectiveStyle := None; - let ret = (func () obj) in (* call underlying printer *) - lineDirectiveStyle := prevStyle; - ret - end in - theFunc - end - -let dn_exp = (dn_obj d_exp) - -let dn_lval = (dn_obj d_lval) - -let dn_stmt = (dn_obj d_stmt) \ No newline at end of file From 18938a393a3fb068a7249de541996a254ceb56b4 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 21 Jun 2022 11:45:21 +0200 Subject: [PATCH 050/518] Fixed crash in forward_list_equal on lists with altering list lengths. --- src/incremental/compareAST.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 95af1f37ca..cb9163c11a 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -88,7 +88,9 @@ let (&&>) (prev_result: bool * rename_mapping) (b: bool) : bool * rename_mapping (*Same as Goblist.eq but propagates the rename_mapping*) let forward_list_equal f l1 l2 (prev_result: rename_mapping) : bool * rename_mapping = - List.fold_left2 (fun (b, r) x y -> if b then f x y r else (b, r)) (true, prev_result) l1 l2 + if ((List.compare_lengths l1 l2) = 0) then + List.fold_left2 (fun (b, r) x y -> if b then f x y r else (b, r)) (true, prev_result) l1 l2 + else false, prev_result (* hack: CIL generates new type names for anonymous types - we want to ignore these *) let compare_name (a: string) (b: string) = @@ -181,7 +183,7 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename (*compinfo2.cname <- compinfo1.cname;*) register_rename_on_success rm (Some((compinfo2, compinfo1))) None - else rm + else rm in if res then global_typ_acc := (a, b) :: !global_typ_acc; From 40281fe99685a1ed446a3b7b6d402ff63134c44f Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 21 Jun 2022 13:50:15 +0200 Subject: [PATCH 051/518] Added documentation to tests in 04-var-rename --- .../04-var-rename/01-unused_rename.txt | 3 +++ .../04-var-rename/02-rename_and_shuffle.txt | 2 ++ .../04-var-rename/03-rename_with_usage.txt | 2 ++ .../04-var-rename/04-renamed_assert.txt | 2 ++ .../04-var-rename/05-renamed_param.txt | 2 ++ .../06-renamed_param_usage_changed.txt | 2 ++ .../incremental/04-var-rename/07-method_rename.c | 10 ---------- .../04-var-rename/07-method_rename.json | 3 --- .../04-var-rename/07-method_rename.patch | 15 --------------- .../04-var-rename/diffs/04-renamed_assert.c | 4 ++-- .../04-var-rename/diffs/07-method_rename.c | 10 ---------- 11 files changed, 15 insertions(+), 40 deletions(-) create mode 100644 tests/incremental/04-var-rename/01-unused_rename.txt create mode 100644 tests/incremental/04-var-rename/02-rename_and_shuffle.txt create mode 100644 tests/incremental/04-var-rename/03-rename_with_usage.txt create mode 100644 tests/incremental/04-var-rename/04-renamed_assert.txt create mode 100644 tests/incremental/04-var-rename/05-renamed_param.txt create mode 100644 tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt delete mode 100644 tests/incremental/04-var-rename/07-method_rename.c delete mode 100644 tests/incremental/04-var-rename/07-method_rename.json delete mode 100644 tests/incremental/04-var-rename/07-method_rename.patch delete mode 100644 tests/incremental/04-var-rename/diffs/07-method_rename.c diff --git a/tests/incremental/04-var-rename/01-unused_rename.txt b/tests/incremental/04-var-rename/01-unused_rename.txt new file mode 100644 index 0000000000..a317916ad1 --- /dev/null +++ b/tests/incremental/04-var-rename/01-unused_rename.txt @@ -0,0 +1,3 @@ +local variable a is renamed to b. +a/b is not used. +No semantic changes. diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.txt b/tests/incremental/04-var-rename/02-rename_and_shuffle.txt new file mode 100644 index 0000000000..8c0ab5ac05 --- /dev/null +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.txt @@ -0,0 +1,2 @@ +a is renamed to c, but the usage of a is replaced by b. +Semantic changes. diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.txt b/tests/incremental/04-var-rename/03-rename_with_usage.txt new file mode 100644 index 0000000000..18ff7e94d4 --- /dev/null +++ b/tests/incremental/04-var-rename/03-rename_with_usage.txt @@ -0,0 +1,2 @@ +a is renamed to c, but the usage stays the same. +No semantic changes. diff --git a/tests/incremental/04-var-rename/04-renamed_assert.txt b/tests/incremental/04-var-rename/04-renamed_assert.txt new file mode 100644 index 0000000000..1afc289347 --- /dev/null +++ b/tests/incremental/04-var-rename/04-renamed_assert.txt @@ -0,0 +1,2 @@ +local var used in assert is renamed. +No semantic changes. diff --git a/tests/incremental/04-var-rename/05-renamed_param.txt b/tests/incremental/04-var-rename/05-renamed_param.txt new file mode 100644 index 0000000000..09bca47979 --- /dev/null +++ b/tests/incremental/04-var-rename/05-renamed_param.txt @@ -0,0 +1,2 @@ +Function param is renamed. +No semantic changes. diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt new file mode 100644 index 0000000000..0dc90594c7 --- /dev/null +++ b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt @@ -0,0 +1,2 @@ +function parameters a and b and swapped in the function header. But the function body stays the same. +Semantic changes. diff --git a/tests/incremental/04-var-rename/07-method_rename.c b/tests/incremental/04-var-rename/07-method_rename.c deleted file mode 100644 index 84ce2d8621..0000000000 --- a/tests/incremental/04-var-rename/07-method_rename.c +++ /dev/null @@ -1,10 +0,0 @@ -//Method is renamed with all of its usages. Test should say no changes. - -int foo() { - return 12; -} - -int main() { - foo(); - return 0; -} diff --git a/tests/incremental/04-var-rename/07-method_rename.json b/tests/incremental/04-var-rename/07-method_rename.json deleted file mode 100644 index 544b7b4ddd..0000000000 --- a/tests/incremental/04-var-rename/07-method_rename.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/07-method_rename.patch b/tests/incremental/04-var-rename/07-method_rename.patch deleted file mode 100644 index e55d61e986..0000000000 --- a/tests/incremental/04-var-rename/07-method_rename.patch +++ /dev/null @@ -1,15 +0,0 @@ ---- tests/incremental/04-var-rename/07-method_rename.c -+++ tests/incremental/04-var-rename/07-method_rename.c -@@ -1,10 +1,10 @@ - //Method is renamed with all of its usages. Test should say no changes. - --int foo() { -+int bar() { - return 12; - } - - int main() { -- foo(); -+ bar(); - return 0; - } diff --git a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c index 642609580c..ef95920fd5 100644 --- a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c +++ b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c @@ -2,8 +2,8 @@ int main() { int j = 0; - + assert(j < 11); return 0; -} \ No newline at end of file +} diff --git a/tests/incremental/04-var-rename/diffs/07-method_rename.c b/tests/incremental/04-var-rename/diffs/07-method_rename.c deleted file mode 100644 index 0d6c2aa9b9..0000000000 --- a/tests/incremental/04-var-rename/diffs/07-method_rename.c +++ /dev/null @@ -1,10 +0,0 @@ -//Method is renamed with all of its usages. Test should say no changes. - -int bar() { - return 12; -} - -int main() { - bar(); - return 0; -} From 60468d43e5f0e175c9a412f81d1039e8a5fd84a9 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:07:27 +0200 Subject: [PATCH 052/518] Add comment to test-incremental-multiple.sh --- scripts/test-incremental-multiple.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/scripts/test-incremental-multiple.sh b/scripts/test-incremental-multiple.sh index a910e8498a..0dee9c117d 100644 --- a/scripts/test-incremental-multiple.sh +++ b/scripts/test-incremental-multiple.sh @@ -1,3 +1,4 @@ +#This file runs 3 incremental tests in total. As such it is similar to test-incremental.sh but performs an additional incremental run on top of it. test=$1 base=./tests/incremental From a9d297cb7b852bc9f7acd9a19f738cf4edc43edc Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 22 Jun 2022 11:14:53 +0200 Subject: [PATCH 053/518] Removed syntactic noise introduced by addition and removal of RenameMapping --- src/cdomains/baseDomain.ml | 2 +- src/framework/analyses.ml | 1 - src/framework/node.ml | 16 ++++++++-------- src/util/cilType.ml | 1 - 4 files changed, 9 insertions(+), 11 deletions(-) diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml index 2002a1e1a4..35daecaf01 100644 --- a/src/cdomains/baseDomain.ml +++ b/src/cdomains/baseDomain.ml @@ -115,7 +115,7 @@ struct let printXml f r = let e = XmlUtil.escape in BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n\n%s\n\n%a\n\n" - (e @@ (CPA.name ())) CPA.printXml r.cpa + (e @@ CPA.name ()) CPA.printXml r.cpa (e @@ PartDeps.name ()) PartDeps.printXml r.deps (e @@ WeakUpdates.name ()) WeakUpdates.printXml r.weak (e @@ PrivD.name ()) PrivD.printXml r.priv diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 63e149ef7a..f2b99a68e4 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -140,7 +140,6 @@ struct (* Not using Node.location here to have updated locations in incremental analysis. See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) let loc = UpdateCil.getLoc n in - BatPrintf.fprintf f "\n" (Node.show_id n) loc.file loc.line loc.byte loc.column; BatPrintf.fprintf f "%a\n" Range.printXml v in diff --git a/src/framework/node.ml b/src/framework/node.ml index 84f8dea1ea..1d5a8291f9 100644 --- a/src/framework/node.ml +++ b/src/framework/node.ml @@ -22,21 +22,21 @@ let name () = "node" (** Pretty node plainly with entire stmt. *) let pretty_plain () = function | Statement s -> text "Statement " ++ dn_stmt () s - | Function f -> text "Function " ++ text (f.svar.vname) - | FunctionEntry f -> text "FunctionEntry " ++ text (f.svar.vname) + | Function f -> text "Function " ++ text f.svar.vname + | FunctionEntry f -> text "FunctionEntry " ++ text f.svar.vname (* TODO: remove this? *) (** Pretty node plainly with stmt location. *) let pretty_plain_short () = function | Statement s -> text "Statement @ " ++ CilType.Location.pretty () (Cilfacade.get_stmtLoc s) - | Function f -> text "Function " ++ text (f.svar.vname) - | FunctionEntry f -> text "FunctionEntry " ++ text (f.svar.vname) + | Function f -> text "Function " ++ text f.svar.vname + | FunctionEntry f -> text "FunctionEntry " ++ text f.svar.vname (** Pretty node for solver variable tracing with short stmt. *) let pretty_trace () = function | Statement stmt -> dprintf "node %d \"%a\"" stmt.sid Cilfacade.stmt_pretty_short stmt - | Function fd -> dprintf "call of %s" (fd.svar.vname) - | FunctionEntry fd -> dprintf "entry state of %s" (fd.svar.vname) + | Function fd -> dprintf "call of %s" fd.svar.vname + | FunctionEntry fd -> dprintf "entry state of %s" fd.svar.vname (** Output functions for Printable interface *) let pretty () x = pretty_trace () x @@ -56,8 +56,8 @@ let show_id = function (** Show node label for CFG. *) let show_cfg = function | Statement stmt -> string_of_int stmt.sid (* doesn't use this but defaults to no label and uses ID from show_id instead *) - | Function fd -> "return of " ^ (fd.svar.vname) ^ "()" - | FunctionEntry fd -> (fd.svar.vname) ^ "()" + | Function fd -> "return of " ^ fd.svar.vname ^ "()" + | FunctionEntry fd -> fd.svar.vname ^ "()" let location (node: t) = diff --git a/src/util/cilType.ml b/src/util/cilType.ml index bd714c31e8..16b3ad75fe 100644 --- a/src/util/cilType.ml +++ b/src/util/cilType.ml @@ -117,7 +117,6 @@ struct let show = show end ) - let pp fmt x = Format.fprintf fmt "%s" x.vname (* for deriving show *) end From 31283c9aafb2e002e8d34bcc7d18dec2e0161b12 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 22 Jun 2022 11:16:25 +0200 Subject: [PATCH 054/518] Removed diffs directory in tests/incremental/04-var-rename --- .../04-var-rename/diffs/01-unused_rename.c | 4 ---- .../diffs/02-rename_and_shuffle.c | 11 ----------- .../04-var-rename/diffs/03-rename_with_usage.c | 11 ----------- .../04-var-rename/diffs/04-renamed_assert.c | 9 --------- .../04-var-rename/diffs/05-renamed_param.c | 8 -------- .../diffs/06-renamed_param_usage_changed.c | 11 ----------- .../diffs/08-2_incremental_runs_2.c | 8 -------- .../diffs/08-2_incremental_runs_3.c | 8 -------- .../diffs/09-2_ir_with_changes_2.c | 18 ------------------ .../diffs/09-2_ir_with_changes_3.c | 18 ------------------ 10 files changed, 106 deletions(-) delete mode 100644 tests/incremental/04-var-rename/diffs/01-unused_rename.c delete mode 100644 tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c delete mode 100644 tests/incremental/04-var-rename/diffs/03-rename_with_usage.c delete mode 100644 tests/incremental/04-var-rename/diffs/04-renamed_assert.c delete mode 100644 tests/incremental/04-var-rename/diffs/05-renamed_param.c delete mode 100644 tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c delete mode 100644 tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c delete mode 100644 tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c delete mode 100644 tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c delete mode 100644 tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c diff --git a/tests/incremental/04-var-rename/diffs/01-unused_rename.c b/tests/incremental/04-var-rename/diffs/01-unused_rename.c deleted file mode 100644 index 1fbd3f6638..0000000000 --- a/tests/incremental/04-var-rename/diffs/01-unused_rename.c +++ /dev/null @@ -1,4 +0,0 @@ -int main() { - int b = 0; - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c b/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c deleted file mode 100644 index eb54a5c0aa..0000000000 --- a/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c +++ /dev/null @@ -1,11 +0,0 @@ -#include - -//a is renamed to c, but the usage of a is replaced by b -int main() { - int c = 0; - int b = 1; - - printf("Print %d", b); - - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c b/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c deleted file mode 100644 index 4676e03447..0000000000 --- a/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c +++ /dev/null @@ -1,11 +0,0 @@ -#include - -//a is renamed to c, but its usages stay the same -int main() { - int c = 0; - int b = 1; - - printf("Print %d", c); - - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c deleted file mode 100644 index ef95920fd5..0000000000 --- a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c +++ /dev/null @@ -1,9 +0,0 @@ -#include - -int main() { - int j = 0; - - assert(j < 11); - - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/05-renamed_param.c b/tests/incremental/04-var-rename/diffs/05-renamed_param.c deleted file mode 100644 index 198bd82496..0000000000 --- a/tests/incremental/04-var-rename/diffs/05-renamed_param.c +++ /dev/null @@ -1,8 +0,0 @@ -void method(int b) { - int c = b; -} - -int main() { - method(0); - return 0; -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c b/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c deleted file mode 100644 index 0bf42f645e..0000000000 --- a/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c +++ /dev/null @@ -1,11 +0,0 @@ -//This test should mark foo and main as changed - -void foo(int b, int a) { - int x = a; - int y = b; -} - -int main() { - foo(3, 4); - return 0; -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c b/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c deleted file mode 100644 index 43205a976e..0000000000 --- a/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c +++ /dev/null @@ -1,8 +0,0 @@ -int main() { - int varSecondIteration = 0; - - varSecondIteration++; - - assert(varSecondIteration < 10); - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c b/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c deleted file mode 100644 index 9ff7105ebb..0000000000 --- a/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c +++ /dev/null @@ -1,8 +0,0 @@ -int main() { - int varThirdIteration = 0; - - varThirdIteration++; - - assert(varThirdIteration < 10); - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c b/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c deleted file mode 100644 index 6c4f789066..0000000000 --- a/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c +++ /dev/null @@ -1,18 +0,0 @@ -void foo() { - int fooTwo = 1; - fooTwo++; - assert(fooTwo == 2); -} - -void bar() { - int barTwo = 10; - int x = 3; - if (x < 11) barTwo = 13; - assert(x > 1); -} - -int main() { - foo(); - bar(); - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c b/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c deleted file mode 100644 index eaf77e72d1..0000000000 --- a/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c +++ /dev/null @@ -1,18 +0,0 @@ -void foo() { - int fooThree = 1; - fooThree++; - assert(fooThree == 2); -} - -void bar() { - int barTwo = 10; - int x = 3; - if (x < 11) barTwo = 13; - assert(x > 1); -} - -int main() { - foo(); - bar(); - return 0; -} From f04651b20e72343f761f6f449686f8ad82f023c6 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 22 Jun 2022 11:16:25 +0200 Subject: [PATCH 055/518] Removed diffs directory in tests/incremental/04-var-rename --- .../04-var-rename/diffs/01-unused_rename.c | 4 ---- .../diffs/02-rename_and_shuffle.c | 11 ----------- .../04-var-rename/diffs/03-rename_with_usage.c | 11 ----------- .../04-var-rename/diffs/04-renamed_assert.c | 7 ------- .../04-var-rename/diffs/05-renamed_param.c | 8 -------- .../diffs/06-renamed_param_usage_changed.c | 11 ----------- .../diffs/08-2_incremental_runs_2.c | 8 -------- .../diffs/08-2_incremental_runs_3.c | 8 -------- .../diffs/09-2_ir_with_changes_2.c | 18 ------------------ .../diffs/09-2_ir_with_changes_3.c | 18 ------------------ 10 files changed, 104 deletions(-) delete mode 100644 tests/incremental/04-var-rename/diffs/01-unused_rename.c delete mode 100644 tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c delete mode 100644 tests/incremental/04-var-rename/diffs/03-rename_with_usage.c delete mode 100644 tests/incremental/04-var-rename/diffs/04-renamed_assert.c delete mode 100644 tests/incremental/04-var-rename/diffs/05-renamed_param.c delete mode 100644 tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c delete mode 100644 tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c delete mode 100644 tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c delete mode 100644 tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c delete mode 100644 tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c diff --git a/tests/incremental/04-var-rename/diffs/01-unused_rename.c b/tests/incremental/04-var-rename/diffs/01-unused_rename.c deleted file mode 100644 index 1fbd3f6638..0000000000 --- a/tests/incremental/04-var-rename/diffs/01-unused_rename.c +++ /dev/null @@ -1,4 +0,0 @@ -int main() { - int b = 0; - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c b/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c deleted file mode 100644 index eb54a5c0aa..0000000000 --- a/tests/incremental/04-var-rename/diffs/02-rename_and_shuffle.c +++ /dev/null @@ -1,11 +0,0 @@ -#include - -//a is renamed to c, but the usage of a is replaced by b -int main() { - int c = 0; - int b = 1; - - printf("Print %d", b); - - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c b/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c deleted file mode 100644 index 4676e03447..0000000000 --- a/tests/incremental/04-var-rename/diffs/03-rename_with_usage.c +++ /dev/null @@ -1,11 +0,0 @@ -#include - -//a is renamed to c, but its usages stay the same -int main() { - int c = 0; - int b = 1; - - printf("Print %d", c); - - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c deleted file mode 100644 index 8f74e36a13..0000000000 --- a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c +++ /dev/null @@ -1,7 +0,0 @@ -int main() { - int j = 0; - - assert(j < 11); - - return 0; -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/05-renamed_param.c b/tests/incremental/04-var-rename/diffs/05-renamed_param.c deleted file mode 100644 index 198bd82496..0000000000 --- a/tests/incremental/04-var-rename/diffs/05-renamed_param.c +++ /dev/null @@ -1,8 +0,0 @@ -void method(int b) { - int c = b; -} - -int main() { - method(0); - return 0; -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c b/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c deleted file mode 100644 index 0bf42f645e..0000000000 --- a/tests/incremental/04-var-rename/diffs/06-renamed_param_usage_changed.c +++ /dev/null @@ -1,11 +0,0 @@ -//This test should mark foo and main as changed - -void foo(int b, int a) { - int x = a; - int y = b; -} - -int main() { - foo(3, 4); - return 0; -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c b/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c deleted file mode 100644 index 43205a976e..0000000000 --- a/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_2.c +++ /dev/null @@ -1,8 +0,0 @@ -int main() { - int varSecondIteration = 0; - - varSecondIteration++; - - assert(varSecondIteration < 10); - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c b/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c deleted file mode 100644 index 9ff7105ebb..0000000000 --- a/tests/incremental/04-var-rename/diffs/08-2_incremental_runs_3.c +++ /dev/null @@ -1,8 +0,0 @@ -int main() { - int varThirdIteration = 0; - - varThirdIteration++; - - assert(varThirdIteration < 10); - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c b/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c deleted file mode 100644 index 6c4f789066..0000000000 --- a/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_2.c +++ /dev/null @@ -1,18 +0,0 @@ -void foo() { - int fooTwo = 1; - fooTwo++; - assert(fooTwo == 2); -} - -void bar() { - int barTwo = 10; - int x = 3; - if (x < 11) barTwo = 13; - assert(x > 1); -} - -int main() { - foo(); - bar(); - return 0; -} diff --git a/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c b/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c deleted file mode 100644 index eaf77e72d1..0000000000 --- a/tests/incremental/04-var-rename/diffs/09-2_ir_with_changes_3.c +++ /dev/null @@ -1,18 +0,0 @@ -void foo() { - int fooThree = 1; - fooThree++; - assert(fooThree == 2); -} - -void bar() { - int barTwo = 10; - int x = 3; - if (x < 11) barTwo = 13; - assert(x > 1); -} - -int main() { - foo(); - bar(); - return 0; -} From 4d8098e84f3a373ced44940f27d33a1a59a83052 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 15 Jun 2022 13:07:27 +0200 Subject: [PATCH 056/518] Add comment to test-incremental-multiple.sh --- scripts/test-incremental-multiple.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/scripts/test-incremental-multiple.sh b/scripts/test-incremental-multiple.sh index 87b7e150ce..eb0dbd9128 100644 --- a/scripts/test-incremental-multiple.sh +++ b/scripts/test-incremental-multiple.sh @@ -1,3 +1,4 @@ +#This file runs 3 incremental tests in total. As such it is similar to test-incremental.sh but performs an additional incremental run on top of it. test=$1 base=./tests/incremental From 45350394dbda2535f216023d00841e0eb99e62a5 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 21 Jun 2022 13:50:15 +0200 Subject: [PATCH 057/518] Added documentation to tests in 04-var-rename --- .../04-var-rename/01-unused_rename.txt | 3 +++ .../04-var-rename/02-rename_and_shuffle.txt | 2 ++ .../04-var-rename/03-rename_with_usage.txt | 2 ++ .../04-var-rename/04-renamed_assert.txt | 2 ++ .../04-var-rename/05-renamed_param.txt | 2 ++ .../06-renamed_param_usage_changed.txt | 2 ++ .../incremental/04-var-rename/07-method_rename.c | 10 ---------- .../04-var-rename/07-method_rename.json | 3 --- .../04-var-rename/07-method_rename.patch | 15 --------------- .../04-var-rename/diffs/04-renamed_assert.c | 9 +++++++++ .../04-var-rename/diffs/07-method_rename.c | 10 ---------- 11 files changed, 22 insertions(+), 38 deletions(-) create mode 100644 tests/incremental/04-var-rename/01-unused_rename.txt create mode 100644 tests/incremental/04-var-rename/02-rename_and_shuffle.txt create mode 100644 tests/incremental/04-var-rename/03-rename_with_usage.txt create mode 100644 tests/incremental/04-var-rename/04-renamed_assert.txt create mode 100644 tests/incremental/04-var-rename/05-renamed_param.txt create mode 100644 tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt delete mode 100644 tests/incremental/04-var-rename/07-method_rename.c delete mode 100644 tests/incremental/04-var-rename/07-method_rename.json delete mode 100644 tests/incremental/04-var-rename/07-method_rename.patch create mode 100644 tests/incremental/04-var-rename/diffs/04-renamed_assert.c delete mode 100644 tests/incremental/04-var-rename/diffs/07-method_rename.c diff --git a/tests/incremental/04-var-rename/01-unused_rename.txt b/tests/incremental/04-var-rename/01-unused_rename.txt new file mode 100644 index 0000000000..a317916ad1 --- /dev/null +++ b/tests/incremental/04-var-rename/01-unused_rename.txt @@ -0,0 +1,3 @@ +local variable a is renamed to b. +a/b is not used. +No semantic changes. diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.txt b/tests/incremental/04-var-rename/02-rename_and_shuffle.txt new file mode 100644 index 0000000000..8c0ab5ac05 --- /dev/null +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.txt @@ -0,0 +1,2 @@ +a is renamed to c, but the usage of a is replaced by b. +Semantic changes. diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.txt b/tests/incremental/04-var-rename/03-rename_with_usage.txt new file mode 100644 index 0000000000..18ff7e94d4 --- /dev/null +++ b/tests/incremental/04-var-rename/03-rename_with_usage.txt @@ -0,0 +1,2 @@ +a is renamed to c, but the usage stays the same. +No semantic changes. diff --git a/tests/incremental/04-var-rename/04-renamed_assert.txt b/tests/incremental/04-var-rename/04-renamed_assert.txt new file mode 100644 index 0000000000..1afc289347 --- /dev/null +++ b/tests/incremental/04-var-rename/04-renamed_assert.txt @@ -0,0 +1,2 @@ +local var used in assert is renamed. +No semantic changes. diff --git a/tests/incremental/04-var-rename/05-renamed_param.txt b/tests/incremental/04-var-rename/05-renamed_param.txt new file mode 100644 index 0000000000..09bca47979 --- /dev/null +++ b/tests/incremental/04-var-rename/05-renamed_param.txt @@ -0,0 +1,2 @@ +Function param is renamed. +No semantic changes. diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt new file mode 100644 index 0000000000..0dc90594c7 --- /dev/null +++ b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt @@ -0,0 +1,2 @@ +function parameters a and b and swapped in the function header. But the function body stays the same. +Semantic changes. diff --git a/tests/incremental/04-var-rename/07-method_rename.c b/tests/incremental/04-var-rename/07-method_rename.c deleted file mode 100644 index 84ce2d8621..0000000000 --- a/tests/incremental/04-var-rename/07-method_rename.c +++ /dev/null @@ -1,10 +0,0 @@ -//Method is renamed with all of its usages. Test should say no changes. - -int foo() { - return 12; -} - -int main() { - foo(); - return 0; -} diff --git a/tests/incremental/04-var-rename/07-method_rename.json b/tests/incremental/04-var-rename/07-method_rename.json deleted file mode 100644 index 544b7b4ddd..0000000000 --- a/tests/incremental/04-var-rename/07-method_rename.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/07-method_rename.patch b/tests/incremental/04-var-rename/07-method_rename.patch deleted file mode 100644 index e55d61e986..0000000000 --- a/tests/incremental/04-var-rename/07-method_rename.patch +++ /dev/null @@ -1,15 +0,0 @@ ---- tests/incremental/04-var-rename/07-method_rename.c -+++ tests/incremental/04-var-rename/07-method_rename.c -@@ -1,10 +1,10 @@ - //Method is renamed with all of its usages. Test should say no changes. - --int foo() { -+int bar() { - return 12; - } - - int main() { -- foo(); -+ bar(); - return 0; - } diff --git a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c new file mode 100644 index 0000000000..ef95920fd5 --- /dev/null +++ b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c @@ -0,0 +1,9 @@ +#include + +int main() { + int j = 0; + + assert(j < 11); + + return 0; +} diff --git a/tests/incremental/04-var-rename/diffs/07-method_rename.c b/tests/incremental/04-var-rename/diffs/07-method_rename.c deleted file mode 100644 index 0d6c2aa9b9..0000000000 --- a/tests/incremental/04-var-rename/diffs/07-method_rename.c +++ /dev/null @@ -1,10 +0,0 @@ -//Method is renamed with all of its usages. Test should say no changes. - -int bar() { - return 12; -} - -int main() { - bar(); - return 0; -} From 55133d21e47e914cfb93727cc79089dc10f16f7a Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 22 Jun 2022 14:55:21 +0200 Subject: [PATCH 058/518] Replaced printf with tracing in compareCIL --- src/incremental/compareCIL.ml | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index d65bff45a0..ea59d48a1c 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -61,21 +61,23 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let renameDetectionResults = detectRenamedFunctions oldAST newAST in - GlobalElemMap.to_seq renameDetectionResults |> - Seq.iter - (fun (gT, (functionGlobal, status)) -> - Printf.printf "Function status of %s is=" (globalElemName gT); - match status with - | Unchanged _ -> Printf.printf "Same Name\n"; - | Added -> Printf.printf "Added\n"; - | Removed -> Printf.printf "Removed\n"; - | Changed _ -> Printf.printf "Changed\n"; - | UnchangedButRenamed toFrom -> - match toFrom with - | GFun (f, _) -> Printf.printf "Renamed to %s\n" f.svar.vname; - | GVar(v, _, _) -> Printf.printf "Renamed to %s\n" v.vname; - | _ -> Printf.printf "TODO"; - ); + + if Messages.tracing then + GlobalElemMap.to_seq renameDetectionResults |> + Seq.iter + (fun (gT, (functionGlobal, status)) -> + Messages.trace "compareCIL" "Function status of %s is=" (globalElemName gT); + match status with + | Unchanged _ -> Messages.trace "compareCIL" "Same Name\n"; + | Added -> Messages.trace "compareCIL" "Added\n"; + | Removed -> Messages.trace "compareCIL" "Removed\n"; + | Changed _ -> Messages.trace "compareCIL" "Changed\n"; + | UnchangedButRenamed toFrom -> + match toFrom with + | GFun (f, _) -> Messages.trace "compareCIL" "Renamed to %s\n" f.svar.vname; + | GVar(v, _, _) -> Messages.trace "compareCIL" "Renamed to %s\n" v.vname; + | _ -> (); + ); (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) From 51590ee7763e5fd7cbb0a9051df6457d9a539cbc Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Fri, 1 Jul 2022 17:57:04 +0200 Subject: [PATCH 059/518] Removed parameter renames and instead disabled the name checking for function parameters on function parameters. --- src/incremental/compareAST.ml | 61 +++++++------------ src/incremental/compareGlobals.ml | 8 --- .../04-var-rename/diffs/04-renamed_assert.c | 9 --- 3 files changed, 22 insertions(+), 56 deletions(-) delete mode 100644 tests/incremental/04-var-rename/diffs/04-renamed_assert.c diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index cb9163c11a..e6d310eeac 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -8,7 +8,7 @@ and global_identifier = {name: string ; global_t: global_type} [@@deriving ord] module StringMap = Map.Make(String) -type method_rename_assumption = {original_method_name: string; new_method_name: string; parameter_renames: string StringMap.t} +type method_rename_assumption = {original_method_name: string; new_method_name: string} type method_rename_assumptions = method_rename_assumption VarinfoMap.t type glob_var_rename_assumptions = string VarinfoMap.t @@ -54,9 +54,8 @@ let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods, glob_vars, _) = rename_mapping in let local_string = string_tuple_to_string (List.of_seq (StringMap.to_seq local)) in let methods_string: string = List.of_seq (VarinfoMap.to_seq methods |> Seq.map snd) |> - List.map (fun x -> match x with {original_method_name; new_method_name; parameter_renames} -> - "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ - "; renamed_params=" ^ string_tuple_to_string (List.of_seq (StringMap.to_seq parameter_renames)) ^ ")") |> + List.map (fun x -> match x with {original_method_name; new_method_name} -> + "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ ")") |> String.concat ", " in let global_var_string: string = string_tuple_to_string (List.of_seq (VarinfoMap.to_seq glob_vars) |> @@ -134,7 +133,7 @@ and mem_typ_acc (a: typ) (b: typ) acc = List.exists (fun p -> match p with (x, y and pretty_length () l = Pretty.num (List.length l) -and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename_mapping) : bool * rename_mapping = +and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) ?(fun_parameter_name_comparison_enabled: bool = true) (rename_mapping: rename_mapping) : bool * rename_mapping = (* Registers a compinfo rename or a enum rename*) let register_rename_on_success = fun rename_mapping compinfo_option enum_option -> let maybeAddTuple = fun list option -> @@ -142,12 +141,12 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename in let (a, b, c, renames_on_success) = rename_mapping in - let (compinfoRenames, enumRenames) = renames_on_success in + let (compinfoRenames, enumRenames) = renames_on_success in - let updatedCompinfoRenames = maybeAddTuple compinfoRenames compinfo_option in - let updatedEnumRenames = maybeAddTuple enumRenames enum_option in + let updatedCompinfoRenames = maybeAddTuple compinfoRenames compinfo_option in + let updatedEnumRenames = maybeAddTuple enumRenames enum_option in - a, b, c, (updatedCompinfoRenames, updatedEnumRenames) + a, b, c, (updatedCompinfoRenames, updatedEnumRenames) in if Messages.tracing then Messages.tracei "compareast" "eq_typ_acc %a vs %a (%a, %a)\n" d_type a d_type b pretty_length acc pretty_length !global_typ_acc; (* %a makes List.length calls lazy if compareast isn't being traced *) @@ -158,7 +157,7 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) -> eq_typ_acc typ1 typ2 acc rename_mapping &&>> - forward_list_equal (eq_args acc) list1 list2 &&> + forward_list_equal (eq_args acc ~fun_parameter_name_comparison_enabled:fun_parameter_name_comparison_enabled) list1 list2 &&> (varArg1 = varArg2) &&>> forward_list_equal eq_attribute attr1 attr2 | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) -> @@ -179,11 +178,11 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename let acc = (a, b) :: acc in let (res, rm) = eq_compinfo compinfo1 compinfo2 acc rename_mapping &&>> forward_list_equal eq_attribute attr1 attr2 in let updated_rm: rename_mapping = if res && compinfo1.cname <> compinfo2.cname then - (* This renaming now only takes place when the comparison was successful.*) - (*compinfo2.cname <- compinfo1.cname;*) + (* This renaming now only takes place when the comparison was successful.*) + (*compinfo2.cname <- compinfo1.cname;*) - register_rename_on_success rm (Some((compinfo2, compinfo1))) None - else rm + register_rename_on_success rm (Some((compinfo2, compinfo1))) None + else rm in if res then global_typ_acc := (a, b) :: !global_typ_acc; @@ -203,7 +202,7 @@ and eq_typ_acc (a: typ) (b: typ) (acc: (typ * typ) list) (rename_mapping: rename if Messages.tracing then Messages.traceu "compareast" "eq_typ_acc %a vs %a\n" d_type a d_type b; (r, updated_rename_mapping) -and eq_typ (a: typ) (b: typ) (rename_mapping: rename_mapping) : bool * rename_mapping = eq_typ_acc a b [] rename_mapping +and eq_typ (a: typ) (b: typ) ?(fun_parameter_name_comparison_enabled: bool = true) (rename_mapping: rename_mapping) : bool * rename_mapping = eq_typ_acc a b [] ~fun_parameter_name_comparison_enabled:fun_parameter_name_comparison_enabled rename_mapping and eq_eitems (a: string * exp * location) (b: string * exp * location) (rename_mapping: rename_mapping) = match a, b with (name1, exp1, _l1), (name2, exp2, _l2) -> (name1 = name2, rename_mapping) &&>> eq_exp exp1 exp2 @@ -215,9 +214,10 @@ and eq_enuminfo (a: enuminfo) (b: enuminfo) (rename_mapping: rename_mapping) = forward_list_equal eq_eitems a.eitems b.eitems (* Ignore ereferenced *) -and eq_args (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) (rename_mapping: rename_mapping) : bool * rename_mapping = match a, b with +(*param: fun_parameter_name_comparison_enabled when set to false, skips the comparison of the names*) +and eq_args (acc: (typ * typ) list) (a: string * typ * attributes) (b: string * typ * attributes) ?(fun_parameter_name_comparison_enabled: bool = true) (rename_mapping: rename_mapping) : bool * rename_mapping = match a, b with (name1, typ1, attr1), (name2, typ2, attr2) -> - (rename_mapping_aware_name_comparison name1 name2 rename_mapping, rename_mapping) &&>> + ((not fun_parameter_name_comparison_enabled) || rename_mapping_aware_name_comparison name1 name2 rename_mapping, rename_mapping) &&>> eq_typ_acc typ1 typ2 acc &&>> forward_list_equal eq_attribute attr1 attr2 @@ -275,18 +275,8 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool is_naming_ok, method_rename_mappings, glob_vars | None -> if a.vname <> b.vname then - (*Function that extracts the names from the param spec of the TFun*) - let extract_names_from_params param_spec = - Option.map (fun list -> List.map (fun (name, _, _) -> name) list) param_spec |> - Option.value ~default:[] - in - - (*No mapping exists yet. Create one.*) - let aParamNames = extract_names_from_params aParamSpec in - let bParamNames = extract_names_from_params bParamSpec in - let assumption = - {original_method_name = a.vname; new_method_name = b.vname; parameter_renames = create_locals_rename_mapping aParamNames bParamNames} in + {original_method_name = a.vname; new_method_name = b.vname} in true, VarinfoMap.add a assumption method_rename_mappings, glob_vars else true, method_rename_mappings, glob_vars @@ -298,15 +288,8 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool in (*If the following is a method call, we need to check if we have a mapping for that method call. *) - let typ_rename_mapping = match b.vtype with - | TFun(_, _, _, _) -> ( - let new_locals = VarinfoMap.find_opt a updated_method_rename_mappings in - - match new_locals with - | Some locals -> - (locals.parameter_renames, updated_method_rename_mappings, updatedGlobVarMapping, renames_on_success) - | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping, renames_on_success) - ) + let fun_parameter_name_comparison_enabled = match b.vtype with + | TFun(_, _, _, _) -> false (*| GVar (_, _, _) -> ( let new_local = VarinfoMap.find_opt a glob_vars in @@ -314,11 +297,11 @@ and eq_varinfo (a: varinfo) (b: varinfo) (rename_mapping: rename_mapping) : bool | Some now_name -> (StringMap.add a.vname now_name StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) )*) - | _ -> (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping, renames_on_success) + | _ -> true in (*Ignore rename mapping for type check, as it doesn't change anyway. We only need the renames_on_success*) - let (typeCheck, (_, _, _, updated_renames_on_success)) = eq_typ a.vtype b.vtype typ_rename_mapping in + let (typeCheck, (_, _, _, updated_renames_on_success)) = eq_typ a.vtype b.vtype ~fun_parameter_name_comparison_enabled:fun_parameter_name_comparison_enabled (StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, renames_on_success) in (isNamingOk && typeCheck, (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping, updated_renames_on_success)) &&>> forward_list_equal eq_attribute a.vattr b.vattr &&> diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml index cac98eefda..602ad52707 100644 --- a/src/incremental/compareGlobals.ml +++ b/src/incremental/compareGlobals.ml @@ -35,14 +35,6 @@ let should_reanalyze (fdec: Cil.fundec) = * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_function_rename_mapping: method_rename_assumptions) (global_var_rename_mapping: glob_var_rename_assumptions) = - let local_rename_map: (string, string) Hashtbl.t = Hashtbl.create (List.length a.slocals) in - - if (List.length a.slocals) = (List.length b.slocals) then - List.combine a.slocals b.slocals |> - List.map (fun x -> match x with (a, b) -> (a.vname, b.vname)) |> - List.iter (fun pair -> match pair with (a, b) -> Hashtbl.add local_rename_map a b); - - (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, * and as a second a rename_mapping, holding the rename assumptions *) let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: string StringMap.t) = match alocals, blocals with diff --git a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c b/tests/incremental/04-var-rename/diffs/04-renamed_assert.c deleted file mode 100644 index ef95920fd5..0000000000 --- a/tests/incremental/04-var-rename/diffs/04-renamed_assert.c +++ /dev/null @@ -1,9 +0,0 @@ -#include - -int main() { - int j = 0; - - assert(j < 11); - - return 0; -} From 1caaa79035ae362fd36fc4a7cddefc7f99021120 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Mon, 4 Jul 2022 14:42:34 +0200 Subject: [PATCH 060/518] Removed diffs. --- .../05-method-rename/diffs/00-simple_rename.c | 10 -------- .../diffs/01-dependent_rename.c | 14 ----------- .../diffs/02-rename_and_swap.c | 23 ------------------ .../diffs/03-cyclic_rename_dependency.c | 17 ------------- .../diffs/04-cyclic_with_swap.c | 20 ---------------- .../05-method-rename/diffs/05-deep-change.c | 18 -------------- .../05-method-rename/diffs/06-common_rename.c | 20 ---------------- .../diffs/07-common_rename_refactored.c | 24 ------------------- .../diffs/00-simple_rename.c | 9 ------- .../diffs/01-duplicate_local_global.c | 14 ----------- .../diffs/02-add_new_gvar.c | 9 ------- 11 files changed, 178 deletions(-) delete mode 100644 tests/incremental/05-method-rename/diffs/00-simple_rename.c delete mode 100644 tests/incremental/05-method-rename/diffs/01-dependent_rename.c delete mode 100644 tests/incremental/05-method-rename/diffs/02-rename_and_swap.c delete mode 100644 tests/incremental/05-method-rename/diffs/03-cyclic_rename_dependency.c delete mode 100644 tests/incremental/05-method-rename/diffs/04-cyclic_with_swap.c delete mode 100644 tests/incremental/05-method-rename/diffs/05-deep-change.c delete mode 100644 tests/incremental/05-method-rename/diffs/06-common_rename.c delete mode 100644 tests/incremental/05-method-rename/diffs/07-common_rename_refactored.c delete mode 100644 tests/incremental/06-glob-var-rename/diffs/00-simple_rename.c delete mode 100644 tests/incremental/06-glob-var-rename/diffs/01-duplicate_local_global.c delete mode 100644 tests/incremental/06-glob-var-rename/diffs/02-add_new_gvar.c diff --git a/tests/incremental/05-method-rename/diffs/00-simple_rename.c b/tests/incremental/05-method-rename/diffs/00-simple_rename.c deleted file mode 100644 index 79a05fe8d4..0000000000 --- a/tests/incremental/05-method-rename/diffs/00-simple_rename.c +++ /dev/null @@ -1,10 +0,0 @@ -#include - -void bar() { - printf("foo"); -} - -int main() { - bar(); - return 0; -} diff --git a/tests/incremental/05-method-rename/diffs/01-dependent_rename.c b/tests/incremental/05-method-rename/diffs/01-dependent_rename.c deleted file mode 100644 index a2c5d48fea..0000000000 --- a/tests/incremental/05-method-rename/diffs/01-dependent_rename.c +++ /dev/null @@ -1,14 +0,0 @@ -#include - -void bar1() { - printf("fun1"); -} - -void bar2() { - bar1(); -} - -int main() { - bar2(); - return 0; -} diff --git a/tests/incremental/05-method-rename/diffs/02-rename_and_swap.c b/tests/incremental/05-method-rename/diffs/02-rename_and_swap.c deleted file mode 100644 index eae4b77001..0000000000 --- a/tests/incremental/05-method-rename/diffs/02-rename_and_swap.c +++ /dev/null @@ -1,23 +0,0 @@ -#include - -void newFun() { - printf("newFun"); -} - -void bar1() { - printf("foo1"); -} - -void foo2() { - bar1(); -} - -void foo3() { - newFun(); -} - -int main() { - foo2(); - foo3(); - return 0; -} diff --git a/tests/incremental/05-method-rename/diffs/03-cyclic_rename_dependency.c b/tests/incremental/05-method-rename/diffs/03-cyclic_rename_dependency.c deleted file mode 100644 index a720f8025e..0000000000 --- a/tests/incremental/05-method-rename/diffs/03-cyclic_rename_dependency.c +++ /dev/null @@ -1,17 +0,0 @@ -#include - -//Unchanged. - -void bar1(int c) { - if (c < 10) bar2(c + 1); -} - -void bar2(int c) { - if (c < 10) bar1(c + 1); -} - -int main() { - bar1(0); - bar2(0); - return 0; -} diff --git a/tests/incremental/05-method-rename/diffs/04-cyclic_with_swap.c b/tests/incremental/05-method-rename/diffs/04-cyclic_with_swap.c deleted file mode 100644 index 67cb349429..0000000000 --- a/tests/incremental/05-method-rename/diffs/04-cyclic_with_swap.c +++ /dev/null @@ -1,20 +0,0 @@ -#include - -//Changed. - -void newFun(int c) { - printf("newfun"); -} - -void bar1(int c) { - if (c < 10) bar2(c + 1); -} - -void bar2(int c) { - if (c < 10) newFun(c + 1); -} - -int main() { - bar1(0); - return 0; -} diff --git a/tests/incremental/05-method-rename/diffs/05-deep-change.c b/tests/incremental/05-method-rename/diffs/05-deep-change.c deleted file mode 100644 index 57ad90457b..0000000000 --- a/tests/incremental/05-method-rename/diffs/05-deep-change.c +++ /dev/null @@ -1,18 +0,0 @@ -#include - -void zap() { - printf("drap"); -} - -void bar() { - zap(); -} - -void foo() { - bar(); -} - -int main() { - foo(); - return 0; -} diff --git a/tests/incremental/05-method-rename/diffs/06-common_rename.c b/tests/incremental/05-method-rename/diffs/06-common_rename.c deleted file mode 100644 index 6a96b84747..0000000000 --- a/tests/incremental/05-method-rename/diffs/06-common_rename.c +++ /dev/null @@ -1,20 +0,0 @@ -#include - -void bar() { - printf("foo"); -} - -void fun1() { - bar(); -} - -void fun2() { - bar(); -} - -int main() { - fun1(); - fun2(); - bar(); - return 0; -} diff --git a/tests/incremental/05-method-rename/diffs/07-common_rename_refactored.c b/tests/incremental/05-method-rename/diffs/07-common_rename_refactored.c deleted file mode 100644 index 170cdfb6de..0000000000 --- a/tests/incremental/05-method-rename/diffs/07-common_rename_refactored.c +++ /dev/null @@ -1,24 +0,0 @@ -#include - -void bar() { - printf("foo"); -} - -void baz() { - printf("baz"); -} - -void fun1() { - bar(); -} - -void fun2() { - bar(); -} - -int main() { - fun1(); - fun2(); - baz(); - return 0; -} diff --git a/tests/incremental/06-glob-var-rename/diffs/00-simple_rename.c b/tests/incremental/06-glob-var-rename/diffs/00-simple_rename.c deleted file mode 100644 index bfe71f0522..0000000000 --- a/tests/incremental/06-glob-var-rename/diffs/00-simple_rename.c +++ /dev/null @@ -1,9 +0,0 @@ -#include - -int bar = 1; - -int main() { - printf("%d", bar); - - return 0; -} diff --git a/tests/incremental/06-glob-var-rename/diffs/01-duplicate_local_global.c b/tests/incremental/06-glob-var-rename/diffs/01-duplicate_local_global.c deleted file mode 100644 index 0e4ebf3fd7..0000000000 --- a/tests/incremental/06-glob-var-rename/diffs/01-duplicate_local_global.c +++ /dev/null @@ -1,14 +0,0 @@ -#include - -int bar = 1; - -int main() { - - printf("%d", bar); - - int bar = 2; - - printf("%d", bar); - - return 0; -} diff --git a/tests/incremental/06-glob-var-rename/diffs/02-add_new_gvar.c b/tests/incremental/06-glob-var-rename/diffs/02-add_new_gvar.c deleted file mode 100644 index 3841a59b11..0000000000 --- a/tests/incremental/06-glob-var-rename/diffs/02-add_new_gvar.c +++ /dev/null @@ -1,9 +0,0 @@ -#include - -int myVar = 1; -int foo = 1; - -int main() { - printf("%d", myVar); - printf("%d", foo); -} From b9785ab01454e8e12798b46760b38a010ddd071c Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 12 Jul 2022 15:55:33 +0200 Subject: [PATCH 061/518] Applied changes requested in PR #731. compareCFG now propagates rename_mapping. --- src/incremental/compareAST.ml | 8 ++- src/incremental/compareCFG.ml | 102 ++++++++++++++++-------------- src/incremental/compareGlobals.ml | 43 ++++++++++--- src/incremental/updateCil.ml | 2 +- 4 files changed, 96 insertions(+), 59 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index be5d987884..00a79e1fb1 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -63,6 +63,10 @@ let rename_mapping_to_string (rename_mapping: rename_mapping) = "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "]; glob_vars=" ^ global_var_string ^ ")" +let is_rename_mapping_empty (rename_mapping: rename_mapping) = + let local, methods, glob_vars, _= rename_mapping in + StringMap.is_empty local && VarinfoMap.is_empty methods && VarinfoMap.is_empty glob_vars + let identifier_of_global glob = match glob with | GFun (fundec, l) -> {name = fundec.svar.vname; global_t = Fun} @@ -86,9 +90,9 @@ let (&&>) (prev_result: bool * rename_mapping) (b: bool) : bool * rename_mapping (prev_equal && b, rename_mapping) (*Same as Goblist.eq but propagates the rename_mapping*) -let forward_list_equal f l1 l2 (prev_result: rename_mapping) : bool * rename_mapping = +let forward_list_equal ?(propF = (&&>>)) f l1 l2 (prev_result: rename_mapping) : bool * rename_mapping = if ((List.compare_lengths l1 l2) = 0) then - List.fold_left2 (fun (b, r) x y -> if b then f x y r else (b, r)) (true, prev_result) l1 l2 + List.fold_left2 (fun (b, r) x y -> propF (b, r) (f x y)) (true, prev_result) l1 l2 else false, prev_result (* hack: CIL generates new type names for anonymous types - we want to ignore these *) diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 33735aa453..5ebcf1aa6a 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -3,43 +3,42 @@ open Queue open Cil include CompareAST -(*Non propagating version of &&>>. Discards the new rename_mapping and alwas propagates the one in prev_result*) +(*Non propagating version of &&>>. Discards the new rename_mapping and alwas propagates the one in prev_result. However propagates the renames_on_success*) let (&&<>) (prev_result: bool * rename_mapping) f : bool * rename_mapping = let (prev_equal, prev_rm) = prev_result in + let (a, b, c, _) = prev_rm in + if prev_equal then - let (r, _) = f prev_rm in - (r, prev_rm) + let (r, (_, _, _, updated_renames_on_success)) = f prev_rm in + (r, (a, b, c, updated_renames_on_success)) else false, prev_rm -let eq_node (x, fun1) (y, fun2) : bool = - let empty_rename_mapping: rename_mapping = emptyRenameMapping in +let eq_node (x, fun1) (y, fun2) rename_mapping = match x,y with - | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) empty_rename_mapping |> fst - | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping |> fst - | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping |> fst - | _ -> false + | Statement s1, Statement s2 -> eq_stmt ~cfg_comp:true (s1, fun1) (s2, fun2) rename_mapping + | Function f1, Function f2 -> eq_varinfo f1.svar f2.svar rename_mapping + | FunctionEntry f1, FunctionEntry f2 -> eq_varinfo f1.svar f2.svar rename_mapping + | _ -> false, rename_mapping (* TODO: compare ASMs properly instead of simply always assuming that they are not the same *) -let eq_edge x y = - let empty_rename_mapping: rename_mapping = emptyRenameMapping in - let (r, _) = match x, y with - | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 empty_rename_mapping &&<> eq_exp rv1 rv2 - | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 empty_rename_mapping &&<> forward_list_equal eq_exp ars1 ars2 - | Proc (Some r1,f1,ars1), Proc (Some r2,f2,ars2) -> - eq_lval r1 r2 empty_rename_mapping &&<> eq_exp f1 f2 &&<> forward_list_equal eq_exp ars1 ars2 - | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar empty_rename_mapping - | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar empty_rename_mapping - | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 empty_rename_mapping &&<> eq_varinfo fd1.svar fd2.svar - | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 empty_rename_mapping &&> (b1 = b2) - | ASM _, ASM _ -> false, empty_rename_mapping - | Skip, Skip -> true, empty_rename_mapping - | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 empty_rename_mapping - | _ -> false, empty_rename_mapping - in - r +let eq_edge x y rename_mapping = + match x, y with + | Assign (lv1, rv1), Assign (lv2, rv2) -> eq_lval lv1 lv2 rename_mapping &&<> eq_exp rv1 rv2 + | Proc (None,f1,ars1), Proc (None,f2,ars2) -> eq_exp f1 f2 rename_mapping &&<> forward_list_equal eq_exp ars1 ars2 + | Proc (Some r1,f1,ars1), Proc (Some r2,f2,ars2) -> + eq_lval r1 r2 rename_mapping &&<> eq_exp f1 f2 &&<> forward_list_equal eq_exp ars1 ars2 + | Entry f1, Entry f2 -> eq_varinfo f1.svar f2.svar rename_mapping + | Ret (None,fd1), Ret (None,fd2) -> eq_varinfo fd1.svar fd2.svar rename_mapping + | Ret (Some r1,fd1), Ret (Some r2,fd2) -> eq_exp r1 r2 rename_mapping &&<> eq_varinfo fd1.svar fd2.svar + | Test (p1,b1), Test (p2,b2) -> eq_exp p1 p2 rename_mapping &&> (b1 = b2) + | ASM _, ASM _ -> false, rename_mapping + | Skip, Skip -> true, rename_mapping + | VDecl v1, VDecl v2 -> eq_varinfo v1 v2 rename_mapping + | _ -> false, rename_mapping + (* The order of the edges in the list is relevant. Therefore compare them one to one without sorting first *) -let eq_edge_list xs ys = GobList.equal eq_edge xs ys +let eq_edge_list xs ys = forward_list_equal ~propF:(&&<>) eq_edge xs ys let to_edge_list ls = List.map (fun (loc, edge) -> edge) ls @@ -52,13 +51,14 @@ type biDirectionNodeMap = {node1to2: node NH.t; node2to1: node NH.t} * in the succesors of fromNode2 in the new CFG. Matching node tuples are added to the waitingList to repeat the matching * process on their successors. If a node from the old CFG can not be matched, it is added to diff and no further * comparison is done for its successors. The two function entry nodes make up the tuple to start the comparison from. *) -let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 fun2 = + +let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 fun2 rename_mapping : biDirectionNodeMap * unit NH.t * rename_mapping = let diff = NH.create 113 in let same = {node1to2=NH.create 113; node2to1=NH.create 113} in let waitingList : (node * node) t = Queue.create () in - let rec compareNext () = - if Queue.is_empty waitingList then () + let rec compareNext () rename_mapping : rename_mapping = + if Queue.is_empty waitingList then rename_mapping else let fromNode1, fromNode2 = Queue.take waitingList in let outList1 = CfgOld.next fromNode1 in @@ -66,24 +66,26 @@ let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 f (* Find a matching edge and successor node for (edgeList1, toNode1) in the list of successors of fromNode2. * If successful, add the matching node tuple to same, else add toNode1 to the differing nodes. *) - let findMatch (edgeList1, toNode1) = - let rec aux remSuc = match remSuc with - | [] -> NH.replace diff toNode1 () + let findMatch (edgeList1, toNode1) rename_mapping : rename_mapping = + let rec aux remSuc rename_mapping : rename_mapping = match remSuc with + | [] -> NH.replace diff toNode1 (); rename_mapping | (locEdgeList2, toNode2)::remSuc' -> let edgeList2 = to_edge_list locEdgeList2 in (* TODO: don't allow pseudo return node to be equal to normal return node, could make function unchanged, but have different sallstmts *) - if eq_node (toNode1, fun1) (toNode2, fun2) && eq_edge_list edgeList1 edgeList2 then + let (isEq, updatedRenameMapping) = (true, rename_mapping) &&>> eq_node (toNode1, fun1) (toNode2, fun2) &&>> eq_edge_list edgeList1 edgeList2 in + if isEq then begin match NH.find_opt same.node1to2 toNode1 with - | Some n2 -> if not (Node.equal n2 toNode2) then NH.replace diff toNode1 () - | None -> NH.replace same.node1to2 toNode1 toNode2; NH.replace same.node2to1 toNode2 toNode1; Queue.add (toNode1, toNode2) waitingList + | Some n2 -> if not (Node.equal n2 toNode2) then NH.replace diff toNode1 (); updatedRenameMapping + | None -> NH.replace same.node1to2 toNode1 toNode2; NH.replace same.node2to1 toNode2 toNode1; Queue.add (toNode1, toNode2) waitingList; + updatedRenameMapping end - else aux remSuc' in - aux outList2 in + else aux remSuc' updatedRenameMapping in + aux outList2 rename_mapping in (* For a toNode1 from the list of successors of fromNode1, check whether it might have duplicate matches. * In that case declare toNode1 as differing node. Else, try finding a match in the list of successors * of fromNode2 in the new CFG using findMatch. *) - let iterOuts (locEdgeList1, toNode1) = + let iterOuts (locEdgeList1, toNode1) rename_mapping : rename_mapping = let edgeList1 = to_edge_list locEdgeList1 in (* Differentiate between a possibly duplicate Test(1,false) edge and a single occurence. In the first * case the edge is directly added to the diff set to avoid undetected ambiguities during the recursive @@ -94,13 +96,18 @@ let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 f let posAmbigEdge edgeList = let findTestFalseEdge (ll,_) = testFalseEdge (snd (List.hd ll)) in let numDuplicates l = List.length (List.find_all findTestFalseEdge l) in testFalseEdge (List.hd edgeList) && (numDuplicates outList1 > 1 || numDuplicates outList2 > 1) in - if posAmbigEdge edgeList1 then NH.replace diff toNode1 () - else findMatch (edgeList1, toNode1) in - List.iter iterOuts outList1; compareNext () in + if posAmbigEdge edgeList1 then (NH.replace diff toNode1 (); rename_mapping) + else findMatch (edgeList1, toNode1) rename_mapping in + let updatedRenameMapping = List.fold_left (fun rm e -> iterOuts e rm) rename_mapping outList1 in + compareNext () updatedRenameMapping + in let entryNode1, entryNode2 = (FunctionEntry fun1, FunctionEntry fun2) in - NH.replace same.node1to2 entryNode1 entryNode2; NH.replace same.node2to1 entryNode2 entryNode1; - Queue.push (entryNode1,entryNode2) waitingList; compareNext (); (same, diff) + NH.replace same.node1to2 entryNode1 entryNode2; + NH.replace same.node2to1 entryNode2 entryNode1; + Queue.push (entryNode1,entryNode2) waitingList; + let updatedRenameMapping = compareNext () rename_mapping in + same, diff, updatedRenameMapping (* This is the second phase of the CFG comparison of functions. It removes the nodes from the matching node set 'same' * that have an incoming backedge in the new CFG that can be reached from a differing new node. This is important to @@ -123,7 +130,8 @@ let reexamine f1 f2 (same : biDirectionNodeMap) (diffNodes1 : unit NH.t) (module repeat (); NH.to_seq same.node1to2, NH.to_seq_keys diffNodes1 -let compareFun (module CfgOld : CfgForward) (module CfgNew : CfgBidir) fun1 fun2 = - let same, diff = Stats.time "compare-phase1" (fun () -> compareCfgs (module CfgOld) (module CfgNew) fun1 fun2) () in + +let compareFun (module CfgOld : CfgForward) (module CfgNew : CfgBidir) fun1 fun2 rename_mapping : (node * node) list * node list * rename_mapping = + let same, diff, rename_mapping = Stats.time "compare-phase1" (fun () -> compareCfgs (module CfgOld) (module CfgNew) fun1 fun2 rename_mapping) () in let unchanged, diffNodes1 = Stats.time "compare-phase2" (fun () -> reexamine fun1 fun2 same diff (module CfgOld) (module CfgNew)) () in - List.of_seq unchanged, List.of_seq diffNodes1 + List.of_seq unchanged, List.of_seq diffNodes1, rename_mapping diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml index 602ad52707..d91255bbaf 100644 --- a/src/incremental/compareGlobals.ml +++ b/src/incremental/compareGlobals.ml @@ -1,5 +1,6 @@ open Cil open MyCFG +open CilMaps include CompareAST include CompareCFG @@ -47,19 +48,43 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo | _, _ -> false, rename_mapping in - let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in - let actHeaderRenameMapping: rename_mapping = (headerRenameMapping, global_function_rename_mapping, global_var_rename_mapping, ([], [])) in + let unchangedHeader, headerRenameMapping, renamesOnSuccessHeader = match cfgs with + | None -> ( + let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare a.sformals b.sformals (StringMap.empty) in + let actHeaderRenameMapping: rename_mapping = (headerRenameMapping, global_function_rename_mapping, global_var_rename_mapping, ([], [])) in + + let (unchangedHeader, (_, _, _, renamesOnSuccessHeader)) = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> + forward_list_equal eq_varinfo a.sformals b.sformals in + unchangedHeader, headerRenameMapping, renamesOnSuccessHeader + ) + | Some _ -> ( + let unchangedHeader, headerRenameMapping = eq_varinfo a.svar b.svar emptyRenameMapping &&>> + forward_list_equal eq_varinfo a.sformals b.sformals in + let (_, _, _, renamesOnSuccessHeader) = headerRenameMapping in + + (unchangedHeader && is_rename_mapping_empty headerRenameMapping), StringMap.empty, renamesOnSuccessHeader + ) + in - let (unchangedHeader, (_, _, _, renamesOnSuccessHeader)) = eq_varinfo a.svar b.svar actHeaderRenameMapping &&>> forward_list_equal eq_varinfo a.sformals b.sformals in let identical, diffOpt, (_, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess) = if should_reanalyze a then false, None, emptyRenameMapping else (* Here the local variables are checked to be equal *) - let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in - let rename_mapping: rename_mapping = (local_rename, global_function_rename_mapping, global_var_rename_mapping, renamesOnSuccessHeader) in + (*flag: when running on cfg, true iff the locals are identical; on ast: if the size of the locals stayed the same*) + let flag, rename_mapping = + match cfgs with + | None -> ( + let sizeEqual, local_rename = rename_mapping_aware_compare a.slocals b.slocals headerRenameMapping in + sizeEqual, (local_rename, global_function_rename_mapping, global_var_rename_mapping, renamesOnSuccessHeader) + ) + | Some _ -> ( + let isEqual, rename_mapping = forward_list_equal eq_varinfo a.slocals b.slocals (StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, renamesOnSuccessHeader) in + isEqual && is_rename_mapping_empty rename_mapping, rename_mapping + ) + in - let sameDef = unchangedHeader && sizeEqual in + let sameDef = unchangedHeader && flag in if not sameDef then (false, None, emptyRenameMapping) else @@ -70,8 +95,8 @@ let eqF (a: Cil.fundec) (b: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (glo | Some (cfgOld, (cfgNew, cfgNewBack)) -> let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in - let matches, diffNodes1 = compareFun (module CfgOld) (module CfgNew) a b in - if diffNodes1 = [] then (true, None, emptyRenameMapping) - else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, emptyRenameMapping) + let matches, diffNodes1, updated_rename_mapping = compareFun (module CfgOld) (module CfgNew) a b rename_mapping in + if diffNodes1 = [] then (true, None, updated_rename_mapping) + else (false, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, updated_rename_mapping) in identical, unchangedHeader, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess diff --git a/src/incremental/updateCil.ml b/src/incremental/updateCil.ml index 5aa756804a..99ff845e38 100644 --- a/src/incremental/updateCil.ml +++ b/src/incremental/updateCil.ml @@ -45,7 +45,7 @@ let update_ids (old_file: file) (ids: max_ids) (new_file: file) (changes: change old_f.svar.vname <- f.svar.vname; f.svar.vid <- old_f.svar.vid; List.iter2 (fun l o_l -> l.vid <- o_l.vid; o_l.vname <- l.vname) f.slocals old_f.slocals; - List.iter2 (fun lo o_f -> lo.vid <- o_f.vid) f.sformals old_f.sformals; + List.iter2 (fun lo o_f -> lo.vid <- o_f.vid; o_f.vname <- lo.vname) f.sformals old_f.sformals; List.iter2 (fun s o_s -> s.sid <- o_s.sid) f.sallstmts old_f.sallstmts; List.iter (fun s -> store_node_location (Statement s) (Cilfacade.get_stmtLoc s)) f.sallstmts; From 1f7b7bb8e9d8a6ac0aeb89edab986ab766ed503f Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 12 Jul 2022 16:30:36 +0200 Subject: [PATCH 062/518] detecting renames can now be disabled using the option incremental.detect-renames --- src/incremental/compareAST.ml | 23 ++++++----- src/incremental/compareCIL.ml | 75 ++++++++++++++++++----------------- src/util/options.schema.json | 6 +++ 3 files changed, 58 insertions(+), 46 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 00a79e1fb1..d3ba142cfb 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -24,16 +24,19 @@ let emptyRenameMapping: rename_mapping = (StringMap.empty, VarinfoMap.empty, Var 1. there is a rename for name1 -> name2 = rename(name1) 2. there is no rename for name1 -> name1 = name2*) let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = - let (local_c, method_c, _, _) = rename_mapping in - let existingAssumption: string option = StringMap.find_opt name1 local_c in - - match existingAssumption with - | Some now -> - (*Printf.printf "Assumption is: %s -> %s\n" original now;*) - now = name2 - | None -> - (*Printf.printf "No assumption when %s, %s, %b\n" name1 name2 (name1 = name2);*) - name1 = name2 (*Var names differ, but there is no assumption, so this can't be good*) + if GobConfig.get_bool "incremental.detect-renames" then ( + let (local_c, method_c, _, _) = rename_mapping in + let existingAssumption: string option = StringMap.find_opt name1 local_c in + + match existingAssumption with + | Some now -> + (*Printf.printf "Assumption is: %s -> %s\n" original now;*) + now = name2 + | None -> + (*Printf.printf "No assumption when %s, %s, %b\n" name1 name2 (name1 = name2);*) + name1 = name2 (*Var names differ, but there is no assumption, so this can't be good*) + ) + else name1 = name2 (*Creates the mapping of local renames. If the locals do not match in size, an empty mapping is returned.*) let create_locals_rename_mapping (originalLocalNames: string list) (updatedLocalNames: string list): string StringMap.t = diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index e89fc27c16..0e494075d1 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -41,12 +41,13 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = global_typ_acc := []; let findChanges map global = try - let isGFun = match global with - | GFun _-> true (* set to true later to disable finding changes for funs*) + let skipFindChanges = match global with + | GFun _-> true + | GVar _ -> true | _ -> false in - if not isGFun then + if not skipFindChanges || not (GobConfig.get_bool "incremental.detect-renames") then let ident = identifier_of_global global in let old_global = GlobalMap.find ident map in (* Do a (recursive) equal comparison ignoring location information *) @@ -60,45 +61,47 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = (* Store a map from functionNames in the old file to the function definition*) let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in - let renameDetectionResults = detectRenamedFunctions oldAST newAST in - - if Messages.tracing then - GlobalElemMap.to_seq renameDetectionResults |> - Seq.iter - (fun (gT, (functionGlobal, status)) -> - Messages.trace "compareCIL" "Function status of %s is=" (globalElemName gT); - match status with - | Unchanged _ -> Messages.trace "compareCIL" "Same Name\n"; - | Added -> Messages.trace "compareCIL" "Added\n"; - | Removed -> Messages.trace "compareCIL" "Removed\n"; - | Changed _ -> Messages.trace "compareCIL" "Changed\n"; - | UnchangedButRenamed toFrom -> - match toFrom with - | GFun (f, _) -> Messages.trace "compareCIL" "Renamed to %s\n" f.svar.vname; - | GVar(v, _, _) -> Messages.trace "compareCIL" "Renamed to %s\n" v.vname; - | _ -> (); - ); + if GobConfig.get_bool "incremental.detect-renames" then ( + let renameDetectionResults = detectRenamedFunctions oldAST newAST in + + if Messages.tracing then + GlobalElemMap.to_seq renameDetectionResults |> + Seq.iter + (fun (gT, (functionGlobal, status)) -> + Messages.trace "compareCIL" "Function status of %s is=" (globalElemName gT); + match status with + | Unchanged _ -> Messages.trace "compareCIL" "Same Name\n"; + | Added -> Messages.trace "compareCIL" "Added\n"; + | Removed -> Messages.trace "compareCIL" "Removed\n"; + | Changed _ -> Messages.trace "compareCIL" "Changed\n"; + | UnchangedButRenamed toFrom -> + match toFrom with + | GFun (f, _) -> Messages.trace "compareCIL" "Renamed to %s\n" f.svar.vname; + | GVar(v, _, _) -> Messages.trace "compareCIL" "Renamed to %s\n" v.vname; + | _ -> (); + ); + + let unchanged, changed, added, removed = GlobalElemMap.fold (fun _ (global, status) (u, c, a, r) -> + match status with + | Unchanged now -> (u @ [{old=global; current=now}], c, a, r) + | UnchangedButRenamed now -> (u @ [{old=global; current=now}], c, a, r) + | Added -> (u, c, a @ [global], r) + | Removed -> (u, c, a, r @ [global]) + | Changed (now, unchangedHeader) -> (u, c @ [{old=global; current=now; unchangedHeader=unchangedHeader; diff=None}], a, r) + ) renameDetectionResults (changes.unchanged, changes.changed, changes.added, changes.removed) + in + + changes.added <- added; + changes.removed <- removed; + changes.changed <- changed; + changes.unchanged <- unchanged; + ) else (); (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) Cil.iterGlobals newAST (fun glob -> findChanges oldMap glob); - let unchanged, changed, added, removed = GlobalElemMap.fold (fun _ (global, status) (u, c, a, r) -> - match status with - | Unchanged now -> (u @ [{old=global; current=now}], c, a, r) - | UnchangedButRenamed now -> (u @ [{old=global; current=now}], c, a, r) - | Added -> (u, c, a @ [global], r) - | Removed -> (u, c, a, r @ [global]) - | Changed (now, unchangedHeader) -> (u, c @ [{old=global; current=now; unchangedHeader=unchangedHeader; diff=None}], a, r) - ) renameDetectionResults (changes.unchanged, changes.changed, changes.added, changes.removed) - in - - changes.added <- added; - changes.removed <- removed; - changes.changed <- changed; - changes.unchanged <- unchanged; - changes (** Given an (optional) equality function between [Cil.global]s, an old and a new [Cil.file], this function computes a [change_info], diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 326ef3f6e1..b6227adc2e 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -953,6 +953,12 @@ "enum": ["ast", "cfg"], "default": "ast" }, + "detect-renames": { + "title": "incremental.detect-renames", + "description": "If Goblint should try to detect renamed local variables, function parameters, functions and global variables", + "type":"boolean", + "default": true + }, "force-reanalyze": { "title": "incremental.force-reanalyze", "type": "object", From ae506cb0b03eea630c5fd1936e69f91d7a977b61 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Wed, 13 Jul 2022 19:01:28 +0200 Subject: [PATCH 063/518] Added test script. function rename detection now supports renamed recursive functions. --- scripts/test-refactorings-rename.py | 432 ++++++++++++++++++ src/incremental/detectRenamedFunctions.ml | 87 ++-- .../05-method-rename/08-recursive_rename.c | 7 + .../05-method-rename/08-recursive_rename.json | 3 + .../08-recursive_rename.patch | 13 + 5 files changed, 504 insertions(+), 38 deletions(-) create mode 100644 scripts/test-refactorings-rename.py create mode 100644 tests/incremental/05-method-rename/08-recursive_rename.c create mode 100644 tests/incremental/05-method-rename/08-recursive_rename.json create mode 100644 tests/incremental/05-method-rename/08-recursive_rename.patch diff --git a/scripts/test-refactorings-rename.py b/scripts/test-refactorings-rename.py new file mode 100644 index 0000000000..4d3fd70edb --- /dev/null +++ b/scripts/test-refactorings-rename.py @@ -0,0 +1,432 @@ +#!/usr/bin/python +import dataclasses +import os +import pathlib +import re +import shutil +import subprocess +import sys +import tempfile +from os.path import isdir +from pathlib import Path +from pycparser import c_ast, c_parser, parse_file +from pycparser.c_ast import TypeDecl, ArrayDecl, PtrDecl, IdentifierType +from pycparser.c_generator import CGenerator + +parser_errors = 0 +struct_occurrences = 0 +skips = 0 +includes = 0 +includes_only_assert = 0 +invalid_solver = 0 +introduced_changes = 0 +renamed_a_function = 0 + +def main(): + regression_folder = Path("./tests/regression") + + task = TaskRenameFunction() + + # test = regression_folder / "23-partitioned_arrays_last/06-interprocedural.c" + # execute_validation_test(test.parent, test, task) + # return + + excluded = [ + "44-trier_analyzer/33-recA.c", + # Even though the same file is read in, the type of rec#i differes from int * to int?! + "04-mutex/53-kernel-spinlock.c", # Kernel is broken. + "56-witness/01-base-lor-enums.c", # 0evals? + "56-witness/02-base-lor-addr.c", # 0evals? + "56-witness/03-int-log-short.c", # 0evals? + "56-witness/04-base-priv-sync-prune.c", # 0evals? + "44-trier_analyzer/09-G1.c", # Also renamed glob var + "44-trier_analyzer/21-Pproc.c" # renamed function. + ] + + # folder = regression_folder / "07-uninit" + # for testFile in folder.iterdir(): + # filename, extension = os.path.splitext(testFile.name) + # identifier = f"{folder.name}/{testFile.name}" + # + # if extension == ".c" and not (identifier in excluded): + # execute_validation_test(folder, testFile) + + total_tests = 0 + executed_tests = 0 + + for folder in regression_folder.iterdir(): + if isdir(folder): + for testFile in folder.iterdir(): + filename, extension = os.path.splitext(testFile.name) + if extension == ".c" and not (f"{folder.name}/{testFile.name}" in excluded): + total_tests += 1 + if execute_validation_test(folder, testFile, task): + executed_tests += 1 + + global introduced_changes + global renamed_a_function + + print(f"Executed {executed_tests}/{total_tests}") + if isinstance(task, TaskRenameLocals) and task.introduce_changes: + print(f"Introduced changes in {introduced_changes}/{executed_tests}") + + if isinstance(task, TaskRenameFunction): + print(f"Renamed a function in {renamed_a_function}/{executed_tests}") + + global parser_errors + global struct_occurrences + global skips + global includes + global invalid_solver + global includes_only_assert + + print("Skipped due tue:") + print("Parser errors: " + str(parser_errors)) + print("Struct occurrences: " + str(struct_occurrences)) + print("Skips (//Skip): " + str(skips)) + print(f"Includes: {includes}, of those only assert: {includes_only_assert}") + print("Invalid solver: " + str(invalid_solver)) + + +def execute_validation_test(folder: Path, test_file: Path, task): + print(f"Executing test: {folder.name}/{test_file.name}") + + global parser_errors + global struct_occurrences + global skips + global includes + global invalid_solver + global includes_only_assert + global introduced_changes + global renamed_a_function + + extra_params = "" + + with open(test_file, "r") as filehandle: + lines = filehandle.readlines() + if lines[0].startswith("// PARAM:"): + extra_params = lines[0][len("// PARAM:"):-1] + if lines[0].startswith("// SKIP"): + print("Skipped test.") + skips += 1 + return False + if any(x.startswith("#include") for x in lines): + print("Skipped test because of include") + includes += 1 + + include_lines = [x for x in lines if x.startswith("#include")] + + if all("assert.h" in x for x in include_lines): + includes_only_assert += 1 + + return False + if any("struct" in x for x in lines): + print("Skipped because struct") + struct_occurrences += 1 + return False + + if "slr3" in extra_params or "slr4" in extra_params: + print("Aborted test due to invalid solver.") + invalid_solver += 1 + return False + + modified_file_result = create_modified_file(test_file, task) + + if modified_file_result is None: + print("Aborted test due to parsing error.") + parser_errors += 1 + return False + + base = "./" + + args = f"--enable dbg.debug --enable printstats -v {extra_params}" + + subprocess.run(f"./goblint {args} --enable incremental.save {test_file}", shell=True, capture_output=True) + + command = subprocess.run( + f"./goblint {args} --enable incremental.load --set save_run {base}/{test_file}-incrementalrun {modified_file_result.tmp.name}", + shell=True, text=True, capture_output=True) + + found_line = False + + for line in command.stdout.splitlines(): + if line.startswith("change_info = "): + match = re.search("; changed = (\d+)", line) + change_count = int(match.group(1)) + + if modified_file_result.introduced_changes: + invalid_change_count = change_count == 0 + expected = "> 0" + else: + invalid_change_count = change_count != 0 + expected = "= 0" + + if invalid_change_count != 0: + print("-----------------------------------------------------------------") + print(command.stdout) + print("-----------------------------------------------------------------") + print(f"Invalid change count={change_count}. Expected {expected}.") + cleanup(folder, test_file, modified_file_result.tmp) + sys.exit(-1) + found_line = True + break + + if not found_line: + print("Could not find line with change count.") + print(command.stdout) + cleanup(folder, test_file, modified_file_result.tmp) + sys.exit(-1) + + if modified_file_result.introduced_changes: + introduced_changes += 1 + + if modified_file_result.renamed_anything and isinstance(task, TaskRenameFunction): + renamed_a_function += 1 + + cleanup(folder, test_file, modified_file_result.tmp) + + return True + + +def cleanup(folder: Path, test: Path, updated_file): + updated_file.close() + shutil.rmtree(folder / f"{test.name}-incrementalrun") + + +def find_local_vars(node, on_node_found): + if node.body.block_items is not None: + for child in node.body.block_items: + if isinstance(child, c_ast.Decl): + if isinstance(child.type, c_ast.TypeDecl) or isinstance(child.type, c_ast.ArrayDecl): + on_node_found(child) + + +def rename_decl(node, new_name): + if isinstance(node.type, TypeDecl) or isinstance(node.type, ArrayDecl) or isinstance(node.type, PtrDecl): + node.name = new_name + if isinstance(node.type, TypeDecl): + node.type.declname = new_name + if isinstance(node.type, ArrayDecl): + node.type.type.declname = new_name + if isinstance(node.type, PtrDecl): + node.type.type.declname = new_name + +def visit_rest_of_func_def(self, node): + self.visit(node.decl) + if node.param_decls is not None: + self.visit(node.param_decls) + + self.visit(node.body) + +class VarDeclVisitor(c_ast.NodeVisitor): + + def __init__(self): + self.local_variables = {} + self.function_params = {} + + def visit_FuncDef(self, node): + lv = [] + fp = [] + + find_local_vars(node, lambda f: lv.append(f.name)) + if isinstance(node.decl, c_ast.Decl) and isinstance(node.decl.type, c_ast.FuncDecl): + func_decl = node.decl.type + if isinstance(func_decl.args, c_ast.ParamList): + for arg in func_decl.args.params: + if isinstance(arg, c_ast.Decl): + fp.append(arg.name) + + self.local_variables[node.decl.name] = lv + self.function_params[node.decl.name] = fp + + +class RenameVariableVisitor(c_ast.NodeVisitor): + + def __init__(self, rename_mapping): + self.map = rename_mapping + + def visit_ID(self, node): + if node.name in self.map: + node.name = self.map[node.name] + + def visit_Decl(self, node): + if node.name in self.map: + rename_decl(node, self.map[node.name]) + + if node.init is not None: + self.visit(node.init) + + self.visit(node.type) + + +class IntroduceSemanticChangeVisitor(c_ast.NodeVisitor): + + # legal_local_variables: Only these variables may be used to introduce a change + def __init__(self, legal_local_variables): + self.in_fun = False + self.fun_name = None + + self.introduced_change = False + self.found_vars = [] + self.introduced_changes = [] + self.legal_local_variables = legal_local_variables + + def visit_ID(self, node): + if self.in_fun: + if any(found_var for found_var in self.found_vars if found_var.name == node.name): + known_var = [found_var for found_var in self.found_vars if found_var.name == node.name][0] + + # check if we can find another already declared var with the same type + other_decls = [var for var in self.found_vars if + var.type == known_var.type and + var.name != known_var.name and + var.name in self.legal_local_variables[self.fun_name] + ] + + # only introduce change if not already done so for this variable + if len(other_decls) > 0 and known_var.name not in self.introduced_changes: + node.name = other_decls[0].name + self.introduced_change = True + self.introduced_changes.append(known_var.name) + else: + node.name = known_var.name + + + def visit_FuncDef(self, node): + self.in_fun = True + self.fun_name = node.decl.name + self.found_vars = [] + self.introduced_changes = [] + visit_rest_of_func_def(self, node) + self.in_fun = False + self.fun_name = None + + def visit_Decl(self, node): + if self.in_fun and isinstance(node.type, c_ast.TypeDecl) or isinstance(node.type, c_ast.ArrayDecl): + if isinstance(node.type, TypeDecl) and isinstance(node.type.type, IdentifierType): + if len(node.type.type.names) == 1: + self.found_vars.append(LocalVar(node.name, node.type.type.names[0], node.name + "_updated")) + if node.init is not None: + self.visit(node.init) + + self.visit(node.type) + + +# find a single function to rename, but never main +class FindFunctionToRenameVisitor(c_ast.NodeVisitor): + + def __init__(self): + self.fun_name = None + self.updated_fun_name = None + + + def visit_FuncDef(self, node): + fun_name = node.decl.name + if fun_name != "main" and self.fun_name is None: + self.fun_name = fun_name + self.updated_fun_name = fun_name + "_updated" + + +class RenameFunctionVisitor(c_ast.NodeVisitor): + + def __init__(self, function_to_rename_name, updated_name): + self.function_to_rename_name = function_to_rename_name + self.updated_name = updated_name + + def visit_FuncDef(self, node): + fun_name = node.decl.name + if fun_name == self.function_to_rename_name: + node.decl.name = self.updated_name + node.decl.type.type.declname = self.updated_name + + visit_rest_of_func_def(self, node) + + + def visit_ID(self, node): + if node.name == self.function_to_rename_name: + node.name = self.updated_name + + +def create_modified_file(source_file: Path, task): + try: + ast = parse_file(source_file, use_cpp=True) + + introduced_change = False + renamed_anything = False + + if isinstance(task, TaskRenameLocals): + v = VarDeclVisitor() + v.visit(ast) + + rename_mapping = {} + local_vars = [x for xs in (list(v.local_variables.values()) + list(v.function_params.values())) for x in xs] + for local_var in local_vars: + rename_mapping[local_var] = local_var + "_updated" + + if task.introduce_changes: + x = IntroduceSemanticChangeVisitor(v.local_variables) + x.visit(ast) + + # print(CGenerator().visit(ast)) + # print("Introduced change:" + str(x.introduced_change)) + + introduced_change = x.introduced_change + else: + introduced_change = False + + RenameVariableVisitor(rename_mapping).visit(ast) + renamed_anything = len(local_vars) > 0 + + if isinstance(task, TaskRenameFunction): + v = FindFunctionToRenameVisitor() + v.visit(ast) + + renamed_anything = v.fun_name is not None + + if v.fun_name is not None: + v = RenameFunctionVisitor(v.fun_name, v.updated_fun_name) + v.visit(ast) + + introduced_change = False + + print(CGenerator().visit(ast)) + + tmp = tempfile.NamedTemporaryFile() + with open(tmp.name, "w") as f: + f.write(CGenerator().visit(ast)) + + return ModifiedFileResult(tmp, introduced_change, renamed_anything) + except: + return None + + +@dataclasses.dataclass +class ModifiedFileResult: + tmp: tempfile.NamedTemporaryFile + introduced_changes: bool + renamed_anything: bool + + +@dataclasses.dataclass +class LocalVar: + name: str + type: str + new_name: str + + +@dataclasses.dataclass +class TaskRenameLocals: + introduce_changes: bool + + +@dataclasses.dataclass +class TaskRenameFunction: + def __init__(self): + self + + +if __name__ == '__main__': + # result = create_modified_file(Path("scripts/test.c"), TaskRenameFunction()) + # print(result.introduced_changes) + # result.tmp.close() + main() diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 0b81b3a718..8a85f54854 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -56,11 +56,11 @@ let getFunctionAndGVarMap (ast: file) : f StringMap.t * v StringMap.t = | _ -> functionMap, gvarMap ) (StringMap.empty, StringMap.empty) -let performRenames (renamesOnSuccess: renamesOnSuccess) = +let performRenames (renamesOnSuccess: renamesOnSuccess) = begin - let (compinfoRenames, enumRenames) = renamesOnSuccess in - List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname) compinfoRenames; - List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; + let (compinfoRenames, enumRenames) = renamesOnSuccess in + List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname) compinfoRenames; + List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; end let getDependencies fromEq = VarinfoMap.map (fun assumption -> assumption.new_method_name) fromEq @@ -115,14 +115,17 @@ let registerGVarMapping oldV nowV data = { reverseMapping=data.reverseMapping; } +(*True iff the global var rename assumptions contains only entries that are identity mappings*) +let areGlobalVarRenameAssumptionsEmpty (mapping: glob_var_rename_assumptions) : bool = + VarinfoMap.for_all (fun varinfo newName -> varinfo.vname = newName) mapping (*returns true iff for all dependencies it is true, that the dependency has a corresponding function with the new name and matches the without having dependencies itself and the new name is not already present on the old AST. *) -let doAllDependenciesMatch (dependencies: functionDependencies) -(global_var_dependencies: glob_var_rename_assumptions) -(oldFunctionMap: f StringMap.t) -(nowFunctionMap: f StringMap.t) -(oldGVarMap: v StringMap.t) -(nowGVarMap: v StringMap.t) (data: carryType) : bool * carryType = +let doAllDependenciesMatch (dependencies: functionDependencies) + (global_var_dependencies: glob_var_rename_assumptions) + (oldFunctionMap: f StringMap.t) + (nowFunctionMap: f StringMap.t) + (oldGVarMap: v StringMap.t) + (nowGVarMap: v StringMap.t) (data: carryType) : bool * carryType = let isConsistent = fun old nowName allEqual getName getGlobal oldMap nowMap getNowOption data -> (*Early cutoff if a previous dependency returned false. @@ -142,31 +145,39 @@ let doAllDependenciesMatch (dependencies: functionDependencies) let nowElemOption = getNowOption nowName in match nowElemOption with - | Some(nowElem) -> - let compare = fun old now -> - match (old, now) with - | Fundec(oF), Fundec(nF) -> - let doMatch, _, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF oF nF None VarinfoMap.empty VarinfoMap.empty in - doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess - | GlobalVar(oV), GlobalVar(nV) -> - let (equal, (_, function_dependencies, global_var_dependencies, renamesOnSuccess)) = eq_varinfo oV nV emptyRenameMapping in - (*eq_varinfo always comes back with a self dependency. We need to filter that out.*) - equal, function_dependencies, (VarinfoMap.filter (fun vi name -> not (vi.vname = oV.vname && name = nowName)) global_var_dependencies), renamesOnSuccess - | _, _ -> failwith "Unknown or incompatible global types" - in - - - let doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess = compare globalElem nowElem in - - (*let _ = Printf.printf "%s <-> %s: %b %b %b\n" (getName old) (globalElemName nowElem) doMatch (StringMap.is_empty function_dependencies) (VarinfoMap.is_empty global_var_dependencies) in - - let _ = Printf.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in - *) - if doMatch && VarinfoMap.is_empty function_dependencies && VarinfoMap.is_empty global_var_dependencies then - let _ = performRenames renamesOnSuccess in - true, registerMapping globalElem nowElem data - else false, data - + | Some(nowElem) -> ( + let compare = fun old now -> + match (old, now) with + | Fundec(oF), Fundec(nF) -> + let doMatch, _, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF oF nF None VarinfoMap.empty VarinfoMap.empty in + doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess + | GlobalVar(oV), GlobalVar(nV) -> + let (equal, (_, function_dependencies, global_var_dependencies, renamesOnSuccess)) = eq_varinfo oV nV emptyRenameMapping in + (*eq_varinfo always comes back with a self dependency. We need to filter that out.*) + equal, function_dependencies, (VarinfoMap.filter (fun vi name -> not (vi.vname = oV.vname && name = nowName)) global_var_dependencies), renamesOnSuccess + | _, _ -> failwith "Unknown or incompatible global types" + in + + + let doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess = compare globalElem nowElem in + + (*let _ = Printf.printf "%s <-> %s: %b %b %b\n" (getName old) (globalElemName nowElem) doMatch (StringMap.is_empty function_dependencies) (VarinfoMap.is_empty global_var_dependencies) in + + let _ = Printf.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in + *) + + (*Having a dependency on yourself is ok.*) + let hasNoExternalDependency = VarinfoMap.is_empty function_dependencies || ( + VarinfoMap.cardinal function_dependencies = 1 && ( + VarinfoMap.fold (fun varinfo dependency _ -> varinfo.vname = globalElemName globalElem && dependency.new_method_name = globalElemName nowElem) function_dependencies true + ) + ) in + + if doMatch && hasNoExternalDependency && areGlobalVarRenameAssumptionsEmpty global_var_dependencies then + let _ = performRenames renamesOnSuccess in + true, registerMapping globalElem nowElem data + else false, data + ) | None -> false, data else false, data @@ -235,15 +246,15 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap. let doMatch, unchangedHeader, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f newFun None VarinfoMap.empty VarinfoMap.empty in - (*Before renamesOnSuccess, functions with the same name have always been compared. + (*Before renamesOnSuccess, functions with the same name have always been compared. In this comparison, the renaming on compinfo and enum was always performed, no matter if the comparison was a success or not. This call mimics this behaviour.*) let _ = performRenames renamesOnSuccess in - (*let _ = Pretty.printf "%s <-> %s: %b %s\n" f.svar.vname newFun.svar.vname doMatch (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in + let _ = Pretty.printf "%s <-> %s: %b %s\n" f.svar.vname newFun.svar.vname doMatch (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies, ([], []))) in let _ = Pretty.printf "old locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) f.slocals)) in - let _ = Pretty.printf "now locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) newFun.slocals)) in*) + let _ = Pretty.printf "now locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) newFun.slocals)) in let actDependencies = getDependencies function_dependencies in diff --git a/tests/incremental/05-method-rename/08-recursive_rename.c b/tests/incremental/05-method-rename/08-recursive_rename.c new file mode 100644 index 0000000000..dc9ac72e94 --- /dev/null +++ b/tests/incremental/05-method-rename/08-recursive_rename.c @@ -0,0 +1,7 @@ +void foo(int x) { + if(x > 1) foo(x - 1); +} + +int main() { + foo(10); +} diff --git a/tests/incremental/05-method-rename/08-recursive_rename.json b/tests/incremental/05-method-rename/08-recursive_rename.json new file mode 100644 index 0000000000..0db3279e44 --- /dev/null +++ b/tests/incremental/05-method-rename/08-recursive_rename.json @@ -0,0 +1,3 @@ +{ + +} diff --git a/tests/incremental/05-method-rename/08-recursive_rename.patch b/tests/incremental/05-method-rename/08-recursive_rename.patch new file mode 100644 index 0000000000..42469f434c --- /dev/null +++ b/tests/incremental/05-method-rename/08-recursive_rename.patch @@ -0,0 +1,13 @@ +--- tests/incremental/05-method-rename/08-recursive_rename.c ++++ tests/incremental/05-method-rename/08-recursive_rename.c +@@ -1,7 +1,7 @@ +-void foo(int x) { +- if(x > 1) foo(x - 1); ++void bar(int x) { ++ if(x > 1) bar(x - 1); + } + + int main() { +- foo(10); ++ bar(10); + } From f8dba3e8598f2b0cc0b8ea75d4bc50341f027488 Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Sat, 16 Jul 2022 16:15:17 +0200 Subject: [PATCH 064/518] Added doc on how to support library headers. --- scripts/test-refactorings-rename.py | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/scripts/test-refactorings-rename.py b/scripts/test-refactorings-rename.py index 4d3fd70edb..4339113eac 100644 --- a/scripts/test-refactorings-rename.py +++ b/scripts/test-refactorings-rename.py @@ -22,14 +22,17 @@ introduced_changes = 0 renamed_a_function = 0 +# to support library headers, first clone https://github.com/eliben/pycparser to the directory next of the analyzer folder. +# Then comment the lines out and in that are described that way. + def main(): regression_folder = Path("./tests/regression") - task = TaskRenameFunction() + task = TaskRenameLocals(False) - # test = regression_folder / "23-partitioned_arrays_last/06-interprocedural.c" - # execute_validation_test(test.parent, test, task) - # return + test = regression_folder / "25-vla/02-loop.c" + execute_validation_test(test.parent, test, task) + return excluded = [ "44-trier_analyzer/33-recA.c", @@ -110,6 +113,7 @@ def execute_validation_test(folder: Path, test_file: Path, task): print("Skipped test.") skips += 1 return False + # comment this if out if you want to support library headers if any(x.startswith("#include") for x in lines): print("Skipped test because of include") includes += 1 @@ -141,6 +145,16 @@ def execute_validation_test(folder: Path, test_file: Path, task): args = f"--enable dbg.debug --enable printstats -v {extra_params}" + # uncomment to support library headers. + # with tempfile.NamedTemporaryFile() as t: + # subprocess.run(f"cpp -E -I../pycparser/utils/fake_libc_include {test_file} > {t.name}", shell=True) + # + # + # x = subprocess.run(f"./goblint {args} --enable incremental.save {t.name}", shell=True, text=True, capture_output=True) + # if x.returncode != 0: + # includes += 1 + # return False + subprocess.run(f"./goblint {args} --enable incremental.save {test_file}", shell=True, capture_output=True) command = subprocess.run( @@ -349,6 +363,10 @@ def visit_ID(self, node): def create_modified_file(source_file: Path, task): try: + # uncommet to support library headers. + # gcc = subprocess.run(f"cpp -E -I../pycparser/utils/fake_libc_include {source_file}", shell=True, capture_output=True, text=True) + + # ast = c_parser.CParser().parse(gcc.stdout) ast = parse_file(source_file, use_cpp=True) introduced_change = False @@ -389,7 +407,7 @@ def create_modified_file(source_file: Path, task): introduced_change = False - print(CGenerator().visit(ast)) + # print(CGenerator().visit(ast)) tmp = tempfile.NamedTemporaryFile() with open(tmp.name, "w") as f: From d9a7c935f145586f7795dcd69f730ab7b912c01c Mon Sep 17 00:00:00 2001 From: Tim Ortel <100865202+TimOrtel@users.noreply.github.com> Date: Tue, 26 Jul 2022 19:54:44 +0200 Subject: [PATCH 065/518] Fixed a couple of bugs --- src/incremental/compareCIL.ml | 17 +- src/incremental/detectRenamedFunctions.ml | 191 +++++++++++++--------- 2 files changed, 131 insertions(+), 77 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 0e494075d1..5450ef2934 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -10,12 +10,11 @@ let empty_change_info () : change_info = {added = []; removed = []; changed = [] let eq_glob (a: global) (b: global) (cfgs : (cfg * (cfg * cfg)) option) = match a, b with | GFun (f,_), GFun (g,_) -> - let identical, unchangedHeader, diffOpt, _, _, renamesOnSuccess = CompareGlobals.eqF f g cfgs VarinfoMap.empty VarinfoMap.empty in + let identical, unchangedHeader, diffOpt, funDep, globVarDep, renamesOnSuccess = CompareGlobals.eqF f g cfgs VarinfoMap.empty VarinfoMap.empty in (*Perform renames no matter what.*) let _ = performRenames renamesOnSuccess in - - identical, unchangedHeader, diffOpt + identical && VarinfoMap.is_empty funDep && areGlobalVarRenameAssumptionsEmpty globVarDep, unchangedHeader, diffOpt | GVar (x, init_x, _), GVar (y, init_y, _) -> eq_varinfo x y emptyRenameMapping |> fst, false, None (* ignore the init_info - a changed init of a global will lead to a different start state *) | GVarDecl (x, _), GVarDecl (y, _) -> eq_varinfo x y emptyRenameMapping |> fst, false, None | _ -> ignore @@ Pretty.printf "Not comparable: %a and %a\n" Cil.d_global a Cil.d_global b; false, false, None @@ -102,6 +101,18 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = Cil.iterGlobals newAST (fun glob -> findChanges oldMap glob); + if not (GobConfig.get_bool "incremental.detect-global-renames") then ( + let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in + + let checkExists map global = + match identifier_of_global global with + | name -> GlobalMap.mem name map + | exception Not_found -> true (* return true, so isn't considered a change *) + in + + Cil.iterGlobals newAST (fun glob -> if not (checkExists oldMap glob) then (changes.added <- (glob::changes.added))); + Cil.iterGlobals oldAST (fun glob -> if not (checkExists newMap glob) then (changes.removed <- (glob::changes.removed))); + ); changes (** Given an (optional) equality function between [Cil.global]s, an old and a new [Cil.file], this function computes a [change_info], diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 8a85f54854..603b7c28ce 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -14,6 +14,10 @@ let globalElemName elem = match elem with | Fundec(f) -> f.svar.vname | GlobalVar(v) -> v.vname +let globalElemName2 elem = match elem with + | Fundec(f) -> "Fundec(" ^ f.svar.vname ^ ")" + | GlobalVar(v) -> "GlobalVar(" ^ v.vname ^ ")" + module GlobalElemForMap = struct type t = globalElem @@ -78,6 +82,13 @@ type carryType = { reverseMapping: globalElem GlobalElemMap.t; } +let emptyCarryType = { + statusForOldElem = GlobalElemMap.empty; + statusForNowElem = GlobalElemMap.empty; + mapping = GlobalElemMap.empty; + reverseMapping = GlobalElemMap.empty; +} + (*Carry type manipulation functions.*) let registerStatusForOldF f status data = @@ -136,10 +147,13 @@ let doAllDependenciesMatch (dependencies: functionDependencies) let globalElem = getGlobal old in let knownMapping = GlobalElemMap.find_opt globalElem data.mapping in + (*let _ = Printf.printf "Dep: %s -> %s\n" (globalElemName2 globalElem) nowName in*) + (*To avoid inconsitencies, if a function has already been mapped to a function, that mapping is reused again.*) match knownMapping with | Some(knownElem) -> (*This function has already been mapped*) + (*let _ = Printf.printf "Already mapped. %s = %s\n" (globalElemName2 knownElem) nowName in*) globalElemName knownElem = nowName, data | None -> let nowElemOption = getNowOption nowName in @@ -161,11 +175,6 @@ let doAllDependenciesMatch (dependencies: functionDependencies) let doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess = compare globalElem nowElem in - (*let _ = Printf.printf "%s <-> %s: %b %b %b\n" (getName old) (globalElemName nowElem) doMatch (StringMap.is_empty function_dependencies) (VarinfoMap.is_empty global_var_dependencies) in - - let _ = Printf.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies)) in - *) - (*Having a dependency on yourself is ok.*) let hasNoExternalDependency = VarinfoMap.is_empty function_dependencies || ( VarinfoMap.cardinal function_dependencies = 1 && ( @@ -173,13 +182,19 @@ let doAllDependenciesMatch (dependencies: functionDependencies) ) ) in + (*let _ = Printf.printf "%s <-> %s: %b %b %b\n" (globalElemName2 globalElem) (globalElemName2 nowElem) doMatch hasNoExternalDependency (VarinfoMap.is_empty global_var_dependencies) in + + let _ = Printf.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies, ([], []))) in*) + if doMatch && hasNoExternalDependency && areGlobalVarRenameAssumptionsEmpty global_var_dependencies then let _ = performRenames renamesOnSuccess in true, registerMapping globalElem nowElem data else false, data ) | None -> - false, data + (*Printf.printf "No elem with name %s found \n" nowName;*) + (*Return true assumes external globs never change. Which is ok for now*) + true, data else false, data in @@ -226,75 +241,62 @@ let assignStatusToUnassignedElem data f registerStatus statusMap mapping status else data -let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap.t = begin - let oldFunctionMap, oldGVarMap = getFunctionAndGVarMap oldAST in - let nowFunctionMap, nowGVarMap = getFunctionAndGVarMap newAST in - - let initialData: carryType = {statusForOldElem = GlobalElemMap.empty; - statusForNowElem = GlobalElemMap.empty; - mapping=GlobalElemMap.empty; - reverseMapping=GlobalElemMap.empty; - } in - - (*Go through all functions, for all that have not been renamed *) - let finalData = - StringMap.fold (fun _ (f, _) (data: carryType) -> - let matchingNewFundec = StringMap.find_opt f.svar.vname nowFunctionMap in - match matchingNewFundec with - | Some (newFun, _) -> - (*Compare if they are similar*) - let doMatch, unchangedHeader, _, function_dependencies, global_var_dependencies, renamesOnSuccess = - CompareGlobals.eqF f newFun None VarinfoMap.empty VarinfoMap.empty in - - (*Before renamesOnSuccess, functions with the same name have always been compared. - In this comparison, the renaming on compinfo and enum was always performed, no matter if the comparison - was a success or not. This call mimics this behaviour.*) - let _ = performRenames renamesOnSuccess in - - let _ = Pretty.printf "%s <-> %s: %b %s\n" f.svar.vname newFun.svar.vname doMatch (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies, ([], []))) in - - let _ = Pretty.printf "old locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) f.slocals)) in - let _ = Pretty.printf "now locals: %s\n" (String.concat ", " (List.map (fun x -> x.vname) newFun.slocals)) in - - - let actDependencies = getDependencies function_dependencies in +let findSameNameMatchingGVars oldGVarMap nowGVarMap data = + StringMap.fold (fun _ (v, _, _) (data: carryType) -> + let matchingNowGvar = StringMap.find_opt v.vname nowGVarMap in + match matchingNowGvar with + | Some (nowGvar, _, _) -> ( + let identical, _ = eq_varinfo v nowGvar emptyRenameMapping in - let oldG = Fundec(f) in - let nowG = Fundec(newFun) in + let oldG, nowG = GlobalVar v, GlobalVar nowGvar in - - if doMatch then - let doDependenciesMatch, updatedData = doAllDependenciesMatch actDependencies global_var_dependencies oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap data in - if doDependenciesMatch then - registerBiStatus oldG nowG (SameName(oldG)) updatedData - else - registerStatusForOldF oldG (Modified(nowG, unchangedHeader)) data |> - registerStatusForNowF nowG (Modified(oldG, unchangedHeader)) + if identical then + registerBiStatus (GlobalVar v) (GlobalVar nowGvar) (SameName (GlobalVar nowGvar)) data else - registerStatusForOldF oldG (Modified(nowG, unchangedHeader)) data |> - registerStatusForNowF nowG (Modified(oldG, unchangedHeader)) - | None -> data - ) oldFunctionMap initialData |> - (*At this point we already know of the functions that have changed and stayed the same. We now assign the correct status to all the functions that - have been mapped. The functions that have not been mapped are added/removed.*) - (*Now go through all old functions again. Those who have not been assigned a status are removed*) - StringMap.fold (fun _ (f, _) (data: carryType) -> - assignStatusToUnassignedElem data (Fundec(f)) registerStatusForOldF data.statusForOldElem data.mapping Deleted - ) oldFunctionMap |> - (*now go through all new functions. Those have have not been assigned a mapping are added.*) - StringMap.fold (fun _ (nowF, _) (data: carryType) -> - assignStatusToUnassignedElem data (Fundec(nowF)) registerStatusForNowF data.statusForNowElem data.reverseMapping Created - ) nowFunctionMap |> - StringMap.fold (fun _ (v, _, _) data -> - assignStatusToUnassignedElem data (GlobalVar(v)) registerStatusForOldF data.statusForOldElem data.mapping Deleted - ) oldGVarMap |> - StringMap.fold (fun _ (nowV, _, _) (data: carryType) -> - assignStatusToUnassignedElem data (GlobalVar(nowV)) registerStatusForNowF data.statusForNowElem data.reverseMapping Created - ) nowGVarMap - in - - (*Done with the analyis, the following just adjusts the output types.*) - + registerStatusForOldF oldG (Modified(nowG, false)) data |> + registerStatusForNowF nowG (Modified(oldG, false)) + ) + | None -> data + ) oldGVarMap data + +(*Goes through all old functions and looks for now-functions with the same name. If a pair has been found, onMatch is called with the comparison result. + On match then modifies the carryType. Returns (list of the functions that have the same name and match, the updated carry type)*) +let findSameNameMatchingFunctions + oldFunctionMap + nowFunctionMap + (initialData: 'a) + (onMatch: fundec -> fundec -> bool -> bool -> string VarinfoMap.t -> CompareGlobals.glob_var_rename_assumptions -> CompareGlobals.renamesOnSuccess -> 'a -> 'a) : 'a = + StringMap.fold (fun _ (f, _) (data: 'a) -> + let matchingNewFundec = StringMap.find_opt f.svar.vname nowFunctionMap in + match matchingNewFundec with + | Some (newFun, _) -> + (*Compare if they are similar*) + let doMatch, unchangedHeader, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f newFun None VarinfoMap.empty VarinfoMap.empty in + + let actDependencies = getDependencies function_dependencies in + + onMatch f newFun doMatch unchangedHeader actDependencies global_var_dependencies renamesOnSuccess data + | None -> data + ) oldFunctionMap initialData + +let fillStatusForUnassignedElems oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap (data: carryType) = + data |> + (*Now go through all old functions again. Those who have not been assigned a status are removed*) + StringMap.fold (fun _ (f, _) (data: carryType) -> + assignStatusToUnassignedElem data (Fundec f) registerStatusForOldF data.statusForOldElem data.mapping Deleted + ) oldFunctionMap |> + (*now go through all new functions. Those have have not been assigned a mapping are added.*) + StringMap.fold (fun _ (nowF, _) (data: carryType) -> + assignStatusToUnassignedElem data (Fundec nowF) registerStatusForNowF data.statusForNowElem data.reverseMapping Created + ) nowFunctionMap |> + StringMap.fold (fun _ (v, _, _) data -> + assignStatusToUnassignedElem data (GlobalVar(v)) registerStatusForOldF data.statusForOldElem data.mapping Deleted + ) oldGVarMap |> + StringMap.fold (fun _ (nowV, _, _) (data: carryType) -> + assignStatusToUnassignedElem data (GlobalVar(nowV)) registerStatusForNowF data.statusForNowElem data.reverseMapping Created + ) nowGVarMap + +let mapAnalysisResultToOutput oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap (data: carryType) : output GlobalElemMap.t = (*Map back to GFun and exposed function status*) let extractOutput funMap invertedFunMap gvarMap invertedGvarMap f (s: status) = let getGlobal gT fundecMap gVarMap = @@ -323,6 +325,47 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap. else if Option.is_some b then b else None ) - (GlobalElemMap.mapi (extractOutput oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap) finalData.statusForOldElem) - (GlobalElemMap.mapi (extractOutput nowFunctionMap oldFunctionMap nowGVarMap oldGVarMap) finalData.statusForNowElem) + (GlobalElemMap.mapi (extractOutput oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap) data.statusForOldElem) + (GlobalElemMap.mapi (extractOutput nowFunctionMap oldFunctionMap nowGVarMap oldGVarMap) data.statusForNowElem) + +let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap.t = begin + let oldFunctionMap, oldGVarMap = getFunctionAndGVarMap oldAST in + let nowFunctionMap, nowGVarMap = getFunctionAndGVarMap newAST in + + (*let show x = [%show: (string * string) list] (StringMap.to_seq x |> Seq.map (fun (name, (v, _, _)) -> (name, v.vname)) |> List.of_seq) in + + let _ = Printf.printf "oldGvarMap: %s" (show oldGVarMap) in + let _ = Printf.printf "nowGvarMap: %s" (show nowGVarMap) in*) + + + let initialData: carryType = findSameNameMatchingGVars oldGVarMap nowGVarMap emptyCarryType in + + (*Go through all functions, for all that have not been renamed *) + let finalData = findSameNameMatchingFunctions oldFunctionMap nowFunctionMap initialData (fun oldF nowF doMatch unchangedHeader functionDependencies global_var_dependencies renamesOnSuccess data -> + let oldG = Fundec(oldF) in + let nowG = Fundec(nowF) in + + (*let _ = Printf.printf "1. Same Name: %s <-> %s: %b, %b\n" oldF.svar.vname nowF.svar.vname doMatch unchangedHeader in*) + + if doMatch then + let doDependenciesMatch, updatedData = doAllDependenciesMatch functionDependencies global_var_dependencies oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap data in + + (*let _ = Printf.printf "2. Same Name: %s <-> %s: %b\n" oldF.svar.vname nowF.svar.vname doDependenciesMatch in*) + + if doDependenciesMatch then + registerBiStatus oldG nowG (SameName(oldG)) updatedData + else + registerStatusForOldF oldG (Modified(nowG, unchangedHeader)) data |> + registerStatusForNowF nowG (Modified(oldG, unchangedHeader)) + else + registerStatusForOldF oldG (Modified(nowG, unchangedHeader)) data |> + registerStatusForNowF nowG (Modified(oldG, unchangedHeader)) + ) |> + (*At this point we already know of the functions that have changed and stayed the same. We now assign the correct status to all the functions that + have been mapped. The functions that have not been mapped are added/removed.*) + fillStatusForUnassignedElems oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap + in + + (*Done with the analyis, the following just adjusts the output types.*) + mapAnalysisResultToOutput oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap finalData end From 52de056a1840b83d6b3d3f0e536dcfb17759c343 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 16:55:32 +0200 Subject: [PATCH 066/518] Simplify Lockset --- src/cdomains/lockDomain.ml | 25 +++++-------------------- 1 file changed, 5 insertions(+), 20 deletions(-) diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 0ebcf4a8a5..e8a83c68ce 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -41,13 +41,7 @@ struct ) end - (* TODO: use SetDomain.Reverse *) - module ReverseAddrSet = SetDomain.ToppedSet (Lock) - (struct let topname = "All mutexes" end) - - module AddrSet = Lattice.Reverse (ReverseAddrSet) - - include AddrSet + include SetDomain.Reverse(SetDomain.ToppedSet (Lock) (struct let topname = "All mutexes" end)) let rec may_be_same_offset of1 of2 = match of1, of2 with @@ -60,7 +54,7 @@ struct let add (addr,rw) set = match (Addr.to_var_offset addr) with - | Some (_,x) when Offs.is_definite x -> ReverseAddrSet.add (addr,rw) set + | Some (_,x) when Offs.is_definite x -> add (addr,rw) set | _ -> set let remove (addr,rw) set = @@ -71,18 +65,9 @@ struct | None -> false in match (Addr.to_var_offset addr) with - | Some (_,x) when Offs.is_definite x -> ReverseAddrSet.remove (addr,rw) set - | Some x -> ReverseAddrSet.filter (collect_diff_varinfo_with x) set - | _ -> AddrSet.top () - - let empty = ReverseAddrSet.empty - let is_empty = ReverseAddrSet.is_empty - - let filter = ReverseAddrSet.filter - let fold = ReverseAddrSet.fold - let singleton = ReverseAddrSet.singleton - let mem = ReverseAddrSet.mem - let exists = ReverseAddrSet.exists + | Some (_,x) when Offs.is_definite x -> remove (addr,rw) set + | Some x -> filter (collect_diff_varinfo_with x) set + | _ -> top () let export_locks ls = let f (x,_) set = Mutexes.add x set in From dde2b1af91fa841977f7b77e2cf8571ca9b383a3 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 17:12:31 +0200 Subject: [PATCH 067/518] Steps --- src/analyses/mayLocks.ml | 13 +++++--- src/cdomains/lockDomain.ml | 5 +++ tests/regression/60-doublelocking/01-simple.c | 33 +++++++++++++++++++ 3 files changed, 46 insertions(+), 5 deletions(-) create mode 100644 tests/regression/60-doublelocking/01-simple.c diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 182b93ff3e..ed5003f1be 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -2,17 +2,20 @@ open Analyses -module Arg = +module Arg:LocksetAnalysis.MayArg = struct - module D = LockDomain.MayLockset + module D = LockDomain.MayLocksetNoRW module G = DefaultSpec.G module V = DefaultSpec.V - let add ctx l = - D.add l ctx.local + let add ctx (l,_) = + if D.mem l ctx.local then + (M.warn "double locking"; ctx.local) + else + D.add l ctx.local let remove ctx l = - D.remove (l, true) (D.remove (l, false) ctx.local) + D.remove l (D.remove l ctx.local) end module Spec = diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index e8a83c68ce..65bd41b372 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -84,6 +84,11 @@ struct let bot = Lockset.top end +module MayLocksetNoRW = +struct + include ValueDomain.AddrSetDomain +end + module Symbolic = struct (* TODO: use SetDomain.Reverse *) diff --git a/tests/regression/60-doublelocking/01-simple.c b/tests/regression/60-doublelocking/01-simple.c new file mode 100644 index 0000000000..8c935f4cc4 --- /dev/null +++ b/tests/regression/60-doublelocking/01-simple.c @@ -0,0 +1,33 @@ +// PARAM: --set ana.activated[+] 'maylocks' +#include +#include +#include +#include + +int g; + +pthread_mutex_t mut = PTHREAD_MUTEX_INITIALIZER; + +void* f1(void* ptr) { + int top; + + g = 1; + if(top) { + pthread_mutex_lock(&mut); + } + pthread_mutex_lock(&mut); //WARN + pthread_mutex_unlock(&mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_t t2; + + pthread_create(&t1,NULL,f1,NULL); + pthread_join(t1, NULL); + + return 0; +} From c982337b117dcbef7447a165a05ed9266923f414 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 17:14:48 +0200 Subject: [PATCH 068/518] Add case where no warning should be issued --- tests/regression/60-doublelocking/01-simple.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/regression/60-doublelocking/01-simple.c b/tests/regression/60-doublelocking/01-simple.c index 8c935f4cc4..f2c961cb63 100644 --- a/tests/regression/60-doublelocking/01-simple.c +++ b/tests/regression/60-doublelocking/01-simple.c @@ -29,5 +29,8 @@ int main(int argc, char const *argv[]) pthread_create(&t1,NULL,f1,NULL); pthread_join(t1, NULL); + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_unlock(&mut); + return 0; } From 37155af27b9b4d45af625c230a660069b3423978 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 17:26:46 +0200 Subject: [PATCH 069/518] More tests --- src/cdomains/lockDomain.ml | 2 +- .../regression/60-doublelocking/02-unknown.c | 43 +++++++++++++++++++ 2 files changed, 44 insertions(+), 1 deletion(-) create mode 100644 tests/regression/60-doublelocking/02-unknown.c diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 65bd41b372..923e247902 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -86,7 +86,7 @@ end module MayLocksetNoRW = struct - include ValueDomain.AddrSetDomain + include PreValueDomain.AD end module Symbolic = diff --git a/tests/regression/60-doublelocking/02-unknown.c b/tests/regression/60-doublelocking/02-unknown.c new file mode 100644 index 0000000000..3c533227c3 --- /dev/null +++ b/tests/regression/60-doublelocking/02-unknown.c @@ -0,0 +1,43 @@ +// PARAM: --set ana.activated[+] 'maylocks' +#include +#include +#include +#include + +pthread_mutex_t mut[8]; + +void* f1(void* ptr) { + int top; + int x = 2; + if(top) { + x = 3; + } + + void* ptr2; + if(top) { + ptr2 = &mut[x]; + } else { + ptr2 = &mut[3]; + } + + + pthread_mutex_lock(&(mut[x])); + pthread_mutex_lock(&(mut[3])); //WARN + pthread_mutex_unlock(&mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_t t2; + + pthread_create(&t1,NULL,f1,NULL); + pthread_join(t1, NULL); + + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_unlock(&mut); + + return 0; +} From 24c75636f462201bcb5fc97b18d94e64aa10859d Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 17:29:25 +0200 Subject: [PATCH 070/518] Rm spurious code --- src/analyses/mayLocks.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index ed5003f1be..eeadee3453 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -14,8 +14,7 @@ struct else D.add l ctx.local - let remove ctx l = - D.remove l (D.remove l ctx.local) + let remove ctx l = D.remove l ctx.local end module Spec = From 06f98a91338c69ab159a95cae9e01f755b8d4419 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 17:29:58 +0200 Subject: [PATCH 071/518] Adapt comments --- src/analyses/mayLocks.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index eeadee3453..0ea1f04393 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -1,4 +1,4 @@ -(** May lockset analysis (unused). *) +(** May lockset analysis and analysis of double locking. *) open Analyses From 28dc103dfabbff6daf8a23ab77006e497523696b Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 17:32:49 +0200 Subject: [PATCH 072/518] Cleanup test --- tests/regression/60-doublelocking/02-unknown.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/regression/60-doublelocking/02-unknown.c b/tests/regression/60-doublelocking/02-unknown.c index 3c533227c3..f7c55b13fb 100644 --- a/tests/regression/60-doublelocking/02-unknown.c +++ b/tests/regression/60-doublelocking/02-unknown.c @@ -21,9 +21,9 @@ void* f1(void* ptr) { } - pthread_mutex_lock(&(mut[x])); - pthread_mutex_lock(&(mut[3])); //WARN - pthread_mutex_unlock(&mut); + pthread_mutex_lock(&mut[x]); + pthread_mutex_lock(&mut[3]); //WARN + pthread_mutex_unlock(&mut[3]); return NULL; } From 575cb5422f75bf129058bb98f5573abdf0b2e5c1 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 17:45:20 +0200 Subject: [PATCH 073/518] Add warning if MayLockset is not empty --- src/analyses/mayLocks.ml | 4 ++ .../03-thread-exit-with-mutex.c | 41 +++++++++++++++++++ 2 files changed, 45 insertions(+) create mode 100644 tests/regression/60-doublelocking/03-thread-exit-with-mutex.c diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 0ea1f04393..ac787bb756 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -23,6 +23,10 @@ struct let name () = "maylocks" let exitstate v = D.top () (* TODO: why? *) + + let return ctx exp fundec = + if not @@ D.is_bot ctx.local && ThreadReturn.is_current (Analyses.ask_of_ctx ctx) then M.warn "Exiting thread while still holding a mutex!"; + ctx.local end let _ = diff --git a/tests/regression/60-doublelocking/03-thread-exit-with-mutex.c b/tests/regression/60-doublelocking/03-thread-exit-with-mutex.c new file mode 100644 index 0000000000..50609631b9 --- /dev/null +++ b/tests/regression/60-doublelocking/03-thread-exit-with-mutex.c @@ -0,0 +1,41 @@ +// PARAM: --set ana.activated[+] 'maylocks' +#include +#include +#include +#include + +pthread_mutex_t mut[8]; + +void* f1(void* ptr) { + int top; + int x = 2; + if(top) { + x = 3; + } + + void* ptr2; + if(top) { + ptr2 = &mut[x]; + } else { + ptr2 = &mut[3]; + } + + + pthread_mutex_lock(&mut[x]); + return NULL; //WARN +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_t t2; + + pthread_create(&t1,NULL,f1,NULL); + pthread_join(t1, NULL); + + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_unlock(&mut); + + return 0; //NOWARN +} From 430c376f3d729139a87365c2e3226b6aea114fe0 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 17:54:57 +0200 Subject: [PATCH 074/518] Account for returning from thread via pthread_exit --- src/analyses/mayLocks.ml | 10 +++++++++- .../60-doublelocking/03-thread-exit-with-mutex.c | 5 +++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index ac787bb756..cc88c92b79 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -1,6 +1,7 @@ (** May lockset analysis and analysis of double locking. *) - open Analyses +open GoblintCil +module LF = LibraryFunctions module Arg:LocksetAnalysis.MayArg = struct @@ -27,6 +28,13 @@ struct let return ctx exp fundec = if not @@ D.is_bot ctx.local && ThreadReturn.is_current (Analyses.ask_of_ctx ctx) then M.warn "Exiting thread while still holding a mutex!"; ctx.local + + let special ctx (lv:lval option) (f: varinfo) (args: exp list) = + (match(LF.find f).special args with + | ThreadExit _ -> if not @@ D.is_bot ctx.local then M.warn "Exiting thread while still holding a mutex!" + | _ -> ()) + ; + ctx.local end let _ = diff --git a/tests/regression/60-doublelocking/03-thread-exit-with-mutex.c b/tests/regression/60-doublelocking/03-thread-exit-with-mutex.c index 50609631b9..3014a044a9 100644 --- a/tests/regression/60-doublelocking/03-thread-exit-with-mutex.c +++ b/tests/regression/60-doublelocking/03-thread-exit-with-mutex.c @@ -22,6 +22,11 @@ void* f1(void* ptr) { pthread_mutex_lock(&mut[x]); + + if(top) { + pthread_exit(5); //WARN + } + return NULL; //WARN } From f471f471ea06b7e1a96ae6f8606c02b6dd1462a7 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Sep 2022 18:15:05 +0200 Subject: [PATCH 075/518] Add warning when unlocking mutex that may not held --- src/analyses/mutexAnalysis.ml | 2 ++ tests/regression/60-doublelocking/04-unlock.c | 35 +++++++++++++++++++ 2 files changed, 37 insertions(+) create mode 100644 tests/regression/60-doublelocking/04-unlock.c diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 5187862be8..56fd48bd9b 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -71,6 +71,7 @@ struct D.add l ctx.local let remove ctx l = + if not @@ D.mem (l,true) ctx.local && not @@ D.mem (l,false) ctx.local then M.warn "unlocking mutex which may not be held"; D.remove (l, true) (D.remove (l, false) ctx.local) let remove_all ctx = @@ -78,6 +79,7 @@ struct ctx.emit (MustUnlock m) ) (D.export_locks ctx.local); *) (* TODO: used to have remove_nonspecial, which kept v.vname.[0] = '{' variables *) + M.warn "unlocking unknown mutex which may not be held"; D.empty () end include LocksetAnalysis.MakeMust (Arg) diff --git a/tests/regression/60-doublelocking/04-unlock.c b/tests/regression/60-doublelocking/04-unlock.c new file mode 100644 index 0000000000..1cc5f26654 --- /dev/null +++ b/tests/regression/60-doublelocking/04-unlock.c @@ -0,0 +1,35 @@ +#include +#include +#include +#include + +int g; + +pthread_mutex_t mut = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t mut2 = PTHREAD_MUTEX_INITIALIZER; +pthread_cond_t cond = PTHREAD_COND_INITIALIZER; + +void* f1(void* ptr) { + int top; + + pthread_mutex_lock(&mut); + pthread_mutex_unlock(&mut2); //WARN + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_t t2; + + pthread_create(&t1,NULL,f1,NULL); + pthread_join(t1, NULL); + + pthread_mutex_lock(&mut); + pthread_mutex_unlock(&mut); //NOWARN + + pthread_cond_wait(&cond,&mut); //WARN + + return 0; +} From 014481edb9820aab0eea3392b3d0347d5654c6e9 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 25 Sep 2022 15:04:29 +0200 Subject: [PATCH 076/518] Rudimentary, flow-insensitive analysis of mutex types --- src/analyses/mayLocks.ml | 6 ++- src/analyses/mutexTypeAnalysis.ml | 84 +++++++++++++++++++++++++++++++ src/cdomains/valueDomain.ml | 1 + src/domains/queries.ml | 4 ++ 4 files changed, 94 insertions(+), 1 deletion(-) create mode 100644 src/analyses/mutexTypeAnalysis.ml diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index cc88c92b79..0ad9bf91d0 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -11,7 +11,11 @@ struct let add ctx (l,_) = if D.mem l ctx.local then - (M.warn "double locking"; ctx.local) + match D.Addr.to_var_must l with + | Some v when ctx.ask (Queries.IsRecursiveMutex v)-> + ctx.local + | _ -> + (M.warn "double locking"; ctx.local) else D.add l ctx.local diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml new file mode 100644 index 0000000000..d83aa3c987 --- /dev/null +++ b/src/analyses/mutexTypeAnalysis.ml @@ -0,0 +1,84 @@ +(** An analysis tracking the type of a mutex. *) + +open Prelude.Ana +open Analyses + +module MutexKind = +struct + include Printable.Std + + type t = NonRec | Recursive [@@deriving eq, ord, hash, to_yojson] + let name () = "mutexKind" + let show x = match x with + | NonRec -> "fast/error_checking" + | Recursive -> "recursive" + + include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) +end + + +module MutexKindLattice = Lattice.Flat(MutexKind) (struct let bot_name = "Uninitialized" let top_name = "Top" end) + +module Spec : Analyses.MCPSpec with module D = Lattice.Unit and module C = Lattice.Unit = +struct + include Analyses.DefaultSpec + module V = VarinfoV + + let name () = "pthreadMutexType" + module D = Lattice.Unit + module C = Lattice.Unit + module G = MutexKindLattice + + (* transfer functions *) + let assign ctx (lval:lval) (rval:exp) : D.t = + match lval with + | Var v, Field (f1, Field (f2, NoOffset)) when ValueDomain.Compound.is_mutex_type v.vtype && f1.fname = "__data" && f2.fname = "__kind" -> + let kind = + (match Cil.constFold true rval with + | Const (CInt (c, _, _)) -> + if Z.equal c Z.zero then + `Lifted(MutexKind.NonRec) + else if Z.equal c Z.one then + `Lifted(MutexKind.Recursive) + else + `Top + | _ -> `Top) + in + ctx.sideg v kind; + ctx.local + | _ -> ctx.local + + let branch ctx (exp:exp) (tv:bool) : D.t = + ctx.local + + let body ctx (f:fundec) : D.t = + ctx.local + + let return ctx (exp:exp option) (f:fundec) : D.t = + ctx.local + + let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = + [ctx.local, ctx.local] + + let combine ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (au:D.t) : D.t = + au + + let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = + ctx.local + + let startstate v = D.bot () + let threadenter ctx lval f args = [D.top ()] + let threadspawn ctx lval f args fctx = ctx.local + let exitstate v = D.top () + + let query ctx (type a) (q: a Queries.t): a Queries.result = + match q with + | Queries.IsRecursiveMutex v -> ctx.global v = `Lifted (MutexKind.Recursive) + | _ -> Queries.Result.top q +end + +let _ = + MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index af7fbb949a..c35d6ba028 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -29,6 +29,7 @@ sig val smart_widen: (exp -> BI.t option) -> (exp -> BI.t option) -> t -> t -> t val smart_leq: (exp -> BI.t option) -> (exp -> BI.t option) -> t -> t -> bool val is_immediate_type: typ -> bool + val is_mutex_type: typ -> bool val bot_value: typ -> t val is_bot_value: t -> bool val init_value: typ -> t diff --git a/src/domains/queries.ml b/src/domains/queries.ml index e5aba6e965..9da4be7cfe 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -104,6 +104,7 @@ type _ t = | HeapVar: VI.t t | IsHeapVar: varinfo -> MayBool.t t (* TODO: is may or must? *) | IsMultiple: varinfo -> MustBool.t t (* Is no other copy of this local variable reachable via pointers? *) + | IsRecursiveMutex: varinfo -> MustBool.t t | EvalThread: exp -> ConcDomain.ThreadSet.t t | CreatedThreads: ConcDomain.ThreadSet.t t | MustJoinedThreads: ConcDomain.MustThreadSet.t t @@ -153,6 +154,7 @@ struct | IterVars _ -> (module Unit) | PartAccess _ -> Obj.magic (module Unit: Lattice.S) (* Never used, MCP handles PartAccess specially. Must still return module (instead of failwith) here, but the module is never used. *) | IsMultiple _ -> (module MustBool) (* see https://github.com/goblint/analyzer/pull/310#discussion_r700056687 on why this needs to be MustBool *) + | IsRecursiveMutex _ -> (module MustBool) | EvalThread _ -> (module ConcDomain.ThreadSet) | CreatedThreads -> (module ConcDomain.ThreadSet) | MustJoinedThreads -> (module ConcDomain.MustThreadSet) @@ -187,6 +189,7 @@ struct | MayBePublicWithout _ -> MayBool.top () | MayBeThreadReturn -> MayBool.top () | IsHeapVar _ -> MayBool.top () + | IsRecursiveMutex _ -> MustBool.top () | MustBeProtectedBy _ -> MustBool.top () | MustBeAtomic -> MustBool.top () | MustBeSingleThreaded -> MustBool.top () @@ -252,6 +255,7 @@ struct | Any (WarnGlobal _) -> 35 | Any (Invariant _) -> 36 | Any (IterSysVars _) -> 37 + | Any (IsRecursiveMutex _) -> 38 let compare a b = let r = Stdlib.compare (order a) (order b) in From 8ccfb9e66f5067bad37d03b15650b1d47c4f463a Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 25 Sep 2022 15:11:21 +0200 Subject: [PATCH 077/518] Fix indentation --- src/analyses/mutexTypeAnalysis.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index d83aa3c987..b6bf22e7ec 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -38,14 +38,14 @@ struct | Var v, Field (f1, Field (f2, NoOffset)) when ValueDomain.Compound.is_mutex_type v.vtype && f1.fname = "__data" && f2.fname = "__kind" -> let kind = (match Cil.constFold true rval with - | Const (CInt (c, _, _)) -> - if Z.equal c Z.zero then - `Lifted(MutexKind.NonRec) - else if Z.equal c Z.one then - `Lifted(MutexKind.Recursive) - else - `Top - | _ -> `Top) + | Const (CInt (c, _, _)) -> + if Z.equal c Z.zero then + `Lifted(MutexKind.NonRec) + else if Z.equal c Z.one then + `Lifted(MutexKind.Recursive) + else + `Top + | _ -> `Top) in ctx.sideg v kind; ctx.local From 15131fe318fd5109670bccb09c0c184ee40bd476 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 25 Sep 2022 15:44:21 +0200 Subject: [PATCH 078/518] Add test for recurisve mutexes --- tests/regression/60-doublelocking/05-rec.c | 40 ++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 tests/regression/60-doublelocking/05-rec.c diff --git a/tests/regression/60-doublelocking/05-rec.c b/tests/regression/60-doublelocking/05-rec.c new file mode 100644 index 0000000000..c56025ab6f --- /dev/null +++ b/tests/regression/60-doublelocking/05-rec.c @@ -0,0 +1,40 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; + +pthread_mutex_t mut = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t mut2 = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP; + +void* f1(void* ptr) { + int top; + + g = 1; + if(top) { + pthread_mutex_lock(&mut); + } + pthread_mutex_lock(&mut); //WARN + pthread_mutex_unlock(&mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_t t2; + + pthread_create(&t1,NULL,f1,NULL); + pthread_join(t1, NULL); + + pthread_mutex_lock(&mut2); //NOWARN + pthread_mutex_lock(&mut2); //NOWARN + pthread_mutex_unlock(&mut2); + pthread_mutex_unlock(&mut2); + + return 0; +} From 1c17d61b351fe845114e52a8b822be8d3812f106 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 25 Sep 2022 16:27:59 +0200 Subject: [PATCH 079/518] Track value of mutexAttrT locally --- src/analyses/base.ml | 20 ++++++++++++++ src/analyses/libraryDesc.ml | 1 + src/analyses/libraryFunctions.ml | 1 + src/analyses/mutexTypeAnalysis.ml | 31 +++------------------ src/cdomains/valueDomain.ml | 45 ++++++++++++++++++++++++++++++- 5 files changed, 70 insertions(+), 28 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 85cece5d1d..0390f6281c 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -476,6 +476,7 @@ struct | `Struct s -> ValueDomain.Structs.fold (fun k v acc -> AD.join (reachable_from_value ask gs st v t description) acc) s empty | `Int _ -> empty | `Float _ -> empty + | `MutexAttr _ -> empty | `Thread _ -> empty (* thread IDs are abstract and nothing known can be reached from them *) | `Mutex -> empty (* mutexes are abstract and nothing known can be reached from them *) @@ -616,6 +617,7 @@ struct ValueDomain.Structs.fold f s (empty, TS.bot (), false) | `Int _ -> (empty, TS.bot (), false) | `Float _ -> (empty, TS.bot (), false) + | `MutexAttr _ -> (empty, TS.bot (), false) | `Thread _ -> (empty, TS.bot (), false) (* TODO: is this right? *) | `Mutex -> (empty, TS.bot (), false) (* TODO: is this right? *) in @@ -2594,6 +2596,24 @@ struct | _ -> () end; raise Deadcode + | MutexAttrSetType {attr = attr; typ = mtyp}, _ -> + begin + let get_type lval = + let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in + AD.get_type address + in + let dst_lval = mkMem ~addr:(Cil.stripCasts attr) ~off:NoOffset in + let dest_typ = get_type dst_lval in + let dest_a = eval_lv (Analyses.ask_of_ctx ctx) gs st dst_lval in + match eval_rv (Analyses.ask_of_ctx ctx) gs st mtyp with + | `Int x -> + begin + match ID.to_int x with + | Some z -> M.tracel "attr" "setting\n"; set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.of_int z)) + | None -> set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.top ())) + end + | _ -> set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.top ())) + end | Unknown, "__builtin_expect" -> begin match lv with | Some v -> assign ctx v (List.hd args) diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index 147f923a09..5e6a992c79 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -43,6 +43,7 @@ type special = | ThreadExit of { ret_val: Cil.exp; } | Signal of Cil.exp | Broadcast of Cil.exp + | MutexAttrSetType of { attr:Cil.exp; typ: Cil.exp; } | Wait of { cond: Cil.exp; mutex: Cil.exp; } | TimedWait of { cond: Cil.exp; mutex: Cil.exp; abstime: Cil.exp; } | Math of { fun_args: math; } diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 77b2b8a76c..6f254aead3 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -34,6 +34,7 @@ let pthread_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("pthread_cond_broadcast", special [__ "cond" []] @@ fun cond -> Broadcast cond); ("pthread_cond_wait", special [__ "cond" []; __ "mutex" []] @@ fun cond mutex -> Wait {cond; mutex}); ("pthread_cond_timedwait", special [__ "cond" []; __ "mutex" []; __ "abstime" [r]] @@ fun cond mutex abstime -> TimedWait {cond; mutex; abstime}); + ("pthread_mutexattr_settype", special [__ "attr" []; __ "type" []] @@ fun attr typ -> MutexAttrSetType {attr; typ}); ] (** GCC builtin functions. diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index b6bf22e7ec..73943ff7f0 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -3,24 +3,7 @@ open Prelude.Ana open Analyses -module MutexKind = -struct - include Printable.Std - - type t = NonRec | Recursive [@@deriving eq, ord, hash, to_yojson] - let name () = "mutexKind" - let show x = match x with - | NonRec -> "fast/error_checking" - | Recursive -> "recursive" - - include Printable.SimpleShow (struct - type nonrec t = t - let show = show - end) -end - - -module MutexKindLattice = Lattice.Flat(MutexKind) (struct let bot_name = "Uninitialized" let top_name = "Top" end) +module MAttr= ValueDomain.MutexAttr module Spec : Analyses.MCPSpec with module D = Lattice.Unit and module C = Lattice.Unit = struct @@ -30,7 +13,7 @@ struct let name () = "pthreadMutexType" module D = Lattice.Unit module C = Lattice.Unit - module G = MutexKindLattice + module G = MAttr (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = @@ -38,13 +21,7 @@ struct | Var v, Field (f1, Field (f2, NoOffset)) when ValueDomain.Compound.is_mutex_type v.vtype && f1.fname = "__data" && f2.fname = "__kind" -> let kind = (match Cil.constFold true rval with - | Const (CInt (c, _, _)) -> - if Z.equal c Z.zero then - `Lifted(MutexKind.NonRec) - else if Z.equal c Z.one then - `Lifted(MutexKind.Recursive) - else - `Top + | Const (CInt (c, _, _)) -> MAttr.of_int c | _ -> `Top) in ctx.sideg v kind; @@ -76,7 +53,7 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = match q with - | Queries.IsRecursiveMutex v -> ctx.global v = `Lifted (MutexKind.Recursive) + | Queries.IsRecursiveMutex v -> ctx.global v = `Lifted (MAttr.MutexKind.Recursive) | _ -> Queries.Result.top q end diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index c35d6ba028..7e50d9548c 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -70,6 +70,35 @@ end module Threads = ConcDomain.ThreadSet +module MutexAttr = struct + module MutexKind = + struct + include Printable.Std + + type t = NonRec | Recursive [@@deriving eq, ord, hash, to_yojson] + let name () = "mutexKind" + let show x = match x with + | NonRec -> "fast/error_checking" + | Recursive -> "recursive" + + include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) + end + + include Lattice.Flat(MutexKind) (struct let bot_name = "Uninitialized" let top_name = "Top" end) + + let of_int z = + if Z.equal z Z.zero then + `Lifted MutexKind.NonRec + else if Z.equal z Z.one then + `Lifted MutexKind.Recursive + else + `Top + +end + module rec Compound: S with type t = [ | `Top | `Int of ID.t @@ -81,6 +110,7 @@ module rec Compound: S with type t = [ | `Blob of Blobs.t | `Thread of Threads.t | `Mutex + | `MutexAttr of MutexAttr.t | `Bot ] and type offs = (fieldinfo,IndexDomain.t) Lval.offs = struct @@ -95,9 +125,14 @@ struct | `Blob of Blobs.t | `Thread of Threads.t | `Mutex + | `MutexAttr of MutexAttr.t | `Bot ] [@@deriving eq, ord, hash] + let is_mutexattr_type (t:typ): bool = match t with + | TNamed (info, attr) -> info.tname = "pthread_mutexattr_t" + | _ -> false + let is_mutex_type (t: typ): bool = match t with | TNamed (info, attr) -> info.tname = "pthread_mutex_t" || info.tname = "spinlock_t" || info.tname = "pthead_spinlock_t" | TInt (IInt, attr) -> hasAttribute "mutex" attr @@ -123,6 +158,7 @@ struct let l = BatOption.map Cilint.big_int_of_cilint (Cil.getInteger (Cil.constFold true exp)) in `Array (CArrays.make (BatOption.map_default (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ())) (IndexDomain.bot ()) l) (bot_value ai)) | t when is_thread_type t -> `Thread (ConcDomain.ThreadSet.empty ()) + | t when is_mutexattr_type t -> `MutexAttr (MutexAttr.bot ()) | TNamed ({ttype=t; _}, _) -> bot_value t | _ -> `Bot @@ -137,6 +173,7 @@ struct | `Blob x -> Blobs.is_bot x | `Thread x -> Threads.is_bot x | `Mutex -> true + | `MutexAttr x -> MutexAttr.is_bot x | `Bot -> true | `Top -> false @@ -183,6 +220,7 @@ struct | `Array x -> CArrays.is_top x | `Blob x -> Blobs.is_top x | `Thread x -> Threads.is_top x + | `MutexAttr x -> MutexAttr.is_top x | `Mutex -> true | `Top -> true | `Bot -> false @@ -214,7 +252,7 @@ struct | _ -> `Top let tag_name : t -> string = function - | `Top -> "Top" | `Int _ -> "Int" | `Float _ -> "Float" | `Address _ -> "Address" | `Struct _ -> "Struct" | `Union _ -> "Union" | `Array _ -> "Array" | `Blob _ -> "Blob" | `Thread _ -> "Thread" | `Mutex -> "Mutex" | `Bot -> "Bot" + | `Top -> "Top" | `Int _ -> "Int" | `Float _ -> "Float" | `Address _ -> "Address" | `Struct _ -> "Struct" | `Union _ -> "Union" | `Array _ -> "Array" | `Blob _ -> "Blob" | `Thread _ -> "Thread" | `Mutex -> "Mutex" | `MutexAttr _ -> "MutexAttr" | `Bot -> "Bot" include Printable.Std let name () = "compound" @@ -239,6 +277,7 @@ struct | `Array n -> CArrays.pretty () n | `Blob n -> Blobs.pretty () n | `Thread n -> Threads.pretty () n + | `MutexAttr n -> MutexAttr.pretty () n | `Mutex -> text "mutex" | `Bot -> text bot_name | `Top -> text top_name @@ -254,6 +293,7 @@ struct | `Blob n -> Blobs.show n | `Thread n -> Threads.show n | `Mutex -> "mutex" + | `MutexAttr x -> MutexAttr.show x | `Bot -> bot_name | `Top -> top_name @@ -1129,6 +1169,7 @@ struct | `Array n -> CArrays.printXml f n | `Blob n -> Blobs.printXml f n | `Thread n -> Threads.printXml f n + | `MutexAttr n -> MutexAttr.printXml f n | `Mutex -> BatPrintf.fprintf f "\n\nmutex\n\n\n" | `Bot -> BatPrintf.fprintf f "\n\nbottom\n\n\n" | `Top -> BatPrintf.fprintf f "\n\ntop\n\n\n" @@ -1142,6 +1183,7 @@ struct | `Array n -> CArrays.to_yojson n | `Blob n -> Blobs.to_yojson n | `Thread n -> Threads.to_yojson n + | `MutexAttr n -> MutexAttr.to_yojson n | `Mutex -> `String "mutex" | `Bot -> `String "⊥" | `Top -> `String "⊤" @@ -1159,6 +1201,7 @@ struct | `Array n -> `Array (project_arr p n) | `Blob (v, s, z) -> `Blob (project p v, ID.project p s, z) | `Thread n -> `Thread n + | `MutexAttr n -> `MutexAttr n | `Mutex -> `Mutex | `Bot -> `Bot | `Top -> `Top From 5f3233751cfc168d8d5e4754346691652f45b8ad Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 25 Sep 2022 17:29:22 +0200 Subject: [PATCH 080/518] Add mutex type tracking for local mutexes --- src/analyses/base.ml | 6 +++ src/analyses/libraryDesc.ml | 1 + src/analyses/libraryFunctions.ml | 1 + src/analyses/mutexTypeAnalysis.ml | 12 +++++- src/cdomains/mutexAttrDomain.ml | 26 +++++++++++ src/cdomains/valueDomain.ml | 37 +++------------- src/domains/queries.ml | 8 ++++ .../regression/60-doublelocking/06-rec-dyn.c | 43 +++++++++++++++++++ 8 files changed, 100 insertions(+), 34 deletions(-) create mode 100644 src/cdomains/mutexAttrDomain.ml create mode 100644 tests/regression/60-doublelocking/06-rec-dyn.c diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 0390f6281c..9ace65a88f 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1231,6 +1231,12 @@ struct end | Q.EvalInt e -> query_evalint (Analyses.ask_of_ctx ctx) ctx.global ctx.local e + | Q.EvalMutexAttr e -> begin + let e:exp = Lval (Cil.mkMem ~addr:e ~off:NoOffset) in + match eval_rv (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with + | `MutexAttr a -> a + | v -> MutexAttrDomain.top () + end | Q.EvalLength e -> begin match eval_rv_address (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with | `Address a -> diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index 5e6a992c79..a59ca7f7bc 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -44,6 +44,7 @@ type special = | Signal of Cil.exp | Broadcast of Cil.exp | MutexAttrSetType of { attr:Cil.exp; typ: Cil.exp; } + | MutexInit of { mutex:Cil.exp; attr: Cil.exp; } | Wait of { cond: Cil.exp; mutex: Cil.exp; } | TimedWait of { cond: Cil.exp; mutex: Cil.exp; abstime: Cil.exp; } | Math of { fun_args: math; } diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 6f254aead3..08eb8ac164 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -35,6 +35,7 @@ let pthread_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("pthread_cond_wait", special [__ "cond" []; __ "mutex" []] @@ fun cond mutex -> Wait {cond; mutex}); ("pthread_cond_timedwait", special [__ "cond" []; __ "mutex" []; __ "abstime" [r]] @@ fun cond mutex abstime -> TimedWait {cond; mutex; abstime}); ("pthread_mutexattr_settype", special [__ "attr" []; __ "type" []] @@ fun attr typ -> MutexAttrSetType {attr; typ}); + ("pthread_mutex_init", special [__ "mutex" []; __ "attr" []] @@ fun mutex attr -> MutexInit {mutex; attr}); ] (** GCC builtin functions. diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 73943ff7f0..7a9913c91e 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -3,7 +3,8 @@ open Prelude.Ana open Analyses -module MAttr= ValueDomain.MutexAttr +module MAttr = ValueDomain.MutexAttr +module LF = LibraryFunctions module Spec : Analyses.MCPSpec with module D = Lattice.Unit and module C = Lattice.Unit = struct @@ -44,7 +45,14 @@ struct au let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = - ctx.local + let desc = LF.find f in + match desc.special arglist with + | MutexInit {mutex = mutex; attr = attr} -> + let mutexes = ctx.ask (Queries.MayPointTo mutex) in + let attr = ctx.ask (Queries.EvalMutexAttr attr) in + Queries.LS.iter (function (v, _) -> ctx.sideg v attr) mutexes; + ctx.local + | _ -> ctx.local let startstate v = D.bot () let threadenter ctx lval f args = [D.top ()] diff --git a/src/cdomains/mutexAttrDomain.ml b/src/cdomains/mutexAttrDomain.ml new file mode 100644 index 0000000000..7396687876 --- /dev/null +++ b/src/cdomains/mutexAttrDomain.ml @@ -0,0 +1,26 @@ +module MutexKind = +struct + include Printable.Std + + type t = NonRec | Recursive [@@deriving eq, ord, hash, to_yojson] + let name () = "mutexKind" + let show x = match x with + | NonRec -> "fast/error_checking" + | Recursive -> "recursive" + + include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) +end + +include Lattice.Flat(MutexKind) (struct let bot_name = "Uninitialized" let top_name = "Top" end) + + +let of_int z = + if Z.equal z Z.zero then + `Lifted MutexKind.NonRec + else if Z.equal z Z.one then + `Lifted MutexKind.Recursive + else + `Top diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 7e50d9548c..688108c7c0 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -10,6 +10,7 @@ module GU = Goblintutil module Expp = ExpDomain module Q = Queries module BI = IntOps.BigIntOps +module MutexAttr = MutexAttrDomain module AddrSetDomain = SetDomain.ToppedSet(Addr)(struct let topname = "All" end) module ArrIdxDomain = IndexDomain @@ -70,35 +71,6 @@ end module Threads = ConcDomain.ThreadSet -module MutexAttr = struct - module MutexKind = - struct - include Printable.Std - - type t = NonRec | Recursive [@@deriving eq, ord, hash, to_yojson] - let name () = "mutexKind" - let show x = match x with - | NonRec -> "fast/error_checking" - | Recursive -> "recursive" - - include Printable.SimpleShow (struct - type nonrec t = t - let show = show - end) - end - - include Lattice.Flat(MutexKind) (struct let bot_name = "Uninitialized" let top_name = "Top" end) - - let of_int z = - if Z.equal z Z.zero then - `Lifted MutexKind.NonRec - else if Z.equal z Z.one then - `Lifted MutexKind.Recursive - else - `Top - -end - module rec Compound: S with type t = [ | `Top | `Int of ID.t @@ -125,7 +97,7 @@ struct | `Blob of Blobs.t | `Thread of Threads.t | `Mutex - | `MutexAttr of MutexAttr.t + | `MutexAttr of MutexAttrDomain.t | `Bot ] [@@deriving eq, ord, hash] @@ -158,7 +130,7 @@ struct let l = BatOption.map Cilint.big_int_of_cilint (Cil.getInteger (Cil.constFold true exp)) in `Array (CArrays.make (BatOption.map_default (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ())) (IndexDomain.bot ()) l) (bot_value ai)) | t when is_thread_type t -> `Thread (ConcDomain.ThreadSet.empty ()) - | t when is_mutexattr_type t -> `MutexAttr (MutexAttr.bot ()) + | t when is_mutexattr_type t -> `MutexAttr (MutexAttrDomain.bot ()) | TNamed ({ttype=t; _}, _) -> bot_value t | _ -> `Bot @@ -412,7 +384,8 @@ struct match v with | `Bot | `Thread _ - | `Mutex -> + | `Mutex + | `MutexAttr _ -> v | _ -> let log_top (_,l,_,_) = Messages.tracel "cast" "log_top at %d: %a to %a is top!\n" l pretty v d_type t in diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 9da4be7cfe..aff77230f8 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -106,6 +106,7 @@ type _ t = | IsMultiple: varinfo -> MustBool.t t (* Is no other copy of this local variable reachable via pointers? *) | IsRecursiveMutex: varinfo -> MustBool.t t | EvalThread: exp -> ConcDomain.ThreadSet.t t + | EvalMutexAttr: exp -> MutexAttrDomain.t t | CreatedThreads: ConcDomain.ThreadSet.t t | MustJoinedThreads: ConcDomain.MustThreadSet.t t | Invariant: invariant_context -> Invariant.t t @@ -146,6 +147,7 @@ struct | MustBeUniqueThread -> (module MustBool) | EvalInt _ -> (module ID) | EvalLength _ -> (module ID) + | EvalMutexAttr _ -> (module MutexAttrDomain) | BlobSize _ -> (module ID) | CurrentThreadId -> (module ThreadIdDomain.ThreadLifted) | HeapVar -> (module VI) @@ -196,6 +198,7 @@ struct | MustBeUniqueThread -> MustBool.top () | EvalInt _ -> ID.top () | EvalLength _ -> ID.top () + | EvalMutexAttr _ -> MutexAttrDomain.top () | BlobSize _ -> ID.top () | CurrentThreadId -> ThreadIdDomain.ThreadLifted.top () | HeapVar -> VI.top () @@ -256,6 +259,7 @@ struct | Any (Invariant _) -> 36 | Any (IterSysVars _) -> 37 | Any (IsRecursiveMutex _) -> 38 + | Any (EvalMutexAttr _ ) -> 39 let compare a b = let r = Stdlib.compare (order a) (order b) in @@ -276,6 +280,7 @@ struct | Any (EvalInt e1), Any (EvalInt e2) -> CilType.Exp.compare e1 e2 | Any (EvalStr e1), Any (EvalStr e2) -> CilType.Exp.compare e1 e2 | Any (EvalLength e1), Any (EvalLength e2) -> CilType.Exp.compare e1 e2 + | Any (EvalMutexAttr e1), Any (EvalMutexAttr e2) -> CilType.Exp.compare e1 e2 | Any (BlobSize e1), Any (BlobSize e2) -> CilType.Exp.compare e1 e2 | Any (CondVars e1), Any (CondVars e2) -> CilType.Exp.compare e1 e2 | Any (PartAccess p1), Any (PartAccess p2) -> compare_access p1 p2 @@ -287,6 +292,7 @@ struct | Any (WarnGlobal vi1), Any (WarnGlobal vi2) -> compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) | Any (Invariant i1), Any (Invariant i2) -> compare_invariant_context i1 i2 | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) + | Any (IsRecursiveMutex v1), Any (IsRecursiveMutex v2) -> CilType.Varinfo.compare v1 v2 (* only argumentless queries should remain *) | _, _ -> Stdlib.compare (order a) (order b) @@ -306,6 +312,7 @@ struct | Any (EvalInt e) -> CilType.Exp.hash e | Any (EvalStr e) -> CilType.Exp.hash e | Any (EvalLength e) -> CilType.Exp.hash e + | Any (EvalMutexAttr e) -> CilType.Exp.hash e | Any (BlobSize e) -> CilType.Exp.hash e | Any (CondVars e) -> CilType.Exp.hash e | Any (PartAccess p) -> hash_access p @@ -316,6 +323,7 @@ struct | Any (EvalThread e) -> CilType.Exp.hash e | Any (WarnGlobal vi) -> Hashtbl.hash vi | Any (Invariant i) -> hash_invariant_context i + | Any (IsRecursiveMutex v) -> CilType.Varinfo.hash v (* only argumentless queries should remain *) | _ -> 0 diff --git a/tests/regression/60-doublelocking/06-rec-dyn.c b/tests/regression/60-doublelocking/06-rec-dyn.c new file mode 100644 index 0000000000..aed19210c5 --- /dev/null +++ b/tests/regression/60-doublelocking/06-rec-dyn.c @@ -0,0 +1,43 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; + +void* f1(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_unlock(mut); + pthread_mutex_unlock(mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_mutex_t mut; + + pthread_mutexattr_t attr; + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + pthread_mutex_init(&mut, &attr); + + + pthread_create(&t1,NULL,f1,&mut); + + + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_unlock(&mut); + pthread_mutex_unlock(&mut); + + pthread_join(t1, NULL); + + + return 0; +} From 6236e4895daf9f2f33695e86ff3629266be5d9c9 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 25 Sep 2022 17:32:30 +0200 Subject: [PATCH 081/518] Skip 60/05 on OS X --- tests/regression/60-doublelocking/05-rec.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/regression/60-doublelocking/05-rec.c b/tests/regression/60-doublelocking/05-rec.c index c56025ab6f..f4d41cef40 100644 --- a/tests/regression/60-doublelocking/05-rec.c +++ b/tests/regression/60-doublelocking/05-rec.c @@ -5,6 +5,14 @@ #include #include +#ifdef __APPLE__ + // OS X does not have PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP + int main(int argc, char const *argv[]) + { + return 0; + } +#else + int g; pthread_mutex_t mut = PTHREAD_MUTEX_INITIALIZER; @@ -38,3 +46,5 @@ int main(int argc, char const *argv[]) return 0; } + } +#endif From e8b09f1640b551da7d1b5a7cf56ced15bed3decd Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 25 Sep 2022 17:45:13 +0200 Subject: [PATCH 082/518] Category for Double Locking --- src/analyses/mayLocks.ml | 4 ++-- src/util/messageCategory.ml | 5 +++++ tests/regression/60-doublelocking/05-rec.c | 1 - 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 0ad9bf91d0..27acd07bbd 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -9,13 +9,13 @@ struct module G = DefaultSpec.G module V = DefaultSpec.V - let add ctx (l,_) = + let add ctx (l,r) = if D.mem l ctx.local then match D.Addr.to_var_must l with | Some v when ctx.ask (Queries.IsRecursiveMutex v)-> ctx.local | _ -> - (M.warn "double locking"; ctx.local) + (M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a (possibly non-recursive) mutex that may be already held"; ctx.local) else D.add l ctx.local diff --git a/src/util/messageCategory.ml b/src/util/messageCategory.ml index 4f61684f56..f0a1d81928 100644 --- a/src/util/messageCategory.ml +++ b/src/util/messageCategory.ml @@ -12,6 +12,7 @@ type undefined_behavior = | NullPointerDereference | UseAfterFree | Uninitialized + | DoubleLocking [@@deriving eq, ord, hash] type behavior = @@ -61,6 +62,7 @@ struct let nullpointer_dereference: category = create @@ NullPointerDereference let use_after_free: category = create @@ UseAfterFree let uninitialized: category = create @@ Uninitialized + let double_locking: category = create @@ DoubleLocking module ArrayOutOfBounds = struct @@ -95,6 +97,7 @@ struct | "nullpointer_dereference" -> nullpointer_dereference | "use_after_free" -> use_after_free | "uninitialized" -> uninitialized + | "double_locking" -> double_locking | _ -> Unknown let path_show (e: t) = @@ -103,6 +106,7 @@ struct | NullPointerDereference -> ["NullPointerDereference"] | UseAfterFree -> ["UseAfterFree"] | Uninitialized -> ["Uninitialized"] + | DoubleLocking -> ["DoubleLocking"] end let from_string_list (s: string list): category = @@ -208,6 +212,7 @@ let behaviorName = function |NullPointerDereference -> "NullPointerDereference" |UseAfterFree -> "UseAfterFree" |Uninitialized -> "Uninitialized" + |DoubleLocking -> "DoubleLocking" | ArrayOutOfBounds aob -> match aob with | PastEnd -> "PastEnd" | BeforeStart -> "BeforeStart" diff --git a/tests/regression/60-doublelocking/05-rec.c b/tests/regression/60-doublelocking/05-rec.c index f4d41cef40..7a1b953f43 100644 --- a/tests/regression/60-doublelocking/05-rec.c +++ b/tests/regression/60-doublelocking/05-rec.c @@ -46,5 +46,4 @@ int main(int argc, char const *argv[]) return 0; } - } #endif From 95f249ab23bfdf1ac336dc69f46dce43b6781237 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 25 Sep 2022 18:07:29 +0200 Subject: [PATCH 083/518] OS X :( --- tests/regression/60-doublelocking/05-rec.c | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/tests/regression/60-doublelocking/05-rec.c b/tests/regression/60-doublelocking/05-rec.c index 7a1b953f43..5bc94dbeda 100644 --- a/tests/regression/60-doublelocking/05-rec.c +++ b/tests/regression/60-doublelocking/05-rec.c @@ -5,18 +5,15 @@ #include #include -#ifdef __APPLE__ - // OS X does not have PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP - int main(int argc, char const *argv[]) - { - return 0; - } -#else int g; pthread_mutex_t mut = PTHREAD_MUTEX_INITIALIZER; + +#ifndef __APPLE__ pthread_mutex_t mut2 = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP; +#endif + void* f1(void* ptr) { int top; @@ -39,11 +36,12 @@ int main(int argc, char const *argv[]) pthread_create(&t1,NULL,f1,NULL); pthread_join(t1, NULL); +#ifndef __APPLE__ pthread_mutex_lock(&mut2); //NOWARN pthread_mutex_lock(&mut2); //NOWARN pthread_mutex_unlock(&mut2); pthread_mutex_unlock(&mut2); +#endif return 0; } -#endif From fa9747b0ac7c06b1c849f9c483a33ce25ea93329 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 6 Mar 2023 16:12:05 +0100 Subject: [PATCH 084/518] remove GlobalElemMap --- src/incremental/compareCIL.ml | 14 +- src/incremental/compareGlobals.ml | 15 ++ src/incremental/detectRenamedFunctions.ml | 263 +++++++++------------- 3 files changed, 126 insertions(+), 166 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 238bf06cb1..c58c34d039 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -46,7 +46,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = Not_found -> map in - (* Store a map from functionNames in the old file to the function definition*) + (* Store a map from global names in the old file to the globals declarations and/or definition *) let oldMap = Cil.foldGlobals oldAST addGlobal GlobalMap.empty in let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in @@ -72,13 +72,13 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = in if GobConfig.get_bool "incremental.detect-renames" then ( - let renameDetectionResults = detectRenamedFunctions oldAST newAST in + let renameDetectionResults = detectRenamedFunctions oldMap newMap in if Messages.tracing then - GlobalElemMap.to_seq renameDetectionResults |> + GlobalColMap.to_seq renameDetectionResults |> Seq.iter (fun (gT, (functionGlobal, status)) -> - Messages.trace "compareCIL" "Function status of %s is=" (globalElemName gT); + Messages.trace "compareCIL" "Function status of %s is=" (name_of_global_col gT); match status with | Unchanged _ -> Messages.trace "compareCIL" "Same Name\n"; | Added -> Messages.trace "compareCIL" "Added\n"; @@ -91,7 +91,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = | _ -> (); ); - let unchanged, changed, added, removed = GlobalElemMap.fold (fun _ (global, status) (u, c, a, r) -> + let unchanged, changed, added, removed = GlobalColMap.fold (fun _ (global, status) (u, c, a, r) -> match status with | Unchanged now -> (u @ [{old=global; current=now}], c, a, r) | UnchangedButRenamed now -> (u @ [{old=global; current=now}], c, a, r) @@ -105,15 +105,13 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = changes.removed <- removed; changes.changed <- changed; changes.unchanged <- unchanged; - ) else (); + ); (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) GlobalMap.iter (fun name glob_col -> findChanges oldMap name glob_col) newMap; if not (GobConfig.get_bool "incremental.detect-renames") then ( - let newMap = Cil.foldGlobals newAST addGlobal GlobalMap.empty in - GlobalMap.iter (fun name glob -> if not (GlobalMap.mem name newMap) then changes.removed <- (glob::changes.removed)) oldMap; ); changes diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml index 2372a9f4f6..2686e16a86 100644 --- a/src/incremental/compareGlobals.ml +++ b/src/incremental/compareGlobals.ml @@ -9,6 +9,21 @@ module GlobalMap = Map.Make(String) type global_def = Var of varinfo | Fun of fundec type global_col = {decls: varinfo option; def: global_def option} +let name_of_global_col gc = match gc.def with + | Some (Fun f) -> f.svar.vname + | Some (Var v) -> v.vname + | None -> match gc.decls with + | Some v -> v.vname + | None -> raise (Failure "empty global record") + +let compare_global_col gc1 gc2 = compare (name_of_global_col gc1) (name_of_global_col gc2) + +module GlobalColMap = Map.Make( + struct + type t = global_col + let compare = compare_global_col + end) + let name_of_global g = match g with | GVar (v,_,_) -> v.vname | GFun (f,_) -> f.svar.vname diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 4454b9c77f..e3ab0328e2 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -7,40 +7,20 @@ module StringSet = Set.Make(String) type f = fundec * location type v = varinfo * initinfo * location -type globalElem = Fundec of fundec | GlobalVar of varinfo - -let globalElemName elem = match elem with - | Fundec(f) -> f.svar.vname - | GlobalVar(v) -> v.vname - -let globalElemName2 elem = match elem with - | Fundec(f) -> "Fundec(" ^ f.svar.vname ^ ")" - | GlobalVar(v) -> "GlobalVar(" ^ v.vname ^ ")" - -module GlobalElemForMap = struct - type t = globalElem - - let compare x y = String.compare (globalElemName x) (globalElemName y) -end - -module GlobalElemMap = Map.Make(GlobalElemForMap) - (*A dependency maps the function it depends on to the name the function has to be changed to*) type functionDependencies = string VarinfoMap.t (*Renamed: newName * dependencies; Modified=now*unchangedHeader*) -type status = SameName of globalElem | Renamed of globalElem | Created | Deleted | Modified of globalElem * bool +type status = SameName of global_col | Renamed of global_col | Created | Deleted | Modified of global_col * bool type outputFunctionStatus = Unchanged of global_col | UnchangedButRenamed of global_col | Added | Removed | Changed of global_col * bool type output = global_col * outputFunctionStatus - - let pretty (f: status) = match f with | SameName _ -> "SameName" - | Renamed x -> ("Renamed to " ^ globalElemName x) + | Renamed x -> ("Renamed to " ^ CompareGlobals.name_of_global_col x) | Created -> "Added" | Deleted -> "Removed" | Modified _ -> "Changed" @@ -75,23 +55,23 @@ let getDependencies fromEq = VarinfoMap.map (fun assumption -> assumption.new_me reversemapping: see method mapping, but from now -> old *) type carryType = { - statusForOldElem: status GlobalElemMap.t; - statusForNowElem: status GlobalElemMap.t; - mapping: globalElem GlobalElemMap.t; - reverseMapping: globalElem GlobalElemMap.t; + statusForOldElem : status GlobalColMap.t; + statusForNowElem : status GlobalColMap.t; + mapping: global_col GlobalColMap.t; + reverseMapping: global_col GlobalColMap.t; } let emptyCarryType = { - statusForOldElem = GlobalElemMap.empty; - statusForNowElem = GlobalElemMap.empty; - mapping = GlobalElemMap.empty; - reverseMapping = GlobalElemMap.empty; + statusForOldElem = GlobalColMap.empty; + statusForNowElem = GlobalColMap.empty; + mapping = GlobalColMap.empty; + reverseMapping = GlobalColMap.empty; } (*Carry type manipulation functions.*) let registerStatusForOldF f status data = - {statusForOldElem = GlobalElemMap.add f status data.statusForOldElem; + {statusForOldElem = GlobalColMap.add f status data.statusForOldElem; statusForNowElem=data.statusForNowElem; mapping=data.mapping; reverseMapping=data.reverseMapping; @@ -99,14 +79,14 @@ let registerStatusForOldF f status data = let registerStatusForNowF f status data = {statusForOldElem = data.statusForOldElem; - statusForNowElem=GlobalElemMap.add f status data.statusForNowElem; + statusForNowElem=GlobalColMap.add f status data.statusForNowElem; mapping=data.mapping; reverseMapping=data.reverseMapping; } -let registerBiStatus (oldF: globalElem) (nowF: globalElem) (status: status) data = - {statusForOldElem=GlobalElemMap.add oldF status data.statusForOldElem; - statusForNowElem=GlobalElemMap.add nowF status data.statusForNowElem; +let registerBiStatus (oldF: global_col) (nowF: global_col) (status: status) data = + {statusForOldElem=GlobalColMap.add oldF status data.statusForOldElem; + statusForNowElem=GlobalColMap.add nowF status data.statusForNowElem; mapping=data.mapping; reverseMapping=data.reverseMapping; } @@ -114,8 +94,8 @@ let registerBiStatus (oldF: globalElem) (nowF: globalElem) (status: status) data let registerMapping oldF nowF data = {statusForOldElem=data.statusForOldElem; statusForNowElem=data.statusForNowElem; - mapping=GlobalElemMap.add oldF nowF data.mapping; - reverseMapping=GlobalElemMap.add nowF oldF data.reverseMapping; + mapping=GlobalColMap.add oldF nowF data.mapping; + reverseMapping=GlobalColMap.add nowF oldF data.reverseMapping; } let registerGVarMapping oldV nowV data = { @@ -132,19 +112,16 @@ let areGlobalVarRenameAssumptionsEmpty (mapping: glob_var_rename_assumptions) : (*returns true iff for all dependencies it is true, that the dependency has a corresponding function with the new name and matches the without having dependencies itself and the new name is not already present on the old AST. *) let doAllDependenciesMatch (dependencies: functionDependencies) (global_var_dependencies: glob_var_rename_assumptions) - (oldFunctionMap: f StringMap.t) - (nowFunctionMap: f StringMap.t) - (oldGVarMap: v StringMap.t) - (nowGVarMap: v StringMap.t) (data: carryType) : bool * carryType = + (oldMap: global_col StringMap.t) + (newMap: global_col StringMap.t) (data: carryType) : bool * carryType = - let isConsistent = fun old nowName allEqual getName getGlobal oldMap nowMap getNowOption data -> + let isConsistent = fun old nowName allEqual getName oldMap nowMap getNowOption data -> (*Early cutoff if a previous dependency returned false. We never create a mapping between globs where the now name was already part of the old set or the old name is part of the now set. But only if now and old differ. *) if allEqual && (getName old = nowName || (not (StringMap.mem nowName oldMap) && not (StringMap.mem (getName old) nowMap))) then - let globalElem = getGlobal old in - let knownMapping = GlobalElemMap.find_opt globalElem data.mapping in + let knownMapping = GlobalColMap.find_opt old data.mapping in (*let _ = Printf.printf "Dep: %s -> %s\n" (globalElemName2 globalElem) nowName in*) @@ -153,31 +130,34 @@ let doAllDependenciesMatch (dependencies: functionDependencies) | Some(knownElem) -> (*This function has already been mapped*) (*let _ = Printf.printf "Already mapped. %s = %s\n" (globalElemName2 knownElem) nowName in*) - globalElemName knownElem = nowName, data + name_of_global_col knownElem = nowName, data | None -> let nowElemOption = getNowOption nowName in match nowElemOption with | Some(nowElem) -> ( let compare = fun old now -> - match (old, now) with - | Fundec(oF), Fundec(nF) -> - let doMatch, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF oF nF None VarinfoMap.empty VarinfoMap.empty in - doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess - | GlobalVar(oV), GlobalVar(nV) -> - let (equal, (_, function_dependencies, global_var_dependencies, renamesOnSuccess)) = eq_varinfo oV nV ~rename_mapping:empty_rename_mapping in + let compareVar oV nV = let (equal, (_, function_dependencies, global_var_dependencies, renamesOnSuccess)) = eq_varinfo oV nV ~rename_mapping:empty_rename_mapping in (*eq_varinfo always comes back with a self dependency. We need to filter that out.*) unchanged_to_change_status equal, function_dependencies, (VarinfoMap.filter (fun vi name -> not (vi.vname = oV.vname && name = nowName)) global_var_dependencies), renamesOnSuccess + in + match (old.def, now.def) with + | Some (Fun oF), Some (Fun nF) -> + let doMatch, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF oF nF None VarinfoMap.empty VarinfoMap.empty in + doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess + | Some (Var oV), Some (Var nV) -> compareVar oV nV + | None, None -> (match old.decls, now.decls with + | Some oV, Some nV -> compareVar oV nV + | _ -> failwith "Unknown or incompatible global types") | _, _ -> failwith "Unknown or incompatible global types" in - - let doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess = compare globalElem nowElem in + let doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess = compare old nowElem in (*Having a dependency on yourself is ok.*) let hasNoExternalDependency = VarinfoMap.is_empty function_dependencies || ( VarinfoMap.cardinal function_dependencies = 1 && ( - VarinfoMap.fold (fun varinfo dependency _ -> varinfo.vname = globalElemName globalElem && dependency.new_method_name = globalElemName nowElem) function_dependencies true + VarinfoMap.fold (fun varinfo dependency _ -> varinfo.vname = name_of_global_col old && dependency.new_method_name = name_of_global_col nowElem) function_dependencies true ) ) in @@ -188,7 +168,7 @@ let doAllDependenciesMatch (dependencies: functionDependencies) match doMatch with | Unchanged when hasNoExternalDependency && areGlobalVarRenameAssumptionsEmpty global_var_dependencies -> let _ = performRenames renamesOnSuccess in - true, registerMapping globalElem nowElem data + true, registerMapping old nowElem data | _ -> false, data ) | None -> @@ -199,32 +179,26 @@ let doAllDependenciesMatch (dependencies: functionDependencies) in VarinfoMap.fold (fun old nowName (allEqual, data) -> - let (old, _) = StringMap.find old.vname oldFunctionMap in + let old = StringMap.find old.vname oldMap in isConsistent old nowName allEqual - (fun x -> x.svar.vname) - (fun x -> Fundec(x)) - oldFunctionMap - nowFunctionMap - (fun x -> - Option.bind (StringMap.find_opt x nowFunctionMap) (fun (x, _) -> Some(Fundec(x))) - ) + (fun x -> name_of_global_col x) + oldMap + newMap + (fun x -> StringMap.find_opt x newMap) data ) dependencies (true, data) |> VarinfoMap.fold (fun oldVarinfo nowName (allEqual, data) -> isConsistent - oldVarinfo + (GlobalMap.find oldVarinfo.vname oldMap) nowName allEqual - (fun x -> x.vname) - (fun x -> GlobalVar(x)) - oldGVarMap - nowGVarMap - (fun x -> - Option.bind (StringMap.find_opt x nowGVarMap) (fun (x, _, _) -> Some(GlobalVar(x))) - ) + (fun x -> name_of_global_col x) + oldMap + newMap + (fun x -> StringMap.find_opt x newMap) data ) global_var_dependencies @@ -232,32 +206,36 @@ let doAllDependenciesMatch (dependencies: functionDependencies) (*Check if f has already been assigned a status. If yes do nothing. If not, check if the function took part in the mapping, then register it to have been renamed. Otherwise register it as the supplied status.*) let assignStatusToUnassignedElem data f registerStatus statusMap mapping status = - if not (GlobalElemMap.mem f statusMap) then - if (GlobalElemMap.mem f mapping) then - registerStatus f (Renamed (GlobalElemMap.find f mapping)) data + if not (GlobalColMap.mem f statusMap) then + if (GlobalColMap.mem f mapping) then + registerStatus f (Renamed (GlobalColMap.find f mapping)) data else (*this function has been added/removed*) registerStatus f status data else data -let findSameNameMatchingGVars oldGVarMap nowGVarMap data = - StringMap.fold (fun _ (v, _, _) (data: carryType) -> - let matchingNowGvar = StringMap.find_opt v.vname nowGVarMap in - match matchingNowGvar with - | Some (nowGvar, _, _) -> ( - let identical, _ = eq_varinfo v nowGvar ~rename_mapping:empty_rename_mapping in - - let oldG, nowG = GlobalVar v, GlobalVar nowGvar in - - if identical then - registerBiStatus (GlobalVar v) (GlobalVar nowGvar) (SameName (GlobalVar nowGvar)) data - else - registerStatusForOldF oldG (Modified(nowG, false)) data |> - registerStatusForNowF nowG (Modified(oldG, false)) - ) - | None -> data - ) oldGVarMap data +let findSameNameMatchingGVars (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) data = + let compare_varinfo v1 v2 data = + let identical, _ = eq_varinfo v1 v2 ~rename_mapping:empty_rename_mapping in + let oldG, nowG = GlobalMap.find v1.vname oldMap, GlobalMap.find v2.vname newMap in + if identical then + registerBiStatus oldG nowG (SameName nowG) data + else + registerStatusForOldF oldG (Modified(nowG, false)) data |> + registerStatusForNowF nowG (Modified(oldG, false)) + in + StringMap.fold (fun name gc_old (data: carryType) -> + try + let gc_new = StringMap.find name newMap in + match gc_old.def, gc_new.def with + | Some (Var v1), Some (Var v2) -> compare_varinfo v1 v2 data + | None, None -> (match gc_old.decls, gc_new.decls with + | Some v1, Some v2 -> compare_varinfo v1 v2 data + | _ -> data) + | _ -> data + with Not_found -> data + ) oldMap data (*Goes through all old functions and looks for now-functions with the same name. If a pair has been found, onMatch is called with the comparison result. On match then modifies the carryType. Returns (list of the functions that have the same name and match, the updated carry type)*) @@ -266,92 +244,62 @@ let findSameNameMatchingFunctions nowFunctionMap (initialData: 'a) (onMatch: fundec -> fundec -> change_status -> string VarinfoMap.t -> CompareGlobals.glob_var_rename_assumptions -> CompareGlobals.renamesOnSuccess -> 'a -> 'a) : 'a = - StringMap.fold (fun _ (f, _) (data: 'a) -> - let matchingNewFundec = StringMap.find_opt f.svar.vname nowFunctionMap in - match matchingNewFundec with - | Some (newFun, _) -> - (*Compare if they are similar*) - let doMatch, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f newFun None VarinfoMap.empty VarinfoMap.empty in - - let actDependencies = getDependencies function_dependencies in - - onMatch f newFun doMatch actDependencies global_var_dependencies renamesOnSuccess data - | None -> data + StringMap.fold (fun name oldFun data -> + try + let newFun = StringMap.find name nowFunctionMap in + match oldFun.def, newFun.def with + | Some (Fun f1), Some (Fun f2) -> + let doMatch, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in + let actDependencies = getDependencies function_dependencies in + onMatch f1 f2 doMatch actDependencies global_var_dependencies renamesOnSuccess data + | _ -> data + with Not_found -> data ) oldFunctionMap initialData -let fillStatusForUnassignedElems oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap (data: carryType) = +let fillStatusForUnassignedElems oldMap newMap (data: carryType) = data |> (*Now go through all old functions again. Those who have not been assigned a status are removed*) - StringMap.fold (fun _ (f, _) (data: carryType) -> - assignStatusToUnassignedElem data (Fundec f) registerStatusForOldF data.statusForOldElem data.mapping Deleted - ) oldFunctionMap |> + StringMap.fold (fun name f (data: carryType) -> + assignStatusToUnassignedElem data f registerStatusForOldF data.statusForOldElem data.mapping Deleted + ) oldMap |> (*now go through all new functions. Those have have not been assigned a mapping are added.*) - StringMap.fold (fun _ (nowF, _) (data: carryType) -> - assignStatusToUnassignedElem data (Fundec nowF) registerStatusForNowF data.statusForNowElem data.reverseMapping Created - ) nowFunctionMap |> - StringMap.fold (fun _ (v, _, _) data -> - assignStatusToUnassignedElem data (GlobalVar(v)) registerStatusForOldF data.statusForOldElem data.mapping Deleted - ) oldGVarMap |> - StringMap.fold (fun _ (nowV, _, _) (data: carryType) -> - assignStatusToUnassignedElem data (GlobalVar(nowV)) registerStatusForNowF data.statusForNowElem data.reverseMapping Created - ) nowGVarMap - -let mapAnalysisResultToOutput oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap (data: carryType) : output GlobalElemMap.t = - (*Map back to GFun and exposed function status*) - let extractOutput funMap invertedFunMap gvarMap invertedGvarMap f (s: status) = - let getGlobal gT fundecMap gVarMap = - match gT with - | Fundec(f2) -> - let (f, l) = StringMap.find f2.svar.vname fundecMap in - {decls = None; def = Some(Fun f);} - | GlobalVar(v2) -> - let (v, i, l) = StringMap.find v2.vname gVarMap in - {decls = None; def = Some(Var v);} - in + StringMap.fold (fun name nowF (data: carryType) -> + assignStatusToUnassignedElem data nowF registerStatusForNowF data.statusForNowElem data.reverseMapping Created + ) newMap +let mapAnalysisResultToOutput (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) (data: carryType) : output GlobalColMap.t = + (*Map back to GFun and exposed function status*) + let extractOutput f (s: status) = let outputS = match s with - | SameName x -> Unchanged (getGlobal x invertedFunMap invertedGvarMap) - | Renamed x -> UnchangedButRenamed(getGlobal x invertedFunMap invertedGvarMap) + | SameName x -> Unchanged x + | Renamed x -> UnchangedButRenamed x | Created -> Added | Deleted -> Removed - | Modified (x, unchangedHeader) -> Changed (getGlobal x invertedFunMap invertedGvarMap, unchangedHeader) + | Modified (x, unchangedHeader) -> Changed (x, unchangedHeader) in - getGlobal f funMap gvarMap, outputS + f, outputS in (*Merge together old and now functions*) - GlobalElemMap.merge (fun _ a b -> + GlobalColMap.merge (fun _ a b -> if Option.is_some a then a else if Option.is_some b then b else None ) - (GlobalElemMap.mapi (extractOutput oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap) data.statusForOldElem) - (GlobalElemMap.mapi (extractOutput nowFunctionMap oldFunctionMap nowGVarMap oldGVarMap) data.statusForNowElem) + (GlobalColMap.mapi extractOutput data.statusForOldElem) + (GlobalColMap.mapi extractOutput data.statusForNowElem) -let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap.t = begin - let oldFunctionMap, oldGVarMap = getFunctionAndGVarMap oldAST in - let nowFunctionMap, nowGVarMap = getFunctionAndGVarMap newAST in - - (*let show x = [%show: (string * string) list] (StringMap.to_seq x |> Seq.map (fun (name, (v, _, _)) -> (name, v.vname)) |> List.of_seq) in - - let _ = Printf.printf "oldGvarMap: %s" (show oldGVarMap) in - let _ = Printf.printf "nowGvarMap: %s" (show nowGVarMap) in*) - - - let initialData: carryType = findSameNameMatchingGVars oldGVarMap nowGVarMap emptyCarryType in +let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) : output GlobalColMap.t = + let initialData: carryType = findSameNameMatchingGVars oldMap newMap emptyCarryType in (*Go through all functions, for all that have not been renamed *) - let finalData = findSameNameMatchingFunctions oldFunctionMap nowFunctionMap initialData (fun oldF nowF change_status functionDependencies global_var_dependencies renamesOnSuccess data -> - let oldG = Fundec(oldF) in - let nowG = Fundec(nowF) in - - (*let _ = Printf.printf "1. Same Name: %s <-> %s: %b, %b\n" oldF.svar.vname nowF.svar.vname doMatch unchangedHeader in*) + let finalData = findSameNameMatchingFunctions oldMap newMap initialData (fun oldF nowF change_status functionDependencies global_var_dependencies renamesOnSuccess data -> + let oldG = GlobalMap.find oldF.svar.vname oldMap in + let nowG = GlobalMap.find nowF.svar.vname newMap in match change_status with | Unchanged -> - let doDependenciesMatch, updatedData = doAllDependenciesMatch functionDependencies global_var_dependencies oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap data in - - (*let _ = Printf.printf "2. Same Name: %s <-> %s: %b\n" oldF.svar.vname nowF.svar.vname doDependenciesMatch in*) + let doDependenciesMatch, updatedData = doAllDependenciesMatch functionDependencies global_var_dependencies oldMap newMap data in if doDependenciesMatch then registerBiStatus oldG nowG (SameName(oldG)) updatedData @@ -366,10 +314,9 @@ let detectRenamedFunctions (oldAST: file) (newAST: file) : output GlobalElemMap. registerStatusForNowF nowG (Modified (oldG, false)) ) |> (*At this point we already know of the functions that have changed and stayed the same. We now assign the correct status to all the functions that - have been mapped. The functions that have not been mapped are added/removed.*) - fillStatusForUnassignedElems oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap + have been mapped. The functions that have not been mapped are added/removed.*) + fillStatusForUnassignedElems oldMap newMap in (*Done with the analyis, the following just adjusts the output types.*) - mapAnalysisResultToOutput oldFunctionMap nowFunctionMap oldGVarMap nowGVarMap finalData -end + mapAnalysisResultToOutput oldMap newMap finalData From 8884a9b332a606c3078c4709331d079876db1234 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Tue, 7 Mar 2023 12:48:45 +0100 Subject: [PATCH 085/518] fix merge mistake --- src/incremental/compareCIL.ml | 5 ++--- src/incremental/compareGlobals.ml | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index c58c34d039..23be2d9223 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -12,9 +12,8 @@ let eq_glob (old: global_col) (current: global_col) (cfgs : (cfg * (cfg * cfg)) (*Perform renames no matter what.*) let _ = performRenames renamesOnSuccess in match identical with - | Unchanged when VarinfoMap.is_empty funDep && areGlobalVarRenameAssumptionsEmpty globVarDep -> Unchanged, diffOpt - | _ -> Changed, None) - + | Unchanged when not (VarinfoMap.is_empty funDep && areGlobalVarRenameAssumptionsEmpty globVarDep) -> Changed, diffOpt + | s -> s, diffOpt) | None, None -> (match old.decls, current.decls with | Some x, Some y -> unchanged_to_change_status (eq_varinfo x y ~rename_mapping:empty_rename_mapping |> fst), None | _, _ -> failwith "should never collect any empty entries in GlobalMap") diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml index 2686e16a86..99f3fb951c 100644 --- a/src/incremental/compareGlobals.ml +++ b/src/incremental/compareGlobals.ml @@ -133,7 +133,7 @@ let eqF (old: Cil.fundec) (current: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) opti ) in - if sameLocals then + if not sameLocals then (Changed, None, empty_rename_mapping) else match cfgs with From ef2a721fae5c343b53d95ea57717357844abfbfb Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Tue, 7 Mar 2023 13:21:18 +0100 Subject: [PATCH 086/518] cleanup compareCilFiles --- src/incremental/compareCIL.ml | 55 +++++++++++------------------------ 1 file changed, 17 insertions(+), 38 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 23be2d9223..cbe197950d 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -53,43 +53,25 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = global_typ_acc := []; let findChanges map name current_global = try - if not (GobConfig.get_bool "incremental.detect-renames") then - let old_global = GlobalMap.find name map in - let change_status, diff = eq old_global current_global cfgs in - let append_to_changed ~unchangedHeader = - changes.changed <- {current = current_global; old = old_global; unchangedHeader; diff} :: changes.changed - in - match change_status with - | Changed -> - append_to_changed ~unchangedHeader:true - | Unchanged -> changes.unchanged <- {current = current_global; old = old_global} :: changes.unchanged - | ChangedFunHeader f - | ForceReanalyze f -> - changes.exclude_from_rel_destab <- VarinfoSet.add f.svar changes.exclude_from_rel_destab; - append_to_changed ~unchangedHeader:false; + let old_global = GlobalMap.find name map in + let change_status, diff = eq old_global current_global cfgs in + let append_to_changed ~unchangedHeader = + changes.changed <- {current = current_global; old = old_global; unchangedHeader; diff} :: changes.changed + in + match change_status with + | Changed -> + append_to_changed ~unchangedHeader:true + | Unchanged -> changes.unchanged <- {current = current_global; old = old_global} :: changes.unchanged + | ChangedFunHeader f + | ForceReanalyze f -> + changes.exclude_from_rel_destab <- VarinfoSet.add f.svar changes.exclude_from_rel_destab; + append_to_changed ~unchangedHeader:false with Not_found -> changes.added <- current_global::changes.added (* Global could not be found in old map -> added *) in if GobConfig.get_bool "incremental.detect-renames" then ( let renameDetectionResults = detectRenamedFunctions oldMap newMap in - if Messages.tracing then - GlobalColMap.to_seq renameDetectionResults |> - Seq.iter - (fun (gT, (functionGlobal, status)) -> - Messages.trace "compareCIL" "Function status of %s is=" (name_of_global_col gT); - match status with - | Unchanged _ -> Messages.trace "compareCIL" "Same Name\n"; - | Added -> Messages.trace "compareCIL" "Added\n"; - | Removed -> Messages.trace "compareCIL" "Removed\n"; - | Changed _ -> Messages.trace "compareCIL" "Changed\n"; - | UnchangedButRenamed toFrom -> - match toFrom.def with - | Some(Fun f) -> Messages.trace "compareCIL" "Renamed to %s\n" f.svar.vname; - | Some(Var v) -> Messages.trace "compareCIL" "Renamed to %s\n" v.vname; - | _ -> (); - ); - let unchanged, changed, added, removed = GlobalColMap.fold (fun _ (global, status) (u, c, a, r) -> match status with | Unchanged now -> (u @ [{old=global; current=now}], c, a, r) @@ -104,13 +86,10 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = changes.removed <- removed; changes.changed <- changed; changes.unchanged <- unchanged; - ); - - (* For each function in the new file, check whether a function with the same name - already existed in the old version, and whether it is the same function. *) - GlobalMap.iter (fun name glob_col -> findChanges oldMap name glob_col) newMap; - - if not (GobConfig.get_bool "incremental.detect-renames") then ( + ) else ( + (* For each function in the new file, check whether a function with the same name + already existed in the old version, and whether it is the same function. *) + GlobalMap.iter (fun name glob_col -> findChanges oldMap name glob_col) newMap; GlobalMap.iter (fun name glob -> if not (GlobalMap.mem name newMap) then changes.removed <- (glob::changes.removed)) oldMap; ); changes From 68ed7e0b07fb933e064640ea877965dc70c08a5c Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Tue, 7 Mar 2023 13:42:04 +0100 Subject: [PATCH 087/518] remove redundant global in output map --- src/incremental/compareCIL.ml | 2 +- src/incremental/detectRenamedFunctions.ml | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index cbe197950d..9e3ff5280a 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -72,7 +72,7 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = if GobConfig.get_bool "incremental.detect-renames" then ( let renameDetectionResults = detectRenamedFunctions oldMap newMap in - let unchanged, changed, added, removed = GlobalColMap.fold (fun _ (global, status) (u, c, a, r) -> + let unchanged, changed, added, removed = GlobalColMap.fold (fun global status (u, c, a, r) -> match status with | Unchanged now -> (u @ [{old=global; current=now}], c, a, r) | UnchangedButRenamed now -> (u @ [{old=global; current=now}], c, a, r) diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index e3ab0328e2..c767b47189 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -15,7 +15,7 @@ type functionDependencies = string VarinfoMap.t type status = SameName of global_col | Renamed of global_col | Created | Deleted | Modified of global_col * bool type outputFunctionStatus = Unchanged of global_col | UnchangedButRenamed of global_col | Added | Removed | Changed of global_col * bool -type output = global_col * outputFunctionStatus +type output = outputFunctionStatus let pretty (f: status) = match f with @@ -269,7 +269,7 @@ let fillStatusForUnassignedElems oldMap newMap (data: carryType) = let mapAnalysisResultToOutput (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) (data: carryType) : output GlobalColMap.t = (*Map back to GFun and exposed function status*) - let extractOutput f (s: status) = + let extractOutput _ (s: status) = let outputS = match s with | SameName x -> Unchanged x | Renamed x -> UnchangedButRenamed x @@ -277,7 +277,7 @@ let mapAnalysisResultToOutput (oldMap : global_col StringMap.t) (newMap : global | Deleted -> Removed | Modified (x, unchangedHeader) -> Changed (x, unchangedHeader) in - f, outputS + outputS in (*Merge together old and now functions*) From b959c3c6872798999dd02cbc63448f4de185b230 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Tue, 7 Mar 2023 14:52:50 +0100 Subject: [PATCH 088/518] fix updating of compinfo names and ckeys for comparison without renaming detection --- src/framework/constraints.ml | 2 +- src/incremental/compareAST.ml | 12 ++++------ src/incremental/compareCIL.ml | 27 ++++++++++++++--------- src/incremental/detectRenamedFunctions.ml | 2 +- 4 files changed, 22 insertions(+), 21 deletions(-) diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index abe4f72804..aeb13d0b5b 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -827,7 +827,7 @@ struct | Some {changes; _} -> changes | None -> empty_change_info () in - List.(Printf.printf "change_info = { unchanged = %d; changed = %d; added = %d; removed = %d }\n" (length c.unchanged) (length c.changed) (length c.added) (length c.removed)); + List.(Printf.printf "change_info = { unchanged = %d; changed = %d (with unchangedHeader = %d); added = %d; removed = %d }\n" (length c.unchanged) (length c.changed) (length (List.filter (fun c -> c.unchangedHeader) c.changed)) (length c.added) (length c.removed)); let changed_funs = List.filter_map (function | {old = {def = Some (Fun f); _}; diff = None; _} -> diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 34368da636..2e836bc257 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -165,15 +165,11 @@ and eq_typ_acc ?(fun_parameter_name_comparison_enabled: bool = true) (a: typ) (b else ( let acc = (a, b) :: acc in let (res, rm) = eq_compinfo compinfo1 compinfo2 acc rename_mapping &&>> forward_list_equal (eq_attribute ~acc) attr1 attr2 in - let updated_rm: rename_mapping = - if res then + let updated_rm = + if res then ( global_typ_acc := (a, b) :: !global_typ_acc; - (* Reset cnames and ckeys to the old value. Only affects anonymous structs/unions where names are not checked for equality. *) - (* TODO - compinfo2.cname <- compinfo1.cname; - compinfo2.ckey <- compinfo1.ckey; - *) - register_rename_on_success rm (Some((compinfo2, compinfo1))) None + register_rename_on_success rm (Some((compinfo2, compinfo1))) None + ) else rm in res, updated_rm ) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 9e3ff5280a..ef12e54b61 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -5,20 +5,25 @@ include CompareAST include CompareCFG open CilMaps -let eq_glob (old: global_col) (current: global_col) (cfgs : (cfg * (cfg * cfg)) option) = match old.def, current.def with - | Some (Var x), Some (Var y) -> unchanged_to_change_status (eq_varinfo x y ~rename_mapping:empty_rename_mapping |> fst), None (* ignore the init_info - a changed init of a global will lead to a different start state *) - | Some (Fun f), Some (Fun g) -> ( +let eq_glob (old: global_col) (current: global_col) (cfgs : (cfg * (cfg * cfg)) option) = + let identical, diff, renamesOnSuccess = match old.def, current.def with + | Some (Var x), Some (Var y) -> + let identical, (_,_,_,renamesOnSuccess) = eq_varinfo x y ~rename_mapping:empty_rename_mapping in + unchanged_to_change_status identical, None, renamesOnSuccess (* ignore the init_info - a changed init of a global will lead to a different start state *) + | Some (Fun f), Some (Fun g) -> ( let identical, diffOpt, funDep, globVarDep, renamesOnSuccess = CompareGlobals.eqF f g cfgs VarinfoMap.empty VarinfoMap.empty in (*Perform renames no matter what.*) - let _ = performRenames renamesOnSuccess in match identical with - | Unchanged when not (VarinfoMap.is_empty funDep && areGlobalVarRenameAssumptionsEmpty globVarDep) -> Changed, diffOpt - | s -> s, diffOpt) - | None, None -> (match old.decls, current.decls with - | Some x, Some y -> unchanged_to_change_status (eq_varinfo x y ~rename_mapping:empty_rename_mapping |> fst), None - | _, _ -> failwith "should never collect any empty entries in GlobalMap") - | _, _ -> Changed, None (* it is considered to be changed (not added or removed) because a global collection only exists in the map - if there is at least one declaration or definition for this global *) + | Unchanged when not (VarinfoMap.is_empty funDep && areGlobalVarRenameAssumptionsEmpty globVarDep) -> Changed, diffOpt, renamesOnSuccess + | s -> s, diffOpt, renamesOnSuccess) + | None, None -> (match old.decls, current.decls with + | Some x, Some y -> + let identical, (_,_,_,renamesOnSuccess) = eq_varinfo x y ~rename_mapping:empty_rename_mapping in + unchanged_to_change_status identical, None, renamesOnSuccess + | _, _ -> failwith "should never collect any empty entries in GlobalMap") + | _, _ -> Changed, None, ([], []) (* it is considered to be changed (not added or removed) because a global collection only exists in the map if there is at least one declaration or definition for this global *) in + performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during successful comparisons *) + identical, diff let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let cfgs = if GobConfig.get_string "incremental.compare" = "cfg" diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index c767b47189..76279df9d4 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -42,7 +42,7 @@ let getFunctionAndGVarMap (ast: file) : f StringMap.t * v StringMap.t = let performRenames (renamesOnSuccess: renamesOnSuccess) = begin let (compinfoRenames, enumRenames) = renamesOnSuccess in - List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname) compinfoRenames; + List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname; compinfo2.ckey <- compinfo1.ckey) compinfoRenames; List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; end From abdfe66ff3512ac64d73ce32b740fb373eb6de58 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Tue, 7 Mar 2023 15:34:51 +0100 Subject: [PATCH 089/518] remove extra output type and avoid another mapping between types --- src/incremental/compareCIL.ml | 59 +++++++++++------------ src/incremental/detectRenamedFunctions.ml | 34 +------------ 2 files changed, 31 insertions(+), 62 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index ef12e54b61..f8c890396b 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -56,42 +56,41 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let changes = empty_change_info () in global_typ_acc := []; - let findChanges map name current_global = - try - let old_global = GlobalMap.find name map in - let change_status, diff = eq old_global current_global cfgs in - let append_to_changed ~unchangedHeader = - changes.changed <- {current = current_global; old = old_global; unchangedHeader; diff} :: changes.changed - in - match change_status with - | Changed -> - append_to_changed ~unchangedHeader:true - | Unchanged -> changes.unchanged <- {current = current_global; old = old_global} :: changes.unchanged - | ChangedFunHeader f - | ForceReanalyze f -> - changes.exclude_from_rel_destab <- VarinfoSet.add f.svar changes.exclude_from_rel_destab; - append_to_changed ~unchangedHeader:false - with Not_found -> changes.added <- current_global::changes.added (* Global could not be found in old map -> added *) - in if GobConfig.get_bool "incremental.detect-renames" then ( let renameDetectionResults = detectRenamedFunctions oldMap newMap in - let unchanged, changed, added, removed = GlobalColMap.fold (fun global status (u, c, a, r) -> - match status with - | Unchanged now -> (u @ [{old=global; current=now}], c, a, r) - | UnchangedButRenamed now -> (u @ [{old=global; current=now}], c, a, r) - | Added -> (u, c, a @ [global], r) - | Removed -> (u, c, a, r @ [global]) - | Changed (now,unchangedHeader) -> (u, c @ [{old=global; current=now; unchangedHeader=unchangedHeader; diff=None}], a, r) - ) renameDetectionResults (changes.unchanged, changes.changed, changes.added, changes.removed) - in + let addToChanges firstPass global status = + match status with + | SameName now when firstPass-> changes.unchanged <- {old=global; current=now} :: changes.unchanged + | Renamed now when firstPass -> changes.unchanged <- {old=global; current=now} :: changes.unchanged + | Modified (now, unchangedHeader) when firstPass -> changes.changed <- {old=global; current=now; unchangedHeader=unchangedHeader; diff=None} :: changes.changed + | Created -> changes.added <- global :: changes.added + | Deleted -> changes.removed <- global :: changes.removed + | _ -> () in + + GlobalColMap.iter (addToChanges true) renameDetectionResults.statusForOldElem; + GlobalColMap.iter (addToChanges false) renameDetectionResults.statusForOldElem; - changes.added <- added; - changes.removed <- removed; - changes.changed <- changed; - changes.unchanged <- unchanged; ) else ( + let findChanges map name current_global = + try + let old_global = GlobalMap.find name map in + let change_status, diff = eq old_global current_global cfgs in + let append_to_changed ~unchangedHeader = + changes.changed <- {current = current_global; old = old_global; unchangedHeader; diff} :: changes.changed + in + match change_status with + | Changed -> + append_to_changed ~unchangedHeader:true + | Unchanged -> changes.unchanged <- {current = current_global; old = old_global} :: changes.unchanged + | ChangedFunHeader f + | ForceReanalyze f -> + changes.exclude_from_rel_destab <- VarinfoSet.add f.svar changes.exclude_from_rel_destab; + append_to_changed ~unchangedHeader:false + with Not_found -> changes.added <- current_global::changes.added (* Global could not be found in old map -> added *) + in + (* For each function in the new file, check whether a function with the same name already existed in the old version, and whether it is the same function. *) GlobalMap.iter (fun name glob_col -> findChanges oldMap name glob_col) newMap; diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 76279df9d4..482785791c 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -10,12 +10,8 @@ type v = varinfo * initinfo * location (*A dependency maps the function it depends on to the name the function has to be changed to*) type functionDependencies = string VarinfoMap.t - (*Renamed: newName * dependencies; Modified=now*unchangedHeader*) type status = SameName of global_col | Renamed of global_col | Created | Deleted | Modified of global_col * bool -type outputFunctionStatus = Unchanged of global_col | UnchangedButRenamed of global_col | Added | Removed | Changed of global_col * bool - -type output = outputFunctionStatus let pretty (f: status) = match f with @@ -267,33 +263,11 @@ let fillStatusForUnassignedElems oldMap newMap (data: carryType) = assignStatusToUnassignedElem data nowF registerStatusForNowF data.statusForNowElem data.reverseMapping Created ) newMap -let mapAnalysisResultToOutput (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) (data: carryType) : output GlobalColMap.t = - (*Map back to GFun and exposed function status*) - let extractOutput _ (s: status) = - let outputS = match s with - | SameName x -> Unchanged x - | Renamed x -> UnchangedButRenamed x - | Created -> Added - | Deleted -> Removed - | Modified (x, unchangedHeader) -> Changed (x, unchangedHeader) - in - outputS - in - - (*Merge together old and now functions*) - GlobalColMap.merge (fun _ a b -> - if Option.is_some a then a - else if Option.is_some b then b - else None - ) - (GlobalColMap.mapi extractOutput data.statusForOldElem) - (GlobalColMap.mapi extractOutput data.statusForNowElem) - -let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) : output GlobalColMap.t = +let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) : carryType = let initialData: carryType = findSameNameMatchingGVars oldMap newMap emptyCarryType in (*Go through all functions, for all that have not been renamed *) - let finalData = findSameNameMatchingFunctions oldMap newMap initialData (fun oldF nowF change_status functionDependencies global_var_dependencies renamesOnSuccess data -> + findSameNameMatchingFunctions oldMap newMap initialData (fun oldF nowF change_status functionDependencies global_var_dependencies renamesOnSuccess data -> let oldG = GlobalMap.find oldF.svar.vname oldMap in let nowG = GlobalMap.find nowF.svar.vname newMap in @@ -316,7 +290,3 @@ let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_co (*At this point we already know of the functions that have changed and stayed the same. We now assign the correct status to all the functions that have been mapped. The functions that have not been mapped are added/removed.*) fillStatusForUnassignedElems oldMap newMap - in - - (*Done with the analyis, the following just adjusts the output types.*) - mapAnalysisResultToOutput oldMap newMap finalData From c0aaa8162141fbcb45802468724014547db8126a Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Tue, 7 Mar 2023 16:47:49 +0100 Subject: [PATCH 090/518] cleanup eqF: same handling for cfg and ast comparison --- src/incremental/compareGlobals.ml | 62 +++++++++---------------------- 1 file changed, 17 insertions(+), 45 deletions(-) diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml index 99f3fb951c..57883fff7c 100644 --- a/src/incremental/compareGlobals.ml +++ b/src/incremental/compareGlobals.ml @@ -86,64 +86,36 @@ let eqF (old: Cil.fundec) (current: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) opti ForceReanalyze current, None, empty_rename_mapping else - (* Compares the two varinfo lists, returning as a first element, if the size of the two lists are equal, - * and as a second a rename_mapping, holding the rename assumptions *) - let rec rename_mapping_aware_compare (alocals: varinfo list) (blocals: varinfo list) (rename_mapping: string StringMap.t) = match alocals, blocals with - | [], [] -> true, rename_mapping - | origLocal :: als, nowLocal :: bls -> - let new_mapping = StringMap.add origLocal.vname nowLocal.vname rename_mapping in - - (*TODO: maybe optimize this with eq_varinfo*) - rename_mapping_aware_compare als bls new_mapping - | _, _ -> false, rename_mapping - in - - let unchangedHeader, headerRenameMapping, renamesOnSuccessHeader = match cfgs with - | None -> ( - let headerSizeEqual, headerRenameMapping = rename_mapping_aware_compare old.sformals current.sformals (StringMap.empty) in - let actHeaderRenameMapping = (headerRenameMapping, global_function_rename_mapping, global_var_rename_mapping, ([], [])) in - - let (unchangedHeader, (_, _, _, renamesOnSuccessHeader)) = - eq_varinfo old.svar current.svar ~rename_mapping:actHeaderRenameMapping - &&>> forward_list_equal eq_varinfo old.sformals current.sformals in - unchangedHeader, headerRenameMapping, renamesOnSuccessHeader - ) - | Some _ -> ( - let unchangedHeader, headerRenameMapping = eq_varinfo old.svar current.svar ~rename_mapping:empty_rename_mapping &&>> - forward_list_equal eq_varinfo old.sformals current.sformals in - let (_, _, _, renamesOnSuccessHeader) = headerRenameMapping in - - (unchangedHeader && is_rename_mapping_empty headerRenameMapping), StringMap.empty, renamesOnSuccessHeader - ) - in + let add_locals_to_rename_mapping la lb map = + try + List.fold_left (fun map (a, b) -> StringMap.add a.vname b.vname map) map (List.combine la lb) + with Invalid_argument _ -> map in + + let parameterMapping = add_locals_to_rename_mapping old.sformals current.sformals StringMap.empty in + let renameMapping = (parameterMapping, global_function_rename_mapping, global_var_rename_mapping, ([], [])) in + + (* compare the function header based on the collected rename assumptions for parameters *) + let unchangedHeader, renameMapping = eq_varinfo old.svar current.svar ~rename_mapping:renameMapping + &&>> forward_list_equal eq_varinfo old.sformals current.sformals in if not unchangedHeader then ChangedFunHeader current, None, empty_rename_mapping else - (* Here the local variables are checked to be equal *) - (* sameLocals: when running on cfg, true iff the locals are identical; on ast: if the size of the locals stayed the same*) - let sameLocals, rename_mapping = - match cfgs with - | None -> ( - let sizeEqual, local_rename = rename_mapping_aware_compare old.slocals current.slocals headerRenameMapping in - sizeEqual, (local_rename, global_function_rename_mapping, global_var_rename_mapping, renamesOnSuccessHeader) - ) - | Some _ -> ( - let isEqual, rename_mapping = forward_list_equal eq_varinfo old.slocals current.slocals ~rename_mapping:(StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, renamesOnSuccessHeader) in - isEqual && is_rename_mapping_empty rename_mapping, rename_mapping - ) - in + (* include matching of local variables into rename mapping *) + let renameMapping = match renameMapping with + | (pm, gf, gv, re) -> (add_locals_to_rename_mapping old.slocals current.slocals pm, gf, gv, re) in + let sameLocals, renameMapping = forward_list_equal eq_varinfo old.slocals current.slocals ~rename_mapping:renameMapping in if not sameLocals then (Changed, None, empty_rename_mapping) else match cfgs with | None -> - let (identical, new_rename_mapping) = eq_block (old.sbody, old) (current.sbody, current) ~rename_mapping in + let (identical, new_rename_mapping) = eq_block (old.sbody, old) (current.sbody, current) ~rename_mapping:renameMapping in unchanged_to_change_status identical, None, new_rename_mapping | Some (cfgOld, (cfgNew, cfgNewBack)) -> let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in - let matches, diffNodes1, updated_rename_mapping = compareFun (module CfgOld) (module CfgNew) old current rename_mapping in + let matches, diffNodes1, updated_rename_mapping = compareFun (module CfgOld) (module CfgNew) old current renameMapping in if diffNodes1 = [] then (Unchanged, None, updated_rename_mapping) else (Changed, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, updated_rename_mapping) in From 55da723c58293ab32a347b089e98a1b5cbf0d60c Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Wed, 8 Mar 2023 17:35:07 +0100 Subject: [PATCH 091/518] make detection of renamed globals more concise --- src/incremental/compareAST.ml | 36 +- src/incremental/compareCIL.ml | 21 +- src/incremental/detectRenamedFunctions.ml | 379 ++++++---------------- 3 files changed, 123 insertions(+), 313 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 2e836bc257..e6ca67f1df 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -3,15 +3,14 @@ open CilMaps module StringMap = Map.Make(String) -type method_rename_assumption = {original_method_name: string; new_method_name: string} -type method_rename_assumptions = method_rename_assumption VarinfoMap.t -type glob_var_rename_assumptions = string VarinfoMap.t +type method_rename_assumptions = varinfo VarinfoMap.t +type glob_var_rename_assumptions = varinfo VarinfoMap.t (*On a successful match, these compinfo and enuminfo names have to be set to the snd element of the tuple. *) type renamesOnSuccess = (compinfo * compinfo) list * (enuminfo * enuminfo) list (*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) -type rename_mapping = (string StringMap.t) * (method_rename_assumptions) * glob_var_rename_assumptions * renamesOnSuccess +type rename_mapping = (string StringMap.t) * method_rename_assumptions * glob_var_rename_assumptions * renamesOnSuccess (*Compares two names, being aware of the rename_mapping. Returns true iff: 1. there is a rename for name1 -> name2 = rename(name1) @@ -47,13 +46,12 @@ let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> let rename_mapping_to_string (rename_mapping: rename_mapping) = let (local, methods, glob_vars, _) = rename_mapping in let local_string = [%show: (string * string) list] (List.of_seq (StringMap.to_seq local)) in - let methods_string: string = List.of_seq (VarinfoMap.to_seq methods |> Seq.map snd) |> - List.map (fun x -> match x with {original_method_name; new_method_name} -> - "(methodName: " ^ original_method_name ^ " -> " ^ new_method_name ^ ")") |> + let methods_string: string = List.of_seq (VarinfoMap.to_seq methods) |> + List.map (fun (oldf, newf) -> "(methodName: " ^ oldf.vname ^ " -> " ^ newf.vname ^ ")") |> String.concat ", " in let global_var_string: string = string_tuple_to_string (List.of_seq (VarinfoMap.to_seq glob_vars) |> - List.map (fun (v, nowName) -> v.vname, nowName)) in + List.map (fun (vold, vnew) -> vold.vname, vnew.vname)) in "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "]; glob_vars=" ^ global_var_string ^ ")" @@ -233,10 +231,10 @@ and eq_varinfo (a: varinfo) (b: varinfo) ~(acc: (typ * typ) list) ~(rename_mappi let present_mapping = VarinfoMap.find_opt a glob_vars in match present_mapping with - | Some (knownNowName) -> - b.vname = knownNowName, method_rename_mappings, glob_vars + | Some (knownNowVarinfo) -> + b.vname = knownNowVarinfo.vname, method_rename_mappings, glob_vars | None -> ( - let update_glob_vars = VarinfoMap.add a b.vname glob_vars in + let update_glob_vars = VarinfoMap.add a b glob_vars in true, method_rename_mappings, update_glob_vars ) else rename_mapping_aware_name_comparison a.vname b.vname rename_mapping, method_rename_mappings, glob_vars @@ -247,15 +245,12 @@ and eq_varinfo (a: varinfo) (b: varinfo) ~(acc: (typ * typ) list) ~(rename_mappi | TFun(_, aParamSpec, _, _), TFun(_, bParamSpec, _, _) -> ( let specific_method_rename_mapping = VarinfoMap.find_opt a method_rename_mappings in match specific_method_rename_mapping with - | Some method_rename_mapping -> - let is_naming_ok = method_rename_mapping.original_method_name = a.vname && method_rename_mapping.new_method_name = b.vname in + | Some new_varinfo -> + let is_naming_ok = new_varinfo.vname = b.vname in is_naming_ok, method_rename_mappings, glob_vars | None -> if a.vname <> b.vname then - let assumption = - {original_method_name = a.vname; new_method_name = b.vname} in - - true, VarinfoMap.add a assumption method_rename_mappings, glob_vars + true, VarinfoMap.add a b method_rename_mappings, glob_vars else true, method_rename_mappings, glob_vars ) | TInt (_, _), TInt (_, _) -> compare_local_and_global_var @@ -267,13 +262,6 @@ and eq_varinfo (a: varinfo) (b: varinfo) ~(acc: (typ * typ) list) ~(rename_mappi (*If the following is a method call, we need to check if we have a mapping for that method call. *) let fun_parameter_name_comparison_enabled = match b.vtype with | TFun(_, _, _, _) -> false - (*| GVar (_, _, _) -> ( - let new_local = VarinfoMap.find_opt a glob_vars in - - match new_local with - | Some now_name -> (StringMap.add a.vname now_name StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) - | None -> (StringMap.empty, updated_method_rename_mappings, updatedGlobVarMapping) - )*) | _ -> true in diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index f8c890396b..1bda93b6bc 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -14,7 +14,7 @@ let eq_glob (old: global_col) (current: global_col) (cfgs : (cfg * (cfg * cfg)) let identical, diffOpt, funDep, globVarDep, renamesOnSuccess = CompareGlobals.eqF f g cfgs VarinfoMap.empty VarinfoMap.empty in (*Perform renames no matter what.*) match identical with - | Unchanged when not (VarinfoMap.is_empty funDep && areGlobalVarRenameAssumptionsEmpty globVarDep) -> Changed, diffOpt, renamesOnSuccess + | Unchanged when not (VarinfoMap.is_empty funDep && VarinfoMap.for_all (fun ov nv -> ov.vname = nv.vname) globVarDep) -> Changed, diffOpt, renamesOnSuccess | s -> s, diffOpt, renamesOnSuccess) | None, None -> (match old.decls, current.decls with | Some x, Some y -> @@ -58,19 +58,12 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = global_typ_acc := []; if GobConfig.get_bool "incremental.detect-renames" then ( - let renameDetectionResults = detectRenamedFunctions oldMap newMap in - - let addToChanges firstPass global status = - match status with - | SameName now when firstPass-> changes.unchanged <- {old=global; current=now} :: changes.unchanged - | Renamed now when firstPass -> changes.unchanged <- {old=global; current=now} :: changes.unchanged - | Modified (now, unchangedHeader) when firstPass -> changes.changed <- {old=global; current=now; unchangedHeader=unchangedHeader; diff=None} :: changes.changed - | Created -> changes.added <- global :: changes.added - | Deleted -> changes.removed <- global :: changes.removed - | _ -> () in - - GlobalColMap.iter (addToChanges true) renameDetectionResults.statusForOldElem; - GlobalColMap.iter (addToChanges false) renameDetectionResults.statusForOldElem; + let (change_info, final_mapping) = detectRenamedFunctions oldMap newMap in + changes.added <- change_info.added; + changes.removed <- change_info.removed; + changes.changed <- change_info.changed; + changes.unchanged <- change_info.unchanged; + changes.exclude_from_rel_destab <- change_info.exclude_from_rel_destab ) else ( let findChanges map name current_global = diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 482785791c..c47f59fc16 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -2,39 +2,6 @@ open GoblintCil include CompareGlobals open CilMaps -module StringSet = Set.Make(String) - -type f = fundec * location -type v = varinfo * initinfo * location - -(*A dependency maps the function it depends on to the name the function has to be changed to*) -type functionDependencies = string VarinfoMap.t - -(*Renamed: newName * dependencies; Modified=now*unchangedHeader*) -type status = SameName of global_col | Renamed of global_col | Created | Deleted | Modified of global_col * bool - -let pretty (f: status) = - match f with - | SameName _ -> "SameName" - | Renamed x -> ("Renamed to " ^ CompareGlobals.name_of_global_col x) - | Created -> "Added" - | Deleted -> "Removed" - | Modified _ -> "Changed" - -let printFundecMap elemToString map = begin - Seq.iter (fun (f, e) -> - ignore@@Pretty.printf "%s->%s;" f.svar.vname (elemToString e); - ) (FundecMap.to_seq map) -end - -let getFunctionAndGVarMap (ast: file) : f StringMap.t * v StringMap.t = - Cil.foldGlobals ast (fun (functionMap, gvarMap) global -> - match global with - | GFun (fundec, location) -> (StringMap.add fundec.svar.vname (fundec, location) functionMap, gvarMap) - | GVar (varinfo, initinfo, location) -> (functionMap, StringMap.add varinfo.vname (varinfo, initinfo, location) gvarMap) - | _ -> functionMap, gvarMap - ) (StringMap.empty, StringMap.empty) - let performRenames (renamesOnSuccess: renamesOnSuccess) = begin let (compinfoRenames, enumRenames) = renamesOnSuccess in @@ -42,251 +9,113 @@ let performRenames (renamesOnSuccess: renamesOnSuccess) = List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; end -let getDependencies fromEq = VarinfoMap.map (fun assumption -> assumption.new_method_name) fromEq - -(*Data type that holds the important data while checking for renames. - statusForOldElem: Status we have already figured out for a fundec from oldAST; - statusForNowElem: see statusForOldElem; - mapping: Mappings from (fundec of old AST) -> (fundec of now AST) we have already figured out to hold. - reversemapping: see method mapping, but from now -> old -*) -type carryType = { - statusForOldElem : status GlobalColMap.t; - statusForNowElem : status GlobalColMap.t; - mapping: global_col GlobalColMap.t; - reverseMapping: global_col GlobalColMap.t; -} - -let emptyCarryType = { - statusForOldElem = GlobalColMap.empty; - statusForNowElem = GlobalColMap.empty; - mapping = GlobalColMap.empty; - reverseMapping = GlobalColMap.empty; -} - -(*Carry type manipulation functions.*) - -let registerStatusForOldF f status data = - {statusForOldElem = GlobalColMap.add f status data.statusForOldElem; - statusForNowElem=data.statusForNowElem; - mapping=data.mapping; - reverseMapping=data.reverseMapping; - } - -let registerStatusForNowF f status data = - {statusForOldElem = data.statusForOldElem; - statusForNowElem=GlobalColMap.add f status data.statusForNowElem; - mapping=data.mapping; - reverseMapping=data.reverseMapping; - } - -let registerBiStatus (oldF: global_col) (nowF: global_col) (status: status) data = - {statusForOldElem=GlobalColMap.add oldF status data.statusForOldElem; - statusForNowElem=GlobalColMap.add nowF status data.statusForNowElem; - mapping=data.mapping; - reverseMapping=data.reverseMapping; - } - -let registerMapping oldF nowF data = - {statusForOldElem=data.statusForOldElem; - statusForNowElem=data.statusForNowElem; - mapping=GlobalColMap.add oldF nowF data.mapping; - reverseMapping=GlobalColMap.add nowF oldF data.reverseMapping; - } - -let registerGVarMapping oldV nowV data = { - statusForOldElem=data.statusForOldElem; - statusForNowElem=data.statusForNowElem; - mapping=data.mapping; - reverseMapping=data.reverseMapping; -} - -(*True iff the global var rename assumptions contains only entries that are identity mappings*) -let areGlobalVarRenameAssumptionsEmpty (mapping: glob_var_rename_assumptions) : bool = - VarinfoMap.for_all (fun varinfo newName -> varinfo.vname = newName) mapping - -(*returns true iff for all dependencies it is true, that the dependency has a corresponding function with the new name and matches the without having dependencies itself and the new name is not already present on the old AST. *) -let doAllDependenciesMatch (dependencies: functionDependencies) - (global_var_dependencies: glob_var_rename_assumptions) - (oldMap: global_col StringMap.t) - (newMap: global_col StringMap.t) (data: carryType) : bool * carryType = - - let isConsistent = fun old nowName allEqual getName oldMap nowMap getNowOption data -> - (*Early cutoff if a previous dependency returned false. - We never create a mapping between globs where the now name was already part of the old set or the old name is part of the now set. - But only if now and old differ. - *) - if allEqual && (getName old = nowName || (not (StringMap.mem nowName oldMap) && not (StringMap.mem (getName old) nowMap))) then - let knownMapping = GlobalColMap.find_opt old data.mapping in - - (*let _ = Printf.printf "Dep: %s -> %s\n" (globalElemName2 globalElem) nowName in*) - - (*To avoid inconsitencies, if a function has already been mapped to a function, that mapping is reused again.*) - match knownMapping with - | Some(knownElem) -> - (*This function has already been mapped*) - (*let _ = Printf.printf "Already mapped. %s = %s\n" (globalElemName2 knownElem) nowName in*) - name_of_global_col knownElem = nowName, data - | None -> - let nowElemOption = getNowOption nowName in - - match nowElemOption with - | Some(nowElem) -> ( - let compare = fun old now -> - let compareVar oV nV = let (equal, (_, function_dependencies, global_var_dependencies, renamesOnSuccess)) = eq_varinfo oV nV ~rename_mapping:empty_rename_mapping in - (*eq_varinfo always comes back with a self dependency. We need to filter that out.*) - unchanged_to_change_status equal, function_dependencies, (VarinfoMap.filter (fun vi name -> not (vi.vname = oV.vname && name = nowName)) global_var_dependencies), renamesOnSuccess - in - match (old.def, now.def) with - | Some (Fun oF), Some (Fun nF) -> - let doMatch, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF oF nF None VarinfoMap.empty VarinfoMap.empty in - doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess - | Some (Var oV), Some (Var nV) -> compareVar oV nV - | None, None -> (match old.decls, now.decls with - | Some oV, Some nV -> compareVar oV nV - | _ -> failwith "Unknown or incompatible global types") - | _, _ -> failwith "Unknown or incompatible global types" - in - - let doMatch, function_dependencies, global_var_dependencies, renamesOnSuccess = compare old nowElem in - - (*Having a dependency on yourself is ok.*) - let hasNoExternalDependency = VarinfoMap.is_empty function_dependencies || ( - VarinfoMap.cardinal function_dependencies = 1 && ( - VarinfoMap.fold (fun varinfo dependency _ -> varinfo.vname = name_of_global_col old && dependency.new_method_name = name_of_global_col nowElem) function_dependencies true - ) - ) in - - (*let _ = Printf.printf "%s <-> %s: %b %b %b\n" (globalElemName2 globalElem) (globalElemName2 nowElem) doMatch hasNoExternalDependency (VarinfoMap.is_empty global_var_dependencies) in - - let _ = Printf.printf "%s\n" (rename_mapping_to_string (StringMap.empty, function_dependencies, global_var_dependencies, ([], []))) in*) - - match doMatch with - | Unchanged when hasNoExternalDependency && areGlobalVarRenameAssumptionsEmpty global_var_dependencies -> - let _ = performRenames renamesOnSuccess in - true, registerMapping old nowElem data - | _ -> false, data - ) - | None -> - (*Printf.printf "No elem with name %s found \n" nowName;*) - (*Return true assumes external globs never change. Which is ok for now*) - true, data - else false, data +let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) = + let get_varinfo gc = match gc.decls, gc.def with + | _, Some (Var v) -> v + | _, Some (Fun f) -> f.svar + | Some v, _ -> v + | _ -> failwith "A global should have at least a declaration or a definition" in + let extract_fundecs _ gc map = match gc.def with + | Some (Fun f) -> VarinfoMap.add f.svar f map + | _ -> map in + let var_fun_old = GlobalMap.fold extract_fundecs oldMap VarinfoMap.empty in + let var_fun_new = GlobalMap.fold extract_fundecs newMap VarinfoMap.empty in + let empty_rename_assumptions m = VarinfoMap.for_all (fun vo vn -> vo.vname = vn.vname) m in (* TODO or in final_matches? *) + + let compare_fundec_exact_match f1 f2 change_info final_matches = + let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in + match doMatch with + | Unchanged when empty_rename_assumptions function_dependencies && empty_rename_assumptions global_var_dependencies -> + performRenames renamesOnSuccess; + let change_info = {change_info with unchanged = change_info.unchanged} in + let final_matches = VarinfoMap.add f1.svar f2.svar final_matches in + true, change_info, final_matches + | _ -> false, change_info, final_matches in - VarinfoMap.fold (fun old nowName (allEqual, data) -> - let old = StringMap.find old.vname oldMap in - isConsistent - old - nowName - allEqual - (fun x -> name_of_global_col x) - oldMap - newMap - (fun x -> StringMap.find_opt x newMap) - data - ) dependencies (true, data) |> - VarinfoMap.fold (fun oldVarinfo nowName (allEqual, data) -> - isConsistent - (GlobalMap.find oldVarinfo.vname oldMap) - nowName - allEqual - (fun x -> name_of_global_col x) - oldMap - newMap - (fun x -> StringMap.find_opt x newMap) - data + let compare_global_var_exact_match oV nV change_info final_matches = + let (equal, (_, function_dependencies, global_var_dependencies, renamesOnSuccess)) = eq_varinfo oV nV ~rename_mapping:(StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, ([],[])) in + (*eq_varinfo always comes back with a self dependency. We need to filter that out.*) + if equal && empty_rename_assumptions function_dependencies && empty_rename_assumptions global_var_dependencies then ( + performRenames renamesOnSuccess; + true, change_info, VarinfoMap.add oV nV final_matches + ) else ( + false, change_info, final_matches ) - global_var_dependencies - -(*Check if f has already been assigned a status. If yes do nothing. - If not, check if the function took part in the mapping, then register it to have been renamed. Otherwise register it as the supplied status.*) -let assignStatusToUnassignedElem data f registerStatus statusMap mapping status = - if not (GlobalColMap.mem f statusMap) then - if (GlobalColMap.mem f mapping) then - registerStatus f (Renamed (GlobalColMap.find f mapping)) data - else - (*this function has been added/removed*) - registerStatus f status data - else - data - -let findSameNameMatchingGVars (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) data = - let compare_varinfo v1 v2 data = - let identical, _ = eq_varinfo v1 v2 ~rename_mapping:empty_rename_mapping in - let oldG, nowG = GlobalMap.find v1.vname oldMap, GlobalMap.find v2.vname newMap in - if identical then - registerBiStatus oldG nowG (SameName nowG) data - else - registerStatusForOldF oldG (Modified(nowG, false)) data |> - registerStatusForNowF nowG (Modified(oldG, false)) in - StringMap.fold (fun name gc_old (data: carryType) -> - try - let gc_new = StringMap.find name newMap in - match gc_old.def, gc_new.def with - | Some (Var v1), Some (Var v2) -> compare_varinfo v1 v2 data - | None, None -> (match gc_old.decls, gc_new.decls with - | Some v1, Some v2 -> compare_varinfo v1 v2 data - | _ -> data) - | _ -> data - with Not_found -> data - ) oldMap data - -(*Goes through all old functions and looks for now-functions with the same name. If a pair has been found, onMatch is called with the comparison result. - On match then modifies the carryType. Returns (list of the functions that have the same name and match, the updated carry type)*) -let findSameNameMatchingFunctions - oldFunctionMap - nowFunctionMap - (initialData: 'a) - (onMatch: fundec -> fundec -> change_status -> string VarinfoMap.t -> CompareGlobals.glob_var_rename_assumptions -> CompareGlobals.renamesOnSuccess -> 'a -> 'a) : 'a = - StringMap.fold (fun name oldFun data -> - try - let newFun = StringMap.find name nowFunctionMap in - match oldFun.def, newFun.def with - | Some (Fun f1), Some (Fun f2) -> - let doMatch, _, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in - let actDependencies = getDependencies function_dependencies in - onMatch f1 f2 doMatch actDependencies global_var_dependencies renamesOnSuccess data - | _ -> data - with Not_found -> data - ) oldFunctionMap initialData -let fillStatusForUnassignedElems oldMap newMap (data: carryType) = - data |> - (*Now go through all old functions again. Those who have not been assigned a status are removed*) - StringMap.fold (fun name f (data: carryType) -> - assignStatusToUnassignedElem data f registerStatusForOldF data.statusForOldElem data.mapping Deleted - ) oldMap |> - (*now go through all new functions. Those have have not been assigned a mapping are added.*) - StringMap.fold (fun name nowF (data: carryType) -> - assignStatusToUnassignedElem data nowF registerStatusForNowF data.statusForNowElem data.reverseMapping Created - ) newMap - -let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) : carryType = - let initialData: carryType = findSameNameMatchingGVars oldMap newMap emptyCarryType in - - (*Go through all functions, for all that have not been renamed *) - findSameNameMatchingFunctions oldMap newMap initialData (fun oldF nowF change_status functionDependencies global_var_dependencies renamesOnSuccess data -> - let oldG = GlobalMap.find oldF.svar.vname oldMap in - let nowG = GlobalMap.find nowF.svar.vname newMap in - - match change_status with - | Unchanged -> - let doDependenciesMatch, updatedData = doAllDependenciesMatch functionDependencies global_var_dependencies oldMap newMap data in + let matchGlobal ~matchVars ~matchFuns name gc_old (change_info, final_matches) = + try + let gc_new = StringMap.find name newMap in + let preservesSameNameMatches n_old n_new = n_old = n_new || (not (GlobalMap.mem n_old newMap) && not (GlobalMap.mem n_new oldMap)) in + + let compare_varinfo v1 v2 = + let identical, (_, _, _, renamesOnSuccess) = eq_varinfo v1 v2 ~rename_mapping:empty_rename_mapping in + performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) + + if identical then ( + let extendedUnchanged = {old = gc_old; current = gc_new} :: change_info.unchanged in + {change_info with unchanged = extendedUnchanged}, VarinfoMap.add v1 v2 final_matches + ) else + let extendedChanged = {old = gc_old; current = gc_new; unchangedHeader = true; diff = None} :: change_info.changed in + {change_info with changed = extendedChanged}, VarinfoMap.add v1 v2 final_matches + in + + let compare_same_name_fundec_check_contained_renames f1 f2 : varinfo VarinfoMap.t = + let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in + performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) + (* TODO recursively check dependencies, check in rename mapping for globals that were already compared *) + let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> (* TODO add global assumptions check *) + match VarinfoMap.find_opt f_old_var final_matches with + | None -> + let f_old = VarinfoMap.find f_old_var var_fun_old in + let f_new = VarinfoMap.find f_new_var var_fun_new in (* TODO: what happens if there exists no fundec for this varinfo? *) + (* check that names of match are each only contained in new or old file *) + if acc && preservesSameNameMatches f_old_var.vname f_new_var.vname then + compare_fundec_exact_match f_old f_new ci fm + else false, ci, fm + | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in + let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> + match VarinfoMap.find_opt old_var final_matches with + | None -> + if acc && preservesSameNameMatches old_var.vname new_var.vname then + compare_global_var_exact_match old_var new_var ci fm + else false, ci, fm + | Some v -> v = new_var, ci, fm + ) global_var_dependencies (true, change_info, final_matches) in + let dependenciesMatch = funDependenciesMatch && globalDependenciesMatch in + let append_to_changed ~unchangedHeader ~diff = + change_info.changed <- {current = gc_new; old = gc_old; unchangedHeader; diff} :: change_info.changed + in + (* TODO: merge with no-rename-detection case in compareCIL.compareCilFiles *) + (match doMatch with + | Unchanged when dependenciesMatch -> + change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged + | Unchanged -> + (* no diff is stored, also when comparing functions based on CFG because currently there is no mechanism to detect which part was affected by the *) + append_to_changed ~unchangedHeader:true ~diff:None + | _ -> (* this can only be ForceReanalyze or ChangedFunHeader *) + change_info.exclude_from_rel_destab <- VarinfoSet.add f1.svar change_info.exclude_from_rel_destab; + append_to_changed ~unchangedHeader:false ~diff:None); + VarinfoMap.add f1.svar f2.svar final_matches in + + match gc_old.def, gc_new.def with + | Some (Var v1), Some (Var v2) when matchVars -> compare_varinfo v1 v2 + | Some (Fun f1), Some (Fun f2) when matchFuns -> change_info, compare_same_name_fundec_check_contained_renames f1 f2 + | None, None -> (match gc_old.decls, gc_new.decls with + | Some v1, Some v2 when matchVars-> compare_varinfo v1 v2 + | _ -> change_info, final_matches) + | _ -> change_info, final_matches + with Not_found -> let extendedRemoved = gc_old :: change_info.removed in {change_info with removed = extendedRemoved}, final_matches in + + let addNewGlobals name gc_new (change_info, final_matches) = + if not (VarinfoMap.mem (get_varinfo gc_new) final_matches) then + let ext_added = gc_new :: change_info.added in + ({change_info with added = ext_added}, final_matches) + else (change_info, final_matches) + in - if doDependenciesMatch then - registerBiStatus oldG nowG (SameName(oldG)) updatedData - else - registerStatusForOldF oldG (Modified (nowG, true)) data |> - registerStatusForNowF nowG (Modified (oldG, true)) - | Changed -> - registerStatusForOldF oldG (Modified (nowG, true)) data |> - registerStatusForNowF nowG (Modified (oldG, true)) - | _ -> - registerStatusForOldF oldG (Modified (nowG, false)) data |> - registerStatusForNowF nowG (Modified (oldG, false)) - ) |> - (*At this point we already know of the functions that have changed and stayed the same. We now assign the correct status to all the functions that - have been mapped. The functions that have not been mapped are added/removed.*) - fillStatusForUnassignedElems oldMap newMap + (empty_change_info (), VarinfoMap.empty) (* change_info and final_matches is propagated *) + |> GlobalMap.fold (matchGlobal ~matchVars:true ~matchFuns:false) oldMap + |> GlobalMap.fold (matchGlobal ~matchVars:false ~matchFuns:true) oldMap + |> GlobalMap.fold addNewGlobals newMap From 009f457baf4dd49961fbeba6b00cdeeffd6f3edd Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Wed, 8 Mar 2023 18:29:43 +0100 Subject: [PATCH 092/518] refactor --- src/incremental/detectRenamedFunctions.ml | 78 +++++++++++------------ 1 file changed, 39 insertions(+), 39 deletions(-) diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index c47f59fc16..8c648355b4 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -9,12 +9,43 @@ let performRenames (renamesOnSuccess: renamesOnSuccess) = List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; end -let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) = +let preservesSameNameMatches n_old oldMap n_new newMap = n_old = n_new || (not (GlobalMap.mem n_old newMap) && not (GlobalMap.mem n_new oldMap)) + +(* TODO: possibly merge with eq_varinfo, provide only varinfo and mapping from varinfo to global_col *) +(* Compares two varinfos. finalizeOnlyExactMatch=true allows to check a rename assumption and discard the comparison result in case they do not match *) +let compare_varinfo ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new newMap change_info final_matches = + if preservesSameNameMatches oV.vname oldMap nV.vname newMap then + (* do not allow for matches between differently named variables if one of the variables names exists in both, the new and old file *) + false, change_info, final_matches + else ( + (* TODO does the emptyness of the dependencies need to be checked? *) + let identical, (_, function_dependencies, global_var_dependencies, renamesOnSuccess) = eq_varinfo oV nV ~rename_mapping:empty_rename_mapping in + + if not finalizeOnlyExactMatch || identical then + performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) + if identical then ( + change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; + true, change_info, VarinfoMap.add oV nV final_matches + ) else if not finalizeOnlyExactMatch then ( + change_info.changed <- {old = gc_old; current = gc_new; unchangedHeader = true; diff = None} :: change_info.changed; + false, change_info, VarinfoMap.add oV nV final_matches + ) else + false, change_info, final_matches + ) +let compare_varinfo_exact = compare_varinfo ~finalizeOnlyExactMatch:true + +let addNewGlobals name gc_new (change_info, final_matches) = let get_varinfo gc = match gc.decls, gc.def with | _, Some (Var v) -> v | _, Some (Fun f) -> f.svar | Some v, _ -> v | _ -> failwith "A global should have at least a declaration or a definition" in + if not (VarinfoMap.mem (get_varinfo gc_new) final_matches) then + let ext_added = gc_new :: change_info.added in + ({change_info with added = ext_added}, final_matches) + else (change_info, final_matches) + +let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) = let extract_fundecs _ gc map = match gc.def with | Some (Fun f) -> VarinfoMap.add f.svar f map | _ -> map in @@ -33,53 +64,29 @@ let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_co | _ -> false, change_info, final_matches in - let compare_global_var_exact_match oV nV change_info final_matches = - let (equal, (_, function_dependencies, global_var_dependencies, renamesOnSuccess)) = eq_varinfo oV nV ~rename_mapping:(StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, ([],[])) in - (*eq_varinfo always comes back with a self dependency. We need to filter that out.*) - if equal && empty_rename_assumptions function_dependencies && empty_rename_assumptions global_var_dependencies then ( - performRenames renamesOnSuccess; - true, change_info, VarinfoMap.add oV nV final_matches - ) else ( - false, change_info, final_matches - ) - in - let matchGlobal ~matchVars ~matchFuns name gc_old (change_info, final_matches) = try let gc_new = StringMap.find name newMap in - let preservesSameNameMatches n_old n_new = n_old = n_new || (not (GlobalMap.mem n_old newMap) && not (GlobalMap.mem n_new oldMap)) in - let compare_varinfo v1 v2 = - let identical, (_, _, _, renamesOnSuccess) = eq_varinfo v1 v2 ~rename_mapping:empty_rename_mapping in - performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) - - if identical then ( - let extendedUnchanged = {old = gc_old; current = gc_new} :: change_info.unchanged in - {change_info with unchanged = extendedUnchanged}, VarinfoMap.add v1 v2 final_matches - ) else - let extendedChanged = {old = gc_old; current = gc_new; unchangedHeader = true; diff = None} :: change_info.changed in - {change_info with changed = extendedChanged}, VarinfoMap.add v1 v2 final_matches - in - - let compare_same_name_fundec_check_contained_renames f1 f2 : varinfo VarinfoMap.t = + let compare_same_name_fundec_check_contained_renames f1 f2 = let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) (* TODO recursively check dependencies, check in rename mapping for globals that were already compared *) - let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> (* TODO add global assumptions check *) + let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> match VarinfoMap.find_opt f_old_var final_matches with | None -> let f_old = VarinfoMap.find f_old_var var_fun_old in let f_new = VarinfoMap.find f_new_var var_fun_new in (* TODO: what happens if there exists no fundec for this varinfo? *) (* check that names of match are each only contained in new or old file *) - if acc && preservesSameNameMatches f_old_var.vname f_new_var.vname then + if acc then compare_fundec_exact_match f_old f_new ci fm else false, ci, fm | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> match VarinfoMap.find_opt old_var final_matches with | None -> - if acc && preservesSameNameMatches old_var.vname new_var.vname then - compare_global_var_exact_match old_var new_var ci fm + if acc && preservesSameNameMatches old_var.vname oldMap new_var.vname newMap then + compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm else false, ci, fm | Some v -> v = new_var, ci, fm ) global_var_dependencies (true, change_info, final_matches) in @@ -100,21 +107,14 @@ let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_co VarinfoMap.add f1.svar f2.svar final_matches in match gc_old.def, gc_new.def with - | Some (Var v1), Some (Var v2) when matchVars -> compare_varinfo v1 v2 + | Some (Var v1), Some (Var v2) when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm | Some (Fun f1), Some (Fun f2) when matchFuns -> change_info, compare_same_name_fundec_check_contained_renames f1 f2 | None, None -> (match gc_old.decls, gc_new.decls with - | Some v1, Some v2 when matchVars-> compare_varinfo v1 v2 + | Some v1, Some v2 when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm | _ -> change_info, final_matches) | _ -> change_info, final_matches with Not_found -> let extendedRemoved = gc_old :: change_info.removed in {change_info with removed = extendedRemoved}, final_matches in - let addNewGlobals name gc_new (change_info, final_matches) = - if not (VarinfoMap.mem (get_varinfo gc_new) final_matches) then - let ext_added = gc_new :: change_info.added in - ({change_info with added = ext_added}, final_matches) - else (change_info, final_matches) - in - (empty_change_info (), VarinfoMap.empty) (* change_info and final_matches is propagated *) |> GlobalMap.fold (matchGlobal ~matchVars:true ~matchFuns:false) oldMap |> GlobalMap.fold (matchGlobal ~matchVars:false ~matchFuns:true) oldMap From 5d90ad02541380fac7251ff00b3a1f5f7f68731f Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 09:57:56 +0100 Subject: [PATCH 093/518] fixes in rename detection --- src/incremental/detectRenamedFunctions.ml | 77 +++++++++++++++-------- 1 file changed, 50 insertions(+), 27 deletions(-) diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml index 8c648355b4..39e0c13850 100644 --- a/src/incremental/detectRenamedFunctions.ml +++ b/src/incremental/detectRenamedFunctions.ml @@ -11,10 +11,13 @@ let performRenames (renamesOnSuccess: renamesOnSuccess) = let preservesSameNameMatches n_old oldMap n_new newMap = n_old = n_new || (not (GlobalMap.mem n_old newMap) && not (GlobalMap.mem n_new oldMap)) +let addToFinalMatchesMapping oV nV final_matches = + VarinfoMap.add oV nV (fst final_matches), VarinfoMap.add nV oV (snd final_matches) + (* TODO: possibly merge with eq_varinfo, provide only varinfo and mapping from varinfo to global_col *) (* Compares two varinfos. finalizeOnlyExactMatch=true allows to check a rename assumption and discard the comparison result in case they do not match *) let compare_varinfo ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new newMap change_info final_matches = - if preservesSameNameMatches oV.vname oldMap nV.vname newMap then + if not (preservesSameNameMatches oV.vname oldMap nV.vname newMap) then (* do not allow for matches between differently named variables if one of the variables names exists in both, the new and old file *) false, change_info, final_matches else ( @@ -25,25 +28,32 @@ let compare_varinfo ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new n performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) if identical then ( change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; - true, change_info, VarinfoMap.add oV nV final_matches + true, change_info, addToFinalMatchesMapping oV nV final_matches ) else if not finalizeOnlyExactMatch then ( change_info.changed <- {old = gc_old; current = gc_new; unchangedHeader = true; diff = None} :: change_info.changed; - false, change_info, VarinfoMap.add oV nV final_matches + false, change_info, addToFinalMatchesMapping oV nV final_matches ) else false, change_info, final_matches ) let compare_varinfo_exact = compare_varinfo ~finalizeOnlyExactMatch:true -let addNewGlobals name gc_new (change_info, final_matches) = - let get_varinfo gc = match gc.decls, gc.def with +let get_varinfo gc = match gc.decls, gc.def with | _, Some (Var v) -> v | _, Some (Fun f) -> f.svar | Some v, _ -> v - | _ -> failwith "A global should have at least a declaration or a definition" in - if not (VarinfoMap.mem (get_varinfo gc_new) final_matches) then - let ext_added = gc_new :: change_info.added in - ({change_info with added = ext_added}, final_matches) - else (change_info, final_matches) + | _ -> failwith "A global should have at least a declaration or a definition" +let addNewGlobals name gc_new (change_info, final_matches) = + if not (VarinfoMap.mem (get_varinfo gc_new) (snd final_matches)) then + change_info.added <- gc_new :: change_info.added; + (change_info, final_matches) + +let addOldGlobals name gc_old (change_info, final_matches) = + if not (VarinfoMap.mem (get_varinfo gc_old) (fst final_matches)) then + change_info.removed <- gc_old :: change_info.removed; + (change_info, final_matches) + +let iname cg = List.mem (name_of_global_col cg) ["main"; "foo"; "bar"] +let inamev v = List.mem v.vname ["main"; "foo"; "bar"] let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) = let extract_fundecs _ gc map = match gc.def with @@ -51,17 +61,30 @@ let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_co | _ -> map in let var_fun_old = GlobalMap.fold extract_fundecs oldMap VarinfoMap.empty in let var_fun_new = GlobalMap.fold extract_fundecs newMap VarinfoMap.empty in - let empty_rename_assumptions m = VarinfoMap.for_all (fun vo vn -> vo.vname = vn.vname) m in (* TODO or in final_matches? *) + let extract_globs _ gc map = + let v = get_varinfo gc in + VarinfoMap.add v gc map in + let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in + let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in + let empty_rename_assms m = VarinfoMap.for_all (fun vo vn -> vo.vname = vn.vname) m in (* TODO or in final_matches? *) let compare_fundec_exact_match f1 f2 change_info final_matches = - let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in - match doMatch with - | Unchanged when empty_rename_assumptions function_dependencies && empty_rename_assumptions global_var_dependencies -> - performRenames renamesOnSuccess; - let change_info = {change_info with unchanged = change_info.unchanged} in - let final_matches = VarinfoMap.add f1.svar f2.svar final_matches in - true, change_info, final_matches - | _ -> false, change_info, final_matches + (* check that names of match are each only contained in new or old file *) + if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then ( + false, change_info, final_matches + ) else + let doMatch, diff, fun_deps, global_deps, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in + match doMatch with + | Unchanged when empty_rename_assms (VarinfoMap.filter (fun vo vn -> not (vo.vname = f1.svar.vname && vn.vname = f2.svar.vname)) fun_deps) && empty_rename_assms global_deps -> + performRenames renamesOnSuccess; + change_info.unchanged <- {old = VarinfoMap.find f1.svar var_glob_old; current = VarinfoMap.find f2.svar var_glob_new} :: change_info.unchanged; + let final_matches = addToFinalMatchesMapping f1.svar f2.svar final_matches in + true, change_info, final_matches + | Unchanged -> false, change_info, final_matches + | Changed -> false, change_info, final_matches + | ChangedFunHeader _ -> false, change_info, final_matches + | ForceReanalyze _ -> false, change_info, final_matches + in let matchGlobal ~matchVars ~matchFuns name gc_old (change_info, final_matches) = @@ -71,21 +94,19 @@ let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_co let compare_same_name_fundec_check_contained_renames f1 f2 = let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) - (* TODO recursively check dependencies, check in rename mapping for globals that were already compared *) let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> - match VarinfoMap.find_opt f_old_var final_matches with + match VarinfoMap.find_opt f_old_var (fst final_matches) with | None -> let f_old = VarinfoMap.find f_old_var var_fun_old in let f_new = VarinfoMap.find f_new_var var_fun_new in (* TODO: what happens if there exists no fundec for this varinfo? *) - (* check that names of match are each only contained in new or old file *) if acc then compare_fundec_exact_match f_old f_new ci fm else false, ci, fm | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> - match VarinfoMap.find_opt old_var final_matches with + match VarinfoMap.find_opt old_var (fst final_matches) with | None -> - if acc && preservesSameNameMatches old_var.vname oldMap new_var.vname newMap then + if acc then compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm else false, ci, fm | Some v -> v = new_var, ci, fm @@ -101,10 +122,11 @@ let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_co | Unchanged -> (* no diff is stored, also when comparing functions based on CFG because currently there is no mechanism to detect which part was affected by the *) append_to_changed ~unchangedHeader:true ~diff:None + | Changed -> append_to_changed ~unchangedHeader:true ~diff:diff | _ -> (* this can only be ForceReanalyze or ChangedFunHeader *) change_info.exclude_from_rel_destab <- VarinfoSet.add f1.svar change_info.exclude_from_rel_destab; append_to_changed ~unchangedHeader:false ~diff:None); - VarinfoMap.add f1.svar f2.svar final_matches in + addToFinalMatchesMapping f1.svar f2.svar final_matches in match gc_old.def, gc_new.def with | Some (Var v1), Some (Var v2) when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm @@ -113,9 +135,10 @@ let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_co | Some v1, Some v2 when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm | _ -> change_info, final_matches) | _ -> change_info, final_matches - with Not_found -> let extendedRemoved = gc_old :: change_info.removed in {change_info with removed = extendedRemoved}, final_matches in + with Not_found -> change_info, final_matches in - (empty_change_info (), VarinfoMap.empty) (* change_info and final_matches is propagated *) + (empty_change_info (), (VarinfoMap.empty, VarinfoMap.empty)) (* change_info and final_matches (bi-directional) is propagated *) |> GlobalMap.fold (matchGlobal ~matchVars:true ~matchFuns:false) oldMap |> GlobalMap.fold (matchGlobal ~matchVars:false ~matchFuns:true) oldMap |> GlobalMap.fold addNewGlobals newMap + |> GlobalMap.fold addOldGlobals oldMap From f7363667b3f165939ba7fbfda8ab690302814faa Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 09:58:30 +0100 Subject: [PATCH 094/518] add cram tests for rename detection --- .../04-var-rename/02-rename_and_shuffle.t | 19 +++++++++++++++++++ .../04-var-rename/03-rename_with_usage.t | 19 +++++++++++++++++++ .../04-var-rename/05-renamed_param.t | 19 +++++++++++++++++++ .../06-renamed_param_usage_changed.t | 19 +++++++++++++++++++ .../06-renamed_param_usage_changed.txt | 2 -- tests/incremental/04-var-rename/dune | 2 ++ .../05-method-rename/00-simple_rename.t | 19 +++++++++++++++++++ .../05-method-rename/01-dependent_rename.t | 19 +++++++++++++++++++ .../03-cyclic_rename_dependency.t | 19 +++++++++++++++++++ .../05-method-rename/04-cyclic_with_swap.t | 19 +++++++++++++++++++ .../05-method-rename/05-deep_change.t | 19 +++++++++++++++++++ .../05-method-rename/06-common_rename.t | 19 +++++++++++++++++++ .../05-method-rename/08-recursive_rename.t | 19 +++++++++++++++++++ tests/incremental/05-method-rename/dune | 2 ++ .../06-glob-var-rename/00-simple_rename.t | 19 +++++++++++++++++++ .../01-duplicate_local_global.t | 19 +++++++++++++++++++ .../06-glob-var-rename/02-add_new_gvar.t | 19 +++++++++++++++++++ tests/incremental/06-glob-var-rename/dune | 2 ++ tests/incremental/dune | 3 +++ 19 files changed, 275 insertions(+), 2 deletions(-) create mode 100644 tests/incremental/04-var-rename/02-rename_and_shuffle.t create mode 100644 tests/incremental/04-var-rename/03-rename_with_usage.t create mode 100644 tests/incremental/04-var-rename/05-renamed_param.t create mode 100644 tests/incremental/04-var-rename/06-renamed_param_usage_changed.t delete mode 100644 tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt create mode 100644 tests/incremental/04-var-rename/dune create mode 100644 tests/incremental/05-method-rename/00-simple_rename.t create mode 100644 tests/incremental/05-method-rename/01-dependent_rename.t create mode 100644 tests/incremental/05-method-rename/03-cyclic_rename_dependency.t create mode 100644 tests/incremental/05-method-rename/04-cyclic_with_swap.t create mode 100644 tests/incremental/05-method-rename/05-deep_change.t create mode 100644 tests/incremental/05-method-rename/06-common_rename.t create mode 100644 tests/incremental/05-method-rename/08-recursive_rename.t create mode 100644 tests/incremental/05-method-rename/dune create mode 100644 tests/incremental/06-glob-var-rename/00-simple_rename.t create mode 100644 tests/incremental/06-glob-var-rename/01-duplicate_local_global.t create mode 100644 tests/incremental/06-glob-var-rename/02-add_new_gvar.t create mode 100644 tests/incremental/06-glob-var-rename/dune create mode 100644 tests/incremental/dune diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.t b/tests/incremental/04-var-rename/02-rename_and_shuffle.t new file mode 100644 index 0000000000..10ff00e5a6 --- /dev/null +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 02-rename_and_shuffle.json --enable incremental.save 02-rename_and_shuffle.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 02-rename_and_shuffle.c + $ patch -b <02-rename_and_shuffle.patch + patching file 02-rename_and_shuffle.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 02-rename_and_shuffle.json --enable incremental.load 02-rename_and_shuffle.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <02-rename_and_shuffle.patch + patching file 02-rename_and_shuffle.c diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.t b/tests/incremental/04-var-rename/03-rename_with_usage.t new file mode 100644 index 0000000000..32d9a95c6d --- /dev/null +++ b/tests/incremental/04-var-rename/03-rename_with_usage.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 03-rename_with_usage.json --enable incremental.save 03-rename_with_usage.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 03-rename_with_usage.c + $ patch -b <03-rename_with_usage.patch + patching file 03-rename_with_usage.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 03-rename_with_usage.json --enable incremental.load 03-rename_with_usage.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <03-rename_with_usage.patch + patching file 03-rename_with_usage.c diff --git a/tests/incremental/04-var-rename/05-renamed_param.t b/tests/incremental/04-var-rename/05-renamed_param.t new file mode 100644 index 0000000000..2401c1bd25 --- /dev/null +++ b/tests/incremental/04-var-rename/05-renamed_param.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 05-renamed_param.json --enable incremental.save 05-renamed_param.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 05-renamed_param.c + $ patch -b <05-renamed_param.patch + patching file 05-renamed_param.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 05-renamed_param.json --enable incremental.load 05-renamed_param.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <05-renamed_param.patch + patching file 05-renamed_param.c diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.t b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.t new file mode 100644 index 0000000000..ddc1b904aa --- /dev/null +++ b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 06-renamed_param_usage_changed.json --enable incremental.save 06-renamed_param_usage_changed.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 06-renamed_param_usage_changed.c + $ patch -b <06-renamed_param_usage_changed.patch + patching file 06-renamed_param_usage_changed.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 06-renamed_param_usage_changed.json --enable incremental.load 06-renamed_param_usage_changed.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <06-renamed_param_usage_changed.patch + patching file 06-renamed_param_usage_changed.c diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt deleted file mode 100644 index 0dc90594c7..0000000000 --- a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.txt +++ /dev/null @@ -1,2 +0,0 @@ -function parameters a and b and swapped in the function header. But the function body stays the same. -Semantic changes. diff --git a/tests/incremental/04-var-rename/dune b/tests/incremental/04-var-rename/dune new file mode 100644 index 0000000000..1b37756f98 --- /dev/null +++ b/tests/incremental/04-var-rename/dune @@ -0,0 +1,2 @@ +(cram + (deps (glob_files *.{c,json,patch}) (sandbox preserve_file_kind))) diff --git a/tests/incremental/05-method-rename/00-simple_rename.t b/tests/incremental/05-method-rename/00-simple_rename.t new file mode 100644 index 0000000000..59a1cfa469 --- /dev/null +++ b/tests/incremental/05-method-rename/00-simple_rename.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 00-simple_rename.json --enable incremental.save 00-simple_rename.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 00-simple_rename.c + $ patch -b <00-simple_rename.patch + patching file 00-simple_rename.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 00-simple_rename.json --enable incremental.load 00-simple_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <00-simple_rename.patch + patching file 00-simple_rename.c diff --git a/tests/incremental/05-method-rename/01-dependent_rename.t b/tests/incremental/05-method-rename/01-dependent_rename.t new file mode 100644 index 0000000000..75c5797c2a --- /dev/null +++ b/tests/incremental/05-method-rename/01-dependent_rename.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 01-dependent_rename.json --enable incremental.save 01-dependent_rename.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 01-dependent_rename.c + $ patch -b <01-dependent_rename.patch + patching file 01-dependent_rename.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 01-dependent_rename.json --enable incremental.load 01-dependent_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 2; removed = 2 + +Revert patch + + $ patch -b -R <01-dependent_rename.patch + patching file 01-dependent_rename.c diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.t b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.t new file mode 100644 index 0000000000..5a90ebdbe3 --- /dev/null +++ b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 03-cyclic_rename_dependency.json --enable incremental.save 03-cyclic_rename_dependency.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 03-cyclic_rename_dependency.c + $ patch -b <03-cyclic_rename_dependency.patch + patching file 03-cyclic_rename_dependency.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 03-cyclic_rename_dependency.json --enable incremental.load 03-cyclic_rename_dependency.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 2; removed = 2 + +Revert patch + + $ patch -b -R <03-cyclic_rename_dependency.patch + patching file 03-cyclic_rename_dependency.c diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.t b/tests/incremental/05-method-rename/04-cyclic_with_swap.t new file mode 100644 index 0000000000..b0a269f646 --- /dev/null +++ b/tests/incremental/05-method-rename/04-cyclic_with_swap.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 04-cyclic_with_swap.json --enable incremental.save 04-cyclic_with_swap.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 04-cyclic_with_swap.c + $ patch -b <04-cyclic_with_swap.patch + patching file 04-cyclic_with_swap.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 04-cyclic_with_swap.json --enable incremental.load 04-cyclic_with_swap.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 3; removed = 2 + +Revert patch + + $ patch -b -R <04-cyclic_with_swap.patch + patching file 04-cyclic_with_swap.c diff --git a/tests/incremental/05-method-rename/05-deep_change.t b/tests/incremental/05-method-rename/05-deep_change.t new file mode 100644 index 0000000000..60aeb46e2a --- /dev/null +++ b/tests/incremental/05-method-rename/05-deep_change.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 05-deep_change.json --enable incremental.save 05-deep_change.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 05-deep_change.c + $ patch -b <05-deep_change.patch + patching file 05-deep_change.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 05-deep_change.json --enable incremental.load 05-deep_change.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <05-deep_change.patch + patching file 05-deep_change.c diff --git a/tests/incremental/05-method-rename/06-common_rename.t b/tests/incremental/05-method-rename/06-common_rename.t new file mode 100644 index 0000000000..4ba4bc2750 --- /dev/null +++ b/tests/incremental/05-method-rename/06-common_rename.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 06-common_rename.json --enable incremental.save 06-common_rename.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 06-common_rename.c + $ patch -b <06-common_rename.patch + patching file 06-common_rename.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 06-common_rename.json --enable incremental.load 06-common_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <06-common_rename.patch + patching file 06-common_rename.c diff --git a/tests/incremental/05-method-rename/08-recursive_rename.t b/tests/incremental/05-method-rename/08-recursive_rename.t new file mode 100644 index 0000000000..5036b1da4b --- /dev/null +++ b/tests/incremental/05-method-rename/08-recursive_rename.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 08-recursive_rename.json --enable incremental.save 08-recursive_rename.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 08-recursive_rename.c + $ patch -b <08-recursive_rename.patch + patching file 08-recursive_rename.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 08-recursive_rename.json --enable incremental.load 08-recursive_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <08-recursive_rename.patch + patching file 08-recursive_rename.c diff --git a/tests/incremental/05-method-rename/dune b/tests/incremental/05-method-rename/dune new file mode 100644 index 0000000000..1b37756f98 --- /dev/null +++ b/tests/incremental/05-method-rename/dune @@ -0,0 +1,2 @@ +(cram + (deps (glob_files *.{c,json,patch}) (sandbox preserve_file_kind))) diff --git a/tests/incremental/06-glob-var-rename/00-simple_rename.t b/tests/incremental/06-glob-var-rename/00-simple_rename.t new file mode 100644 index 0000000000..59a1cfa469 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/00-simple_rename.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 00-simple_rename.json --enable incremental.save 00-simple_rename.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 00-simple_rename.c + $ patch -b <00-simple_rename.patch + patching file 00-simple_rename.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 00-simple_rename.json --enable incremental.load 00-simple_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <00-simple_rename.patch + patching file 00-simple_rename.c diff --git a/tests/incremental/06-glob-var-rename/01-duplicate_local_global.t b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.t new file mode 100644 index 0000000000..b1b73f4f26 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 01-duplicate_local_global.json --enable incremental.save 01-duplicate_local_global.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 01-duplicate_local_global.c + $ patch -b <01-duplicate_local_global.patch + patching file 01-duplicate_local_global.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 01-duplicate_local_global.json --enable incremental.load 01-duplicate_local_global.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <01-duplicate_local_global.patch + patching file 01-duplicate_local_global.c diff --git a/tests/incremental/06-glob-var-rename/02-add_new_gvar.t b/tests/incremental/06-glob-var-rename/02-add_new_gvar.t new file mode 100644 index 0000000000..8450df2d47 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/02-add_new_gvar.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 02-add_new_gvar.json --enable incremental.save 02-add_new_gvar.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 02-add_new_gvar.c + $ patch -b <02-add_new_gvar.patch + patching file 02-add_new_gvar.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 02-add_new_gvar.json --enable incremental.load 02-add_new_gvar.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 1; removed = 0 + +Revert patch + + $ patch -b -R <02-add_new_gvar.patch + patching file 02-add_new_gvar.c diff --git a/tests/incremental/06-glob-var-rename/dune b/tests/incremental/06-glob-var-rename/dune new file mode 100644 index 0000000000..1b37756f98 --- /dev/null +++ b/tests/incremental/06-glob-var-rename/dune @@ -0,0 +1,2 @@ +(cram + (deps (glob_files *.{c,json,patch}) (sandbox preserve_file_kind))) diff --git a/tests/incremental/dune b/tests/incremental/dune new file mode 100644 index 0000000000..fdb1d941c2 --- /dev/null +++ b/tests/incremental/dune @@ -0,0 +1,3 @@ +(cram + (applies_to :whole_subtree) + (deps %{bin:goblint} (package goblint))) ; need entire package for includes/ From 5e1963f75f59010e61b077bec7e1756ff4b5d0e0 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 10:06:29 +0100 Subject: [PATCH 095/518] remove superflous tests and those without clear expected result --- .../04-var-rename/01-unused_rename.c | 4 --- .../04-var-rename/01-unused_rename.json | 3 -- .../04-var-rename/01-unused_rename.patch | 8 ----- .../04-var-rename/01-unused_rename.txt | 3 -- .../04-var-rename/02-rename_and_shuffle.c | 2 +- .../04-var-rename/02-rename_and_shuffle.txt | 2 -- .../04-var-rename/03-rename_with_usage.txt | 2 -- .../04-var-rename/04-renamed_assert.c | 3 +- .../04-var-rename/04-renamed_assert.txt | 2 -- .../04-var-rename/05-renamed_param.c | 3 +- .../04-var-rename/05-renamed_param.txt | 2 -- .../05-method-rename/02-rename_and_swap.c | 19 ------------ .../05-method-rename/02-rename_and_swap.json | 3 -- .../05-method-rename/02-rename_and_swap.patch | 25 --------------- .../03-cyclic_rename_dependency.c | 2 -- .../05-method-rename/04-cyclic_with_swap.c | 2 -- .../07-common_rename_refactored.c | 20 ------------ .../07-common_rename_refactored.json | 3 -- .../07-common_rename_refactored.patch | 31 ------------------- 19 files changed, 5 insertions(+), 134 deletions(-) delete mode 100644 tests/incremental/04-var-rename/01-unused_rename.c delete mode 100644 tests/incremental/04-var-rename/01-unused_rename.json delete mode 100644 tests/incremental/04-var-rename/01-unused_rename.patch delete mode 100644 tests/incremental/04-var-rename/01-unused_rename.txt delete mode 100644 tests/incremental/04-var-rename/02-rename_and_shuffle.txt delete mode 100644 tests/incremental/04-var-rename/03-rename_with_usage.txt delete mode 100644 tests/incremental/04-var-rename/04-renamed_assert.txt delete mode 100644 tests/incremental/04-var-rename/05-renamed_param.txt delete mode 100644 tests/incremental/05-method-rename/02-rename_and_swap.c delete mode 100644 tests/incremental/05-method-rename/02-rename_and_swap.json delete mode 100644 tests/incremental/05-method-rename/02-rename_and_swap.patch delete mode 100644 tests/incremental/05-method-rename/07-common_rename_refactored.c delete mode 100644 tests/incremental/05-method-rename/07-common_rename_refactored.json delete mode 100644 tests/incremental/05-method-rename/07-common_rename_refactored.patch diff --git a/tests/incremental/04-var-rename/01-unused_rename.c b/tests/incremental/04-var-rename/01-unused_rename.c deleted file mode 100644 index 31eacd5bf9..0000000000 --- a/tests/incremental/04-var-rename/01-unused_rename.c +++ /dev/null @@ -1,4 +0,0 @@ -int main() { - int a = 0; - return 0; -} diff --git a/tests/incremental/04-var-rename/01-unused_rename.json b/tests/incremental/04-var-rename/01-unused_rename.json deleted file mode 100644 index 544b7b4ddd..0000000000 --- a/tests/incremental/04-var-rename/01-unused_rename.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - -} \ No newline at end of file diff --git a/tests/incremental/04-var-rename/01-unused_rename.patch b/tests/incremental/04-var-rename/01-unused_rename.patch deleted file mode 100644 index 977470ad53..0000000000 --- a/tests/incremental/04-var-rename/01-unused_rename.patch +++ /dev/null @@ -1,8 +0,0 @@ ---- tests/incremental/04-var-rename/01-unused_rename.c -+++ tests/incremental/04-var-rename/01-unused_rename.c -@@ -1,4 +1,4 @@ - int main() { -- int a = 0; -+ int b = 0; - return 0; - } diff --git a/tests/incremental/04-var-rename/01-unused_rename.txt b/tests/incremental/04-var-rename/01-unused_rename.txt deleted file mode 100644 index a317916ad1..0000000000 --- a/tests/incremental/04-var-rename/01-unused_rename.txt +++ /dev/null @@ -1,3 +0,0 @@ -local variable a is renamed to b. -a/b is not used. -No semantic changes. diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.c b/tests/incremental/04-var-rename/02-rename_and_shuffle.c index 9917738055..d851dcea95 100644 --- a/tests/incremental/04-var-rename/02-rename_and_shuffle.c +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.c @@ -1,6 +1,6 @@ #include -//a is renamed to c, but the usage of a is replaced by b +//a is renamed to c, but the usage of a is replaced by b (semantic changes) int main() { int a = 0; int b = 1; diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.txt b/tests/incremental/04-var-rename/02-rename_and_shuffle.txt deleted file mode 100644 index 8c0ab5ac05..0000000000 --- a/tests/incremental/04-var-rename/02-rename_and_shuffle.txt +++ /dev/null @@ -1,2 +0,0 @@ -a is renamed to c, but the usage of a is replaced by b. -Semantic changes. diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.txt b/tests/incremental/04-var-rename/03-rename_with_usage.txt deleted file mode 100644 index 18ff7e94d4..0000000000 --- a/tests/incremental/04-var-rename/03-rename_with_usage.txt +++ /dev/null @@ -1,2 +0,0 @@ -a is renamed to c, but the usage stays the same. -No semantic changes. diff --git a/tests/incremental/04-var-rename/04-renamed_assert.c b/tests/incremental/04-var-rename/04-renamed_assert.c index 665e44251c..b9f484ba01 100644 --- a/tests/incremental/04-var-rename/04-renamed_assert.c +++ b/tests/incremental/04-var-rename/04-renamed_assert.c @@ -1,9 +1,10 @@ #include +// local var used in assert is renamed (no semantic changes) int main() { int myVar = 0; __goblint_check(myVar < 11); return 0; -} \ No newline at end of file +} diff --git a/tests/incremental/04-var-rename/04-renamed_assert.txt b/tests/incremental/04-var-rename/04-renamed_assert.txt deleted file mode 100644 index 1afc289347..0000000000 --- a/tests/incremental/04-var-rename/04-renamed_assert.txt +++ /dev/null @@ -1,2 +0,0 @@ -local var used in assert is renamed. -No semantic changes. diff --git a/tests/incremental/04-var-rename/05-renamed_param.c b/tests/incremental/04-var-rename/05-renamed_param.c index 72fdfaf0e9..770af2683c 100644 --- a/tests/incremental/04-var-rename/05-renamed_param.c +++ b/tests/incremental/04-var-rename/05-renamed_param.c @@ -1,3 +1,4 @@ +// function param is renamed (no semantic changes) void method(int a) { int c = a; } @@ -5,4 +6,4 @@ void method(int a) { int main() { method(0); return 0; -} \ No newline at end of file +} diff --git a/tests/incremental/04-var-rename/05-renamed_param.txt b/tests/incremental/04-var-rename/05-renamed_param.txt deleted file mode 100644 index 09bca47979..0000000000 --- a/tests/incremental/04-var-rename/05-renamed_param.txt +++ /dev/null @@ -1,2 +0,0 @@ -Function param is renamed. -No semantic changes. diff --git a/tests/incremental/05-method-rename/02-rename_and_swap.c b/tests/incremental/05-method-rename/02-rename_and_swap.c deleted file mode 100644 index f62edd44a4..0000000000 --- a/tests/incremental/05-method-rename/02-rename_and_swap.c +++ /dev/null @@ -1,19 +0,0 @@ -#include - -void foo1() { - printf("foo1"); -} - -void foo2() { - foo1(); -} - -void foo3() { - foo1(); -} - -int main() { - foo2(); - foo3(); - return 0; -} diff --git a/tests/incremental/05-method-rename/02-rename_and_swap.json b/tests/incremental/05-method-rename/02-rename_and_swap.json deleted file mode 100644 index 0db3279e44..0000000000 --- a/tests/incremental/05-method-rename/02-rename_and_swap.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - -} diff --git a/tests/incremental/05-method-rename/02-rename_and_swap.patch b/tests/incremental/05-method-rename/02-rename_and_swap.patch deleted file mode 100644 index ab39c2dc4b..0000000000 --- a/tests/incremental/05-method-rename/02-rename_and_swap.patch +++ /dev/null @@ -1,25 +0,0 @@ ---- tests/incremental/05-method-rename/02-rename_and_swap.c -+++ tests/incremental/05-method-rename/02-rename_and_swap.c -@@ -1,15 +1,19 @@ - #include - --void foo1() { -+void newFun() { -+ printf("newFun"); -+} -+ -+void bar1() { - printf("foo1"); - } - - void foo2() { -- foo1(); -+ bar1(); - } - - void foo3() { -- foo1(); -+ newFun(); - } - - int main() { diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.c b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.c index 2509cfbcd5..331a5e25cb 100644 --- a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.c +++ b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.c @@ -1,7 +1,5 @@ #include -//Unchanged. - void foo1(int c) { if (c < 10) foo2(c + 1); } diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.c b/tests/incremental/05-method-rename/04-cyclic_with_swap.c index 74123d5a14..34026afa92 100644 --- a/tests/incremental/05-method-rename/04-cyclic_with_swap.c +++ b/tests/incremental/05-method-rename/04-cyclic_with_swap.c @@ -1,7 +1,5 @@ #include -//Changed. - void foo1(int c) { if (c < 10) foo2(c + 1); } diff --git a/tests/incremental/05-method-rename/07-common_rename_refactored.c b/tests/incremental/05-method-rename/07-common_rename_refactored.c deleted file mode 100644 index ce72a6dda1..0000000000 --- a/tests/incremental/05-method-rename/07-common_rename_refactored.c +++ /dev/null @@ -1,20 +0,0 @@ -#include - -void foo() { - printf("foo"); -} - -void fun1() { - foo(); -} - -void fun2() { - foo(); -} - -int main() { - fun1(); - fun2(); - foo(); - return 0; -} diff --git a/tests/incremental/05-method-rename/07-common_rename_refactored.json b/tests/incremental/05-method-rename/07-common_rename_refactored.json deleted file mode 100644 index 0db3279e44..0000000000 --- a/tests/incremental/05-method-rename/07-common_rename_refactored.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - -} diff --git a/tests/incremental/05-method-rename/07-common_rename_refactored.patch b/tests/incremental/05-method-rename/07-common_rename_refactored.patch deleted file mode 100644 index 4c3d9fa1d6..0000000000 --- a/tests/incremental/05-method-rename/07-common_rename_refactored.patch +++ /dev/null @@ -1,31 +0,0 @@ ---- tests/incremental/05-method-rename/07-common_rename_refactored.c -+++ tests/incremental/05-method-rename/07-common_rename_refactored.c -@@ -1,20 +1,24 @@ - #include - --void foo() { -+void bar() { - printf("foo"); - } - -+void baz() { -+ printf("baz"); -+} -+ - void fun1() { -- foo(); -+ bar(); - } - - void fun2() { -- foo(); -+ bar(); - } - - int main() { - fun1(); - fun2(); -- foo(); -+ baz(); - return 0; - } From b90d0bcedd7a4bf319a124a3591785555e19db9a Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 10:19:04 +0100 Subject: [PATCH 096/518] fix patches --- tests/incremental/04-var-rename/02-rename_and_shuffle.c | 2 +- .../incremental/04-var-rename/02-rename_and_shuffle.patch | 8 ++++---- .../incremental/04-var-rename/03-rename_with_usage.patch | 6 +++--- tests/incremental/04-var-rename/05-renamed_param.patch | 4 ++-- .../05-method-rename/03-cyclic_rename_dependency.patch | 4 +--- .../05-method-rename/04-cyclic_with_swap.patch | 4 +--- 6 files changed, 12 insertions(+), 16 deletions(-) diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.c b/tests/incremental/04-var-rename/02-rename_and_shuffle.c index d851dcea95..7d6ea81e6f 100644 --- a/tests/incremental/04-var-rename/02-rename_and_shuffle.c +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.c @@ -1,6 +1,6 @@ #include -//a is renamed to c, but the usage of a is replaced by b (semantic changes) +// a is renamed to c, but the usage of a is replaced by b (semantic changes) int main() { int a = 0; int b = 1; diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.patch b/tests/incremental/04-var-rename/02-rename_and_shuffle.patch index 5c1dc4785e..365696734c 100644 --- a/tests/incremental/04-var-rename/02-rename_and_shuffle.patch +++ b/tests/incremental/04-var-rename/02-rename_and_shuffle.patch @@ -1,15 +1,15 @@ --- tests/incremental/04-var-rename/02-rename_and_shuffle.c +++ tests/incremental/04-var-rename/02-rename_and_shuffle.c @@ -2,10 +2,10 @@ - - //a is renamed to c, but the usage of a is replaced by b + + // a is renamed to c, but the usage of a is replaced by b (semantic changes) int main() { - int a = 0; + int c = 0; int b = 1; - + - printf("Print %d", a); + printf("Print %d", b); - + return 0; } diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.patch b/tests/incremental/04-var-rename/03-rename_with_usage.patch index 26fb98b340..8421a5a920 100644 --- a/tests/incremental/04-var-rename/03-rename_with_usage.patch +++ b/tests/incremental/04-var-rename/03-rename_with_usage.patch @@ -1,15 +1,15 @@ --- tests/incremental/04-var-rename/03-rename_with_usage.c +++ tests/incremental/04-var-rename/03-rename_with_usage.c @@ -2,10 +2,10 @@ - + //a is renamed to c, but its usages stay the same int main() { - int a = 0; + int c = 0; int b = 1; - + - printf("Print %d", a); + printf("Print %d", c); - + return 0; } diff --git a/tests/incremental/04-var-rename/05-renamed_param.patch b/tests/incremental/04-var-rename/05-renamed_param.patch index 944566b05c..8e9963d689 100644 --- a/tests/incremental/04-var-rename/05-renamed_param.patch +++ b/tests/incremental/04-var-rename/05-renamed_param.patch @@ -1,10 +1,10 @@ --- tests/incremental/04-var-rename/05-renamed_param.c +++ tests/incremental/04-var-rename/05-renamed_param.c -@@ -1,5 +1,5 @@ +@@ -2,5 +2,5 @@ -void method(int a) { - int c = a; +void method(int b) { + int c = b; } - + int main() { diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch index ae32544efd..936843dfad 100644 --- a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch +++ b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch @@ -1,8 +1,6 @@ --- tests/incremental/05-method-rename/03-cyclic_rename_dependency.c +++ tests/incremental/05-method-rename/03-cyclic_rename_dependency.c -@@ -2,16 +2,16 @@ - - //Unchanged. +@@ -2,14 +2,14 @@ -void foo1(int c) { - if (c < 10) foo2(c + 1); diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.patch b/tests/incremental/05-method-rename/04-cyclic_with_swap.patch index 7e96afd8e0..534faecae4 100644 --- a/tests/incremental/05-method-rename/04-cyclic_with_swap.patch +++ b/tests/incremental/05-method-rename/04-cyclic_with_swap.patch @@ -1,8 +1,6 @@ --- tests/incremental/05-method-rename/04-cyclic_with_swap.c +++ tests/incremental/05-method-rename/04-cyclic_with_swap.c -@@ -2,15 +2,19 @@ - - //Changed. +@@ -2,13 +2,17 @@ -void foo1(int c) { - if (c < 10) foo2(c + 1); From 7c365ba988c19447f4652380f2f30d68dcb73afa Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 10:30:18 +0100 Subject: [PATCH 097/518] re-establish consecutive test ids --- ..._and_shuffle.c => 01-rename_and_shuffle.c} | 0 ...huffle.json => 01-rename_and_shuffle.json} | 0 ...ffle.patch => 01-rename_and_shuffle.patch} | 4 ++-- .../04-var-rename/01-rename_and_shuffle.t | 19 +++++++++++++++++++ .../04-var-rename/02-rename_and_shuffle.t | 19 ------------------- ...me_with_usage.c => 02-rename_with_usage.c} | 0 ...h_usage.json => 02-rename_with_usage.json} | 0 ...usage.patch => 02-rename_with_usage.patch} | 4 ++-- .../04-var-rename/02-rename_with_usage.t | 19 +++++++++++++++++++ .../04-var-rename/03-rename_with_usage.t | 19 ------------------- ...4-renamed_assert.c => 03-renamed_assert.c} | 0 ...med_assert.json => 03-renamed_assert.json} | 0 ...d_assert.patch => 03-renamed_assert.patch} | 4 ++-- ...{05-renamed_param.c => 04-renamed_param.c} | 0 ...named_param.json => 04-renamed_param.json} | 0 ...med_param.patch => 04-renamed_param.patch} | 4 ++-- .../04-var-rename/04-renamed_param.t | 19 +++++++++++++++++++ .../04-var-rename/05-renamed_param.t | 19 ------------------- ...ged.c => 05-renamed_param_usage_changed.c} | 0 ...on => 05-renamed_param_usage_changed.json} | 0 ...h => 05-renamed_param_usage_changed.patch} | 6 +++--- .../05-renamed_param_usage_changed.t | 19 +++++++++++++++++++ .../06-renamed_param_usage_changed.t | 19 ------------------- ...ndency.c => 02-cyclic_rename_dependency.c} | 0 ....json => 02-cyclic_rename_dependency.json} | 0 ...atch => 02-cyclic_rename_dependency.patch} | 4 ++-- .../02-cyclic_rename_dependency.t | 19 +++++++++++++++++++ .../03-cyclic_rename_dependency.t | 19 ------------------- ...clic_with_swap.c => 03-cyclic_with_swap.c} | 0 ...ith_swap.json => 03-cyclic_with_swap.json} | 0 ...h_swap.patch => 03-cyclic_with_swap.patch} | 4 ++-- .../05-method-rename/03-cyclic_with_swap.t | 19 +++++++++++++++++++ .../05-method-rename/04-cyclic_with_swap.t | 19 ------------------- .../{05-deep_change.c => 04-deep_change.c} | 0 ...5-deep_change.json => 04-deep_change.json} | 0 .../05-method-rename/04-deep_change.patch | 11 +++++++++++ .../05-method-rename/04-deep_change.t | 19 +++++++++++++++++++ ...{06-common_rename.c => 05-common_rename.c} | 0 ...mmon_rename.json => 05-common_rename.json} | 0 ...on_rename.patch => 05-common_rename.patch} | 4 ++-- .../05-method-rename/05-common_rename.t | 19 +++++++++++++++++++ .../05-method-rename/05-deep_change.patch | 11 ----------- .../05-method-rename/05-deep_change.t | 19 ------------------- .../05-method-rename/06-common_rename.t | 19 ------------------- ...cursive_rename.c => 06-recursive_rename.c} | 0 ...e_rename.json => 06-recursive_rename.json} | 0 ...rename.patch => 06-recursive_rename.patch} | 4 ++-- .../05-method-rename/06-recursive_rename.t | 19 +++++++++++++++++++ .../05-method-rename/08-recursive_rename.t | 19 ------------------- 49 files changed, 201 insertions(+), 201 deletions(-) rename tests/incremental/04-var-rename/{02-rename_and_shuffle.c => 01-rename_and_shuffle.c} (100%) rename tests/incremental/04-var-rename/{02-rename_and_shuffle.json => 01-rename_and_shuffle.json} (100%) rename tests/incremental/04-var-rename/{02-rename_and_shuffle.patch => 01-rename_and_shuffle.patch} (66%) create mode 100644 tests/incremental/04-var-rename/01-rename_and_shuffle.t delete mode 100644 tests/incremental/04-var-rename/02-rename_and_shuffle.t rename tests/incremental/04-var-rename/{03-rename_with_usage.c => 02-rename_with_usage.c} (100%) rename tests/incremental/04-var-rename/{03-rename_with_usage.json => 02-rename_with_usage.json} (100%) rename tests/incremental/04-var-rename/{03-rename_with_usage.patch => 02-rename_with_usage.patch} (63%) create mode 100644 tests/incremental/04-var-rename/02-rename_with_usage.t delete mode 100644 tests/incremental/04-var-rename/03-rename_with_usage.t rename tests/incremental/04-var-rename/{04-renamed_assert.c => 03-renamed_assert.c} (100%) rename tests/incremental/04-var-rename/{04-renamed_assert.json => 03-renamed_assert.json} (100%) rename tests/incremental/04-var-rename/{04-renamed_assert.patch => 03-renamed_assert.patch} (64%) rename tests/incremental/04-var-rename/{05-renamed_param.c => 04-renamed_param.c} (100%) rename tests/incremental/04-var-rename/{05-renamed_param.json => 04-renamed_param.json} (100%) rename tests/incremental/04-var-rename/{05-renamed_param.patch => 04-renamed_param.patch} (50%) create mode 100644 tests/incremental/04-var-rename/04-renamed_param.t delete mode 100644 tests/incremental/04-var-rename/05-renamed_param.t rename tests/incremental/04-var-rename/{06-renamed_param_usage_changed.c => 05-renamed_param_usage_changed.c} (100%) rename tests/incremental/04-var-rename/{06-renamed_param_usage_changed.json => 05-renamed_param_usage_changed.json} (100%) rename tests/incremental/04-var-rename/{06-renamed_param_usage_changed.patch => 05-renamed_param_usage_changed.patch} (55%) create mode 100644 tests/incremental/04-var-rename/05-renamed_param_usage_changed.t delete mode 100644 tests/incremental/04-var-rename/06-renamed_param_usage_changed.t rename tests/incremental/05-method-rename/{03-cyclic_rename_dependency.c => 02-cyclic_rename_dependency.c} (100%) rename tests/incremental/05-method-rename/{03-cyclic_rename_dependency.json => 02-cyclic_rename_dependency.json} (100%) rename tests/incremental/05-method-rename/{03-cyclic_rename_dependency.patch => 02-cyclic_rename_dependency.patch} (71%) create mode 100644 tests/incremental/05-method-rename/02-cyclic_rename_dependency.t delete mode 100644 tests/incremental/05-method-rename/03-cyclic_rename_dependency.t rename tests/incremental/05-method-rename/{04-cyclic_with_swap.c => 03-cyclic_with_swap.c} (100%) rename tests/incremental/05-method-rename/{04-cyclic_with_swap.json => 03-cyclic_with_swap.json} (100%) rename tests/incremental/05-method-rename/{04-cyclic_with_swap.patch => 03-cyclic_with_swap.patch} (73%) create mode 100644 tests/incremental/05-method-rename/03-cyclic_with_swap.t delete mode 100644 tests/incremental/05-method-rename/04-cyclic_with_swap.t rename tests/incremental/05-method-rename/{05-deep_change.c => 04-deep_change.c} (100%) rename tests/incremental/05-method-rename/{05-deep_change.json => 04-deep_change.json} (100%) create mode 100644 tests/incremental/05-method-rename/04-deep_change.patch create mode 100644 tests/incremental/05-method-rename/04-deep_change.t rename tests/incremental/05-method-rename/{06-common_rename.c => 05-common_rename.c} (100%) rename tests/incremental/05-method-rename/{06-common_rename.json => 05-common_rename.json} (100%) rename tests/incremental/05-method-rename/{06-common_rename.patch => 05-common_rename.patch} (68%) create mode 100644 tests/incremental/05-method-rename/05-common_rename.t delete mode 100644 tests/incremental/05-method-rename/05-deep_change.patch delete mode 100644 tests/incremental/05-method-rename/05-deep_change.t delete mode 100644 tests/incremental/05-method-rename/06-common_rename.t rename tests/incremental/05-method-rename/{08-recursive_rename.c => 06-recursive_rename.c} (100%) rename tests/incremental/05-method-rename/{08-recursive_rename.json => 06-recursive_rename.json} (100%) rename tests/incremental/05-method-rename/{08-recursive_rename.patch => 06-recursive_rename.patch} (56%) create mode 100644 tests/incremental/05-method-rename/06-recursive_rename.t delete mode 100644 tests/incremental/05-method-rename/08-recursive_rename.t diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.c b/tests/incremental/04-var-rename/01-rename_and_shuffle.c similarity index 100% rename from tests/incremental/04-var-rename/02-rename_and_shuffle.c rename to tests/incremental/04-var-rename/01-rename_and_shuffle.c diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.json b/tests/incremental/04-var-rename/01-rename_and_shuffle.json similarity index 100% rename from tests/incremental/04-var-rename/02-rename_and_shuffle.json rename to tests/incremental/04-var-rename/01-rename_and_shuffle.json diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.patch b/tests/incremental/04-var-rename/01-rename_and_shuffle.patch similarity index 66% rename from tests/incremental/04-var-rename/02-rename_and_shuffle.patch rename to tests/incremental/04-var-rename/01-rename_and_shuffle.patch index 365696734c..94e27d9a80 100644 --- a/tests/incremental/04-var-rename/02-rename_and_shuffle.patch +++ b/tests/incremental/04-var-rename/01-rename_and_shuffle.patch @@ -1,5 +1,5 @@ ---- tests/incremental/04-var-rename/02-rename_and_shuffle.c -+++ tests/incremental/04-var-rename/02-rename_and_shuffle.c +--- tests/incremental/04-var-rename/01-rename_and_shuffle.c ++++ tests/incremental/04-var-rename/01-rename_and_shuffle.c @@ -2,10 +2,10 @@ // a is renamed to c, but the usage of a is replaced by b (semantic changes) diff --git a/tests/incremental/04-var-rename/01-rename_and_shuffle.t b/tests/incremental/04-var-rename/01-rename_and_shuffle.t new file mode 100644 index 0000000000..5cfb03eb54 --- /dev/null +++ b/tests/incremental/04-var-rename/01-rename_and_shuffle.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 01-rename_and_shuffle.json --enable incremental.save 01-rename_and_shuffle.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 01-rename_and_shuffle.c + $ patch -b <01-rename_and_shuffle.patch + patching file 01-rename_and_shuffle.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 01-rename_and_shuffle.json --enable incremental.load 01-rename_and_shuffle.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <01-rename_and_shuffle.patch + patching file 01-rename_and_shuffle.c diff --git a/tests/incremental/04-var-rename/02-rename_and_shuffle.t b/tests/incremental/04-var-rename/02-rename_and_shuffle.t deleted file mode 100644 index 10ff00e5a6..0000000000 --- a/tests/incremental/04-var-rename/02-rename_and_shuffle.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 02-rename_and_shuffle.json --enable incremental.save 02-rename_and_shuffle.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 02-rename_and_shuffle.c - $ patch -b <02-rename_and_shuffle.patch - patching file 02-rename_and_shuffle.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 02-rename_and_shuffle.json --enable incremental.load 02-rename_and_shuffle.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <02-rename_and_shuffle.patch - patching file 02-rename_and_shuffle.c diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.c b/tests/incremental/04-var-rename/02-rename_with_usage.c similarity index 100% rename from tests/incremental/04-var-rename/03-rename_with_usage.c rename to tests/incremental/04-var-rename/02-rename_with_usage.c diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.json b/tests/incremental/04-var-rename/02-rename_with_usage.json similarity index 100% rename from tests/incremental/04-var-rename/03-rename_with_usage.json rename to tests/incremental/04-var-rename/02-rename_with_usage.json diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.patch b/tests/incremental/04-var-rename/02-rename_with_usage.patch similarity index 63% rename from tests/incremental/04-var-rename/03-rename_with_usage.patch rename to tests/incremental/04-var-rename/02-rename_with_usage.patch index 8421a5a920..6cfe41bbb1 100644 --- a/tests/incremental/04-var-rename/03-rename_with_usage.patch +++ b/tests/incremental/04-var-rename/02-rename_with_usage.patch @@ -1,5 +1,5 @@ ---- tests/incremental/04-var-rename/03-rename_with_usage.c -+++ tests/incremental/04-var-rename/03-rename_with_usage.c +--- tests/incremental/04-var-rename/02-rename_with_usage.c ++++ tests/incremental/04-var-rename/02-rename_with_usage.c @@ -2,10 +2,10 @@ //a is renamed to c, but its usages stay the same diff --git a/tests/incremental/04-var-rename/02-rename_with_usage.t b/tests/incremental/04-var-rename/02-rename_with_usage.t new file mode 100644 index 0000000000..2abea2988f --- /dev/null +++ b/tests/incremental/04-var-rename/02-rename_with_usage.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 02-rename_with_usage.json --enable incremental.save 02-rename_with_usage.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 02-rename_with_usage.c + $ patch -b <02-rename_with_usage.patch + patching file 02-rename_with_usage.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 02-rename_with_usage.json --enable incremental.load 02-rename_with_usage.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <02-rename_with_usage.patch + patching file 02-rename_with_usage.c diff --git a/tests/incremental/04-var-rename/03-rename_with_usage.t b/tests/incremental/04-var-rename/03-rename_with_usage.t deleted file mode 100644 index 32d9a95c6d..0000000000 --- a/tests/incremental/04-var-rename/03-rename_with_usage.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 03-rename_with_usage.json --enable incremental.save 03-rename_with_usage.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 03-rename_with_usage.c - $ patch -b <03-rename_with_usage.patch - patching file 03-rename_with_usage.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 03-rename_with_usage.json --enable incremental.load 03-rename_with_usage.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <03-rename_with_usage.patch - patching file 03-rename_with_usage.c diff --git a/tests/incremental/04-var-rename/04-renamed_assert.c b/tests/incremental/04-var-rename/03-renamed_assert.c similarity index 100% rename from tests/incremental/04-var-rename/04-renamed_assert.c rename to tests/incremental/04-var-rename/03-renamed_assert.c diff --git a/tests/incremental/04-var-rename/04-renamed_assert.json b/tests/incremental/04-var-rename/03-renamed_assert.json similarity index 100% rename from tests/incremental/04-var-rename/04-renamed_assert.json rename to tests/incremental/04-var-rename/03-renamed_assert.json diff --git a/tests/incremental/04-var-rename/04-renamed_assert.patch b/tests/incremental/04-var-rename/03-renamed_assert.patch similarity index 64% rename from tests/incremental/04-var-rename/04-renamed_assert.patch rename to tests/incremental/04-var-rename/03-renamed_assert.patch index d7dfe6ae8e..c672e68044 100644 --- a/tests/incremental/04-var-rename/04-renamed_assert.patch +++ b/tests/incremental/04-var-rename/03-renamed_assert.patch @@ -1,5 +1,5 @@ ---- tests/incremental/04-var-rename/04-renamed_assert.c -+++ tests/incremental/04-var-rename/04-renamed_assert.c +--- tests/incremental/04-var-rename/03-renamed_assert.c ++++ tests/incremental/04-var-rename/03-renamed_assert.c @@ -1,7 +1,7 @@ int main() { - int myVar = 0; diff --git a/tests/incremental/04-var-rename/05-renamed_param.c b/tests/incremental/04-var-rename/04-renamed_param.c similarity index 100% rename from tests/incremental/04-var-rename/05-renamed_param.c rename to tests/incremental/04-var-rename/04-renamed_param.c diff --git a/tests/incremental/04-var-rename/05-renamed_param.json b/tests/incremental/04-var-rename/04-renamed_param.json similarity index 100% rename from tests/incremental/04-var-rename/05-renamed_param.json rename to tests/incremental/04-var-rename/04-renamed_param.json diff --git a/tests/incremental/04-var-rename/05-renamed_param.patch b/tests/incremental/04-var-rename/04-renamed_param.patch similarity index 50% rename from tests/incremental/04-var-rename/05-renamed_param.patch rename to tests/incremental/04-var-rename/04-renamed_param.patch index 8e9963d689..50a9b69f6a 100644 --- a/tests/incremental/04-var-rename/05-renamed_param.patch +++ b/tests/incremental/04-var-rename/04-renamed_param.patch @@ -1,5 +1,5 @@ ---- tests/incremental/04-var-rename/05-renamed_param.c -+++ tests/incremental/04-var-rename/05-renamed_param.c +--- tests/incremental/04-var-rename/04-renamed_param.c ++++ tests/incremental/04-var-rename/04-renamed_param.c @@ -2,5 +2,5 @@ -void method(int a) { - int c = a; diff --git a/tests/incremental/04-var-rename/04-renamed_param.t b/tests/incremental/04-var-rename/04-renamed_param.t new file mode 100644 index 0000000000..ed13d38fd7 --- /dev/null +++ b/tests/incremental/04-var-rename/04-renamed_param.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 04-renamed_param.json --enable incremental.save 04-renamed_param.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 04-renamed_param.c + $ patch -b <04-renamed_param.patch + patching file 04-renamed_param.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 04-renamed_param.json --enable incremental.load 04-renamed_param.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <04-renamed_param.patch + patching file 04-renamed_param.c diff --git a/tests/incremental/04-var-rename/05-renamed_param.t b/tests/incremental/04-var-rename/05-renamed_param.t deleted file mode 100644 index 2401c1bd25..0000000000 --- a/tests/incremental/04-var-rename/05-renamed_param.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 05-renamed_param.json --enable incremental.save 05-renamed_param.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 05-renamed_param.c - $ patch -b <05-renamed_param.patch - patching file 05-renamed_param.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 05-renamed_param.json --enable incremental.load 05-renamed_param.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <05-renamed_param.patch - patching file 05-renamed_param.c diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.c b/tests/incremental/04-var-rename/05-renamed_param_usage_changed.c similarity index 100% rename from tests/incremental/04-var-rename/06-renamed_param_usage_changed.c rename to tests/incremental/04-var-rename/05-renamed_param_usage_changed.c diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.json b/tests/incremental/04-var-rename/05-renamed_param_usage_changed.json similarity index 100% rename from tests/incremental/04-var-rename/06-renamed_param_usage_changed.json rename to tests/incremental/04-var-rename/05-renamed_param_usage_changed.json diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.patch b/tests/incremental/04-var-rename/05-renamed_param_usage_changed.patch similarity index 55% rename from tests/incremental/04-var-rename/06-renamed_param_usage_changed.patch rename to tests/incremental/04-var-rename/05-renamed_param_usage_changed.patch index a93e45c4c5..9ffc2c1cea 100644 --- a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.patch +++ b/tests/incremental/04-var-rename/05-renamed_param_usage_changed.patch @@ -1,8 +1,8 @@ ---- tests/incremental/04-var-rename/06-renamed_param_usage_changed.c -+++ tests/incremental/04-var-rename/06-renamed_param_usage_changed.c +--- tests/incremental/04-var-rename/05-renamed_param_usage_changed.c ++++ tests/incremental/04-var-rename/05-renamed_param_usage_changed.c @@ -1,6 +1,6 @@ //This test should mark foo and main as changed - + -void foo(int a, int b) { +void foo(int b, int a) { int x = a; diff --git a/tests/incremental/04-var-rename/05-renamed_param_usage_changed.t b/tests/incremental/04-var-rename/05-renamed_param_usage_changed.t new file mode 100644 index 0000000000..7f23cd649f --- /dev/null +++ b/tests/incremental/04-var-rename/05-renamed_param_usage_changed.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 05-renamed_param_usage_changed.json --enable incremental.save 05-renamed_param_usage_changed.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 05-renamed_param_usage_changed.c + $ patch -b <05-renamed_param_usage_changed.patch + patching file 05-renamed_param_usage_changed.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 05-renamed_param_usage_changed.json --enable incremental.load 05-renamed_param_usage_changed.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <05-renamed_param_usage_changed.patch + patching file 05-renamed_param_usage_changed.c diff --git a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.t b/tests/incremental/04-var-rename/06-renamed_param_usage_changed.t deleted file mode 100644 index ddc1b904aa..0000000000 --- a/tests/incremental/04-var-rename/06-renamed_param_usage_changed.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 06-renamed_param_usage_changed.json --enable incremental.save 06-renamed_param_usage_changed.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 06-renamed_param_usage_changed.c - $ patch -b <06-renamed_param_usage_changed.patch - patching file 06-renamed_param_usage_changed.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 06-renamed_param_usage_changed.json --enable incremental.load 06-renamed_param_usage_changed.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <06-renamed_param_usage_changed.patch - patching file 06-renamed_param_usage_changed.c diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.c b/tests/incremental/05-method-rename/02-cyclic_rename_dependency.c similarity index 100% rename from tests/incremental/05-method-rename/03-cyclic_rename_dependency.c rename to tests/incremental/05-method-rename/02-cyclic_rename_dependency.c diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.json b/tests/incremental/05-method-rename/02-cyclic_rename_dependency.json similarity index 100% rename from tests/incremental/05-method-rename/03-cyclic_rename_dependency.json rename to tests/incremental/05-method-rename/02-cyclic_rename_dependency.json diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch b/tests/incremental/05-method-rename/02-cyclic_rename_dependency.patch similarity index 71% rename from tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch rename to tests/incremental/05-method-rename/02-cyclic_rename_dependency.patch index 936843dfad..7f15d88c3a 100644 --- a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.patch +++ b/tests/incremental/05-method-rename/02-cyclic_rename_dependency.patch @@ -1,5 +1,5 @@ ---- tests/incremental/05-method-rename/03-cyclic_rename_dependency.c -+++ tests/incremental/05-method-rename/03-cyclic_rename_dependency.c +--- tests/incremental/05-method-rename/02-cyclic_rename_dependency.c ++++ tests/incremental/05-method-rename/02-cyclic_rename_dependency.c @@ -2,14 +2,14 @@ -void foo1(int c) { diff --git a/tests/incremental/05-method-rename/02-cyclic_rename_dependency.t b/tests/incremental/05-method-rename/02-cyclic_rename_dependency.t new file mode 100644 index 0000000000..0d706cf320 --- /dev/null +++ b/tests/incremental/05-method-rename/02-cyclic_rename_dependency.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 02-cyclic_rename_dependency.json --enable incremental.save 02-cyclic_rename_dependency.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 02-cyclic_rename_dependency.c + $ patch -b <02-cyclic_rename_dependency.patch + patching file 02-cyclic_rename_dependency.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 02-cyclic_rename_dependency.json --enable incremental.load 02-cyclic_rename_dependency.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 2; removed = 2 + +Revert patch + + $ patch -b -R <02-cyclic_rename_dependency.patch + patching file 02-cyclic_rename_dependency.c diff --git a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.t b/tests/incremental/05-method-rename/03-cyclic_rename_dependency.t deleted file mode 100644 index 5a90ebdbe3..0000000000 --- a/tests/incremental/05-method-rename/03-cyclic_rename_dependency.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 03-cyclic_rename_dependency.json --enable incremental.save 03-cyclic_rename_dependency.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 03-cyclic_rename_dependency.c - $ patch -b <03-cyclic_rename_dependency.patch - patching file 03-cyclic_rename_dependency.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 03-cyclic_rename_dependency.json --enable incremental.load 03-cyclic_rename_dependency.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 1 (with unchangedHeader = 1); added = 2; removed = 2 - -Revert patch - - $ patch -b -R <03-cyclic_rename_dependency.patch - patching file 03-cyclic_rename_dependency.c diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.c b/tests/incremental/05-method-rename/03-cyclic_with_swap.c similarity index 100% rename from tests/incremental/05-method-rename/04-cyclic_with_swap.c rename to tests/incremental/05-method-rename/03-cyclic_with_swap.c diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.json b/tests/incremental/05-method-rename/03-cyclic_with_swap.json similarity index 100% rename from tests/incremental/05-method-rename/04-cyclic_with_swap.json rename to tests/incremental/05-method-rename/03-cyclic_with_swap.json diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.patch b/tests/incremental/05-method-rename/03-cyclic_with_swap.patch similarity index 73% rename from tests/incremental/05-method-rename/04-cyclic_with_swap.patch rename to tests/incremental/05-method-rename/03-cyclic_with_swap.patch index 534faecae4..0886106162 100644 --- a/tests/incremental/05-method-rename/04-cyclic_with_swap.patch +++ b/tests/incremental/05-method-rename/03-cyclic_with_swap.patch @@ -1,5 +1,5 @@ ---- tests/incremental/05-method-rename/04-cyclic_with_swap.c -+++ tests/incremental/05-method-rename/04-cyclic_with_swap.c +--- tests/incremental/05-method-rename/03-cyclic_with_swap.c ++++ tests/incremental/05-method-rename/03-cyclic_with_swap.c @@ -2,13 +2,17 @@ -void foo1(int c) { diff --git a/tests/incremental/05-method-rename/03-cyclic_with_swap.t b/tests/incremental/05-method-rename/03-cyclic_with_swap.t new file mode 100644 index 0000000000..8bed0df5e9 --- /dev/null +++ b/tests/incremental/05-method-rename/03-cyclic_with_swap.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 03-cyclic_with_swap.json --enable incremental.save 03-cyclic_with_swap.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 03-cyclic_with_swap.c + $ patch -b <03-cyclic_with_swap.patch + patching file 03-cyclic_with_swap.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 03-cyclic_with_swap.json --enable incremental.load 03-cyclic_with_swap.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 3; removed = 2 + +Revert patch + + $ patch -b -R <03-cyclic_with_swap.patch + patching file 03-cyclic_with_swap.c diff --git a/tests/incremental/05-method-rename/04-cyclic_with_swap.t b/tests/incremental/05-method-rename/04-cyclic_with_swap.t deleted file mode 100644 index b0a269f646..0000000000 --- a/tests/incremental/05-method-rename/04-cyclic_with_swap.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 04-cyclic_with_swap.json --enable incremental.save 04-cyclic_with_swap.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 04-cyclic_with_swap.c - $ patch -b <04-cyclic_with_swap.patch - patching file 04-cyclic_with_swap.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 04-cyclic_with_swap.json --enable incremental.load 04-cyclic_with_swap.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 1 (with unchangedHeader = 1); added = 3; removed = 2 - -Revert patch - - $ patch -b -R <04-cyclic_with_swap.patch - patching file 04-cyclic_with_swap.c diff --git a/tests/incremental/05-method-rename/05-deep_change.c b/tests/incremental/05-method-rename/04-deep_change.c similarity index 100% rename from tests/incremental/05-method-rename/05-deep_change.c rename to tests/incremental/05-method-rename/04-deep_change.c diff --git a/tests/incremental/05-method-rename/05-deep_change.json b/tests/incremental/05-method-rename/04-deep_change.json similarity index 100% rename from tests/incremental/05-method-rename/05-deep_change.json rename to tests/incremental/05-method-rename/04-deep_change.json diff --git a/tests/incremental/05-method-rename/04-deep_change.patch b/tests/incremental/05-method-rename/04-deep_change.patch new file mode 100644 index 0000000000..687b8f74bc --- /dev/null +++ b/tests/incremental/05-method-rename/04-deep_change.patch @@ -0,0 +1,11 @@ +--- tests/incremental/05-method-rename/04-deep_change.c ++++ tests/incremental/05-method-rename/04-deep_change.c +@@ -1,7 +1,7 @@ + #include + + void zap() { +- printf("zap"); ++ printf("drap"); + } + + void bar() { diff --git a/tests/incremental/05-method-rename/04-deep_change.t b/tests/incremental/05-method-rename/04-deep_change.t new file mode 100644 index 0000000000..3ac9ac649c --- /dev/null +++ b/tests/incremental/05-method-rename/04-deep_change.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 04-deep_change.json --enable incremental.save 04-deep_change.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 04-deep_change.c + $ patch -b <04-deep_change.patch + patching file 04-deep_change.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 04-deep_change.json --enable incremental.load 04-deep_change.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <04-deep_change.patch + patching file 04-deep_change.c diff --git a/tests/incremental/05-method-rename/06-common_rename.c b/tests/incremental/05-method-rename/05-common_rename.c similarity index 100% rename from tests/incremental/05-method-rename/06-common_rename.c rename to tests/incremental/05-method-rename/05-common_rename.c diff --git a/tests/incremental/05-method-rename/06-common_rename.json b/tests/incremental/05-method-rename/05-common_rename.json similarity index 100% rename from tests/incremental/05-method-rename/06-common_rename.json rename to tests/incremental/05-method-rename/05-common_rename.json diff --git a/tests/incremental/05-method-rename/06-common_rename.patch b/tests/incremental/05-method-rename/05-common_rename.patch similarity index 68% rename from tests/incremental/05-method-rename/06-common_rename.patch rename to tests/incremental/05-method-rename/05-common_rename.patch index 15afbce9ce..93904d5780 100644 --- a/tests/incremental/05-method-rename/06-common_rename.patch +++ b/tests/incremental/05-method-rename/05-common_rename.patch @@ -1,5 +1,5 @@ ---- tests/incremental/05-method-rename/06-common_rename.c -+++ tests/incremental/05-method-rename/06-common_rename.c +--- tests/incremental/05-method-rename/05-common_rename.c ++++ tests/incremental/05-method-rename/05-common_rename.c @@ -1,20 +1,20 @@ #include diff --git a/tests/incremental/05-method-rename/05-common_rename.t b/tests/incremental/05-method-rename/05-common_rename.t new file mode 100644 index 0000000000..faa7ae9f7f --- /dev/null +++ b/tests/incremental/05-method-rename/05-common_rename.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 05-common_rename.json --enable incremental.save 05-common_rename.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 05-common_rename.c + $ patch -b <05-common_rename.patch + patching file 05-common_rename.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 05-common_rename.json --enable incremental.load 05-common_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <05-common_rename.patch + patching file 05-common_rename.c diff --git a/tests/incremental/05-method-rename/05-deep_change.patch b/tests/incremental/05-method-rename/05-deep_change.patch deleted file mode 100644 index 0374da2fb6..0000000000 --- a/tests/incremental/05-method-rename/05-deep_change.patch +++ /dev/null @@ -1,11 +0,0 @@ ---- tests/incremental/05-method-rename/05-deep_change.c -+++ tests/incremental/05-method-rename/05-deep_change.c -@@ -1,7 +1,7 @@ - #include - - void zap() { -- printf("zap"); -+ printf("drap"); - } - - void bar() { diff --git a/tests/incremental/05-method-rename/05-deep_change.t b/tests/incremental/05-method-rename/05-deep_change.t deleted file mode 100644 index 60aeb46e2a..0000000000 --- a/tests/incremental/05-method-rename/05-deep_change.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 05-deep_change.json --enable incremental.save 05-deep_change.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 05-deep_change.c - $ patch -b <05-deep_change.patch - patching file 05-deep_change.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 05-deep_change.json --enable incremental.load 05-deep_change.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <05-deep_change.patch - patching file 05-deep_change.c diff --git a/tests/incremental/05-method-rename/06-common_rename.t b/tests/incremental/05-method-rename/06-common_rename.t deleted file mode 100644 index 4ba4bc2750..0000000000 --- a/tests/incremental/05-method-rename/06-common_rename.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 06-common_rename.json --enable incremental.save 06-common_rename.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 06-common_rename.c - $ patch -b <06-common_rename.patch - patching file 06-common_rename.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 06-common_rename.json --enable incremental.load 06-common_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <06-common_rename.patch - patching file 06-common_rename.c diff --git a/tests/incremental/05-method-rename/08-recursive_rename.c b/tests/incremental/05-method-rename/06-recursive_rename.c similarity index 100% rename from tests/incremental/05-method-rename/08-recursive_rename.c rename to tests/incremental/05-method-rename/06-recursive_rename.c diff --git a/tests/incremental/05-method-rename/08-recursive_rename.json b/tests/incremental/05-method-rename/06-recursive_rename.json similarity index 100% rename from tests/incremental/05-method-rename/08-recursive_rename.json rename to tests/incremental/05-method-rename/06-recursive_rename.json diff --git a/tests/incremental/05-method-rename/08-recursive_rename.patch b/tests/incremental/05-method-rename/06-recursive_rename.patch similarity index 56% rename from tests/incremental/05-method-rename/08-recursive_rename.patch rename to tests/incremental/05-method-rename/06-recursive_rename.patch index 42469f434c..356f959256 100644 --- a/tests/incremental/05-method-rename/08-recursive_rename.patch +++ b/tests/incremental/05-method-rename/06-recursive_rename.patch @@ -1,5 +1,5 @@ ---- tests/incremental/05-method-rename/08-recursive_rename.c -+++ tests/incremental/05-method-rename/08-recursive_rename.c +--- tests/incremental/05-method-rename/06-recursive_rename.c ++++ tests/incremental/05-method-rename/06-recursive_rename.c @@ -1,7 +1,7 @@ -void foo(int x) { - if(x > 1) foo(x - 1); diff --git a/tests/incremental/05-method-rename/06-recursive_rename.t b/tests/incremental/05-method-rename/06-recursive_rename.t new file mode 100644 index 0000000000..b7d0fabe3e --- /dev/null +++ b/tests/incremental/05-method-rename/06-recursive_rename.t @@ -0,0 +1,19 @@ +Run Goblint on initial program version + + $ goblint --conf 06-recursive_rename.json --enable incremental.save 06-recursive_rename.c > /dev/null 2>&1 + +Apply patch + + $ chmod +w 06-recursive_rename.c + $ patch -b <06-recursive_rename.patch + patching file 06-recursive_rename.c + +Run Goblint incrementally on new program version and check the change detection result + + $ goblint --conf 06-recursive_rename.json --enable incremental.load 06-recursive_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' + changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 + +Revert patch + + $ patch -b -R <06-recursive_rename.patch + patching file 06-recursive_rename.c diff --git a/tests/incremental/05-method-rename/08-recursive_rename.t b/tests/incremental/05-method-rename/08-recursive_rename.t deleted file mode 100644 index 5036b1da4b..0000000000 --- a/tests/incremental/05-method-rename/08-recursive_rename.t +++ /dev/null @@ -1,19 +0,0 @@ -Run Goblint on initial program version - - $ goblint --conf 08-recursive_rename.json --enable incremental.save 08-recursive_rename.c > /dev/null 2>&1 - -Apply patch - - $ chmod +w 08-recursive_rename.c - $ patch -b <08-recursive_rename.patch - patching file 08-recursive_rename.c - -Run Goblint incrementally on new program version and check the change detection result - - $ goblint --conf 08-recursive_rename.json --enable incremental.load 08-recursive_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' - changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <08-recursive_rename.patch - patching file 08-recursive_rename.c From 4bb775ab3c80ffabb8d550bb2f6927229c2efbc0 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 10:58:03 +0100 Subject: [PATCH 098/518] move rename detection and CompareGlobals back to CompareCIL --- src/framework/analyses.ml | 2 +- src/incremental/compareCIL.ml | 267 +++++++++++++++++++++- src/incremental/compareGlobals.ml | 122 ---------- src/incremental/detectRenamedFunctions.ml | 144 ------------ src/incremental/updateCil.ml | 2 +- src/util/server.ml | 2 +- 6 files changed, 264 insertions(+), 275 deletions(-) delete mode 100644 src/incremental/compareGlobals.ml delete mode 100644 src/incremental/detectRenamedFunctions.ml diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 3bbddcb71a..a86689ac1e 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -480,7 +480,7 @@ type increment_data = { server: bool; solver_data: Obj.t; - changes: CompareGlobals.change_info; + changes: CompareCIL.change_info; (* Globals for which the constraint system unknowns should be restarted *) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 1bda93b6bc..136c8434a3 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -1,21 +1,276 @@ open GoblintCil open MyCFG -include DetectRenamedFunctions include CompareAST include CompareCFG open CilMaps +module GlobalMap = Map.Make(String) + +type global_def = Var of varinfo | Fun of fundec +type global_col = {decls: varinfo option; def: global_def option} + +let name_of_global_col gc = match gc.def with + | Some (Fun f) -> f.svar.vname + | Some (Var v) -> v.vname + | None -> match gc.decls with + | Some v -> v.vname + | None -> raise (Failure "empty global record") + +let compare_global_col gc1 gc2 = compare (name_of_global_col gc1) (name_of_global_col gc2) + +module GlobalColMap = Map.Make( + struct + type t = global_col + let compare = compare_global_col + end) + +let name_of_global g = match g with + | GVar (v,_,_) -> v.vname + | GFun (f,_) -> f.svar.vname + | GVarDecl (v,_) -> v.vname + | _ -> failwith "global constructor not supported" + +type nodes_diff = { + unchangedNodes: (node * node) list; + primObsoleteNodes: node list; (** primary obsolete nodes -> all obsolete nodes are reachable from these *) +} + +type unchanged_global = { + old: global_col; + current: global_col +} +(** For semantically unchanged globals, still keep old and current version of global for resetting current to old. *) + +type changed_global = { + old: global_col; + current: global_col; + unchangedHeader: bool; + diff: nodes_diff option +} + +module VarinfoSet = Set.Make(CilType.Varinfo) + +type change_info = { + mutable changed: changed_global list; + mutable unchanged: unchanged_global list; + mutable removed: global_col list; + mutable added: global_col list; + mutable exclude_from_rel_destab: VarinfoSet.t; + (** Set of functions that are to be force-reanalyzed. + These functions are additionally included in the [changed] field, among the other changed globals. *) +} + +let empty_change_info () : change_info = + {added = []; removed = []; changed = []; unchanged = []; exclude_from_rel_destab = VarinfoSet.empty} + +(* 'ChangedFunHeader' is used for functions whose varinfo or formal parameters changed. 'Changed' is used only for + * changed functions whose header is unchanged and changed non-function globals *) +type change_status = Unchanged | Changed | ChangedFunHeader of Cil.fundec | ForceReanalyze of Cil.fundec + +(** Given a boolean that indicates whether the code object is identical to the previous version, returns the corresponding [change_status]*) +let unchanged_to_change_status = function + | true -> Unchanged + | false -> Changed + +let empty_rename_mapping: rename_mapping = (StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, ([], [])) + +let should_reanalyze (fdec: Cil.fundec) = + List.mem fdec.svar.vname (GobConfig.get_string_list "incremental.force-reanalyze.funs") + +(* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which + * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is + * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) +let eqF (old: Cil.fundec) (current: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_function_rename_mapping: method_rename_assumptions) (global_var_rename_mapping: glob_var_rename_assumptions) = + let identical, diffOpt, (_, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess) = + if should_reanalyze current then + ForceReanalyze current, None, empty_rename_mapping + else + + let add_locals_to_rename_mapping la lb map = + try + List.fold_left (fun map (a, b) -> StringMap.add a.vname b.vname map) map (List.combine la lb) + with Invalid_argument _ -> map in + + let parameterMapping = add_locals_to_rename_mapping old.sformals current.sformals StringMap.empty in + let renameMapping = (parameterMapping, global_function_rename_mapping, global_var_rename_mapping, ([], [])) in + + (* compare the function header based on the collected rename assumptions for parameters *) + let unchangedHeader, renameMapping = eq_varinfo old.svar current.svar ~rename_mapping:renameMapping + &&>> forward_list_equal eq_varinfo old.sformals current.sformals in + + if not unchangedHeader then ChangedFunHeader current, None, empty_rename_mapping + else + (* include matching of local variables into rename mapping *) + let renameMapping = match renameMapping with + | (pm, gf, gv, re) -> (add_locals_to_rename_mapping old.slocals current.slocals pm, gf, gv, re) in + let sameLocals, renameMapping = forward_list_equal eq_varinfo old.slocals current.slocals ~rename_mapping:renameMapping in + + if not sameLocals then + (Changed, None, empty_rename_mapping) + else + match cfgs with + | None -> + let (identical, new_rename_mapping) = eq_block (old.sbody, old) (current.sbody, current) ~rename_mapping:renameMapping in + unchanged_to_change_status identical, None, new_rename_mapping + | Some (cfgOld, (cfgNew, cfgNewBack)) -> + let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in + let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in + let matches, diffNodes1, updated_rename_mapping = compareFun (module CfgOld) (module CfgNew) old current renameMapping in + if diffNodes1 = [] then (Unchanged, None, updated_rename_mapping) + else (Changed, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, updated_rename_mapping) + in + identical, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess + +let performRenames (renamesOnSuccess: renamesOnSuccess) = + begin + let (compinfoRenames, enumRenames) = renamesOnSuccess in + List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname; compinfo2.ckey <- compinfo1.ckey) compinfoRenames; + List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; + end + +let preservesSameNameMatches n_old oldMap n_new newMap = n_old = n_new || (not (GlobalMap.mem n_old newMap) && not (GlobalMap.mem n_new oldMap)) + +let addToFinalMatchesMapping oV nV final_matches = + VarinfoMap.add oV nV (fst final_matches), VarinfoMap.add nV oV (snd final_matches) + +(* TODO: possibly merge with eq_varinfo, provide only varinfo and mapping from varinfo to global_col *) +(* Compares two varinfos. finalizeOnlyExactMatch=true allows to check a rename assumption and discard the comparison result in case they do not match *) +let compare_varinfo ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new newMap change_info final_matches = + if not (preservesSameNameMatches oV.vname oldMap nV.vname newMap) then + (* do not allow for matches between differently named variables if one of the variables names exists in both, the new and old file *) + false, change_info, final_matches + else ( + (* TODO does the emptyness of the dependencies need to be checked? *) + let identical, (_, function_dependencies, global_var_dependencies, renamesOnSuccess) = eq_varinfo oV nV ~rename_mapping:empty_rename_mapping in + + if not finalizeOnlyExactMatch || identical then + performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) + if identical then ( + change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; + true, change_info, addToFinalMatchesMapping oV nV final_matches + ) else if not finalizeOnlyExactMatch then ( + change_info.changed <- {old = gc_old; current = gc_new; unchangedHeader = true; diff = None} :: change_info.changed; + false, change_info, addToFinalMatchesMapping oV nV final_matches + ) else + false, change_info, final_matches + ) +let compare_varinfo_exact = compare_varinfo ~finalizeOnlyExactMatch:true + +let get_varinfo gc = match gc.decls, gc.def with + | _, Some (Var v) -> v + | _, Some (Fun f) -> f.svar + | Some v, _ -> v + | _ -> failwith "A global should have at least a declaration or a definition" + +let addNewGlobals name gc_new (change_info, final_matches) = + if not (VarinfoMap.mem (get_varinfo gc_new) (snd final_matches)) then + change_info.added <- gc_new :: change_info.added; + (change_info, final_matches) + +let addOldGlobals name gc_old (change_info, final_matches) = + if not (VarinfoMap.mem (get_varinfo gc_old) (fst final_matches)) then + change_info.removed <- gc_old :: change_info.removed; + (change_info, final_matches) + +let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) = + let extract_fundecs _ gc map = match gc.def with + | Some (Fun f) -> VarinfoMap.add f.svar f map + | _ -> map in + let var_fun_old = GlobalMap.fold extract_fundecs oldMap VarinfoMap.empty in + let var_fun_new = GlobalMap.fold extract_fundecs newMap VarinfoMap.empty in + let extract_globs _ gc map = + let v = get_varinfo gc in + VarinfoMap.add v gc map in + let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in + let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in + let empty_rename_assms m = VarinfoMap.for_all (fun vo vn -> vo.vname = vn.vname) m in (* TODO or in final_matches? *) + + let compare_fundec_exact_match f1 f2 change_info final_matches = + (* check that names of match are each only contained in new or old file *) + if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then ( + false, change_info, final_matches + ) else + let doMatch, diff, fun_deps, global_deps, renamesOnSuccess = eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in + match doMatch with + | Unchanged when empty_rename_assms (VarinfoMap.filter (fun vo vn -> not (vo.vname = f1.svar.vname && vn.vname = f2.svar.vname)) fun_deps) && empty_rename_assms global_deps -> + performRenames renamesOnSuccess; + change_info.unchanged <- {old = VarinfoMap.find f1.svar var_glob_old; current = VarinfoMap.find f2.svar var_glob_new} :: change_info.unchanged; + let final_matches = addToFinalMatchesMapping f1.svar f2.svar final_matches in + true, change_info, final_matches + | Unchanged -> false, change_info, final_matches + | Changed -> false, change_info, final_matches + | ChangedFunHeader _ -> false, change_info, final_matches + | ForceReanalyze _ -> false, change_info, final_matches + + in + + let matchGlobal ~matchVars ~matchFuns name gc_old (change_info, final_matches) = + try + let gc_new = StringMap.find name newMap in + + let compare_same_name_fundec_check_contained_renames f1 f2 = + let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in + performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) + let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> + match VarinfoMap.find_opt f_old_var (fst final_matches) with + | None -> + let f_old = VarinfoMap.find f_old_var var_fun_old in + let f_new = VarinfoMap.find f_new_var var_fun_new in (* TODO: what happens if there exists no fundec for this varinfo? *) + if acc then + compare_fundec_exact_match f_old f_new ci fm + else false, ci, fm + | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in + let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> + match VarinfoMap.find_opt old_var (fst final_matches) with + | None -> + if acc then + compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm + else false, ci, fm + | Some v -> v = new_var, ci, fm + ) global_var_dependencies (true, change_info, final_matches) in + let dependenciesMatch = funDependenciesMatch && globalDependenciesMatch in + let append_to_changed ~unchangedHeader ~diff = + change_info.changed <- {current = gc_new; old = gc_old; unchangedHeader; diff} :: change_info.changed + in + (* TODO: merge with no-rename-detection case in compareCIL.compareCilFiles *) + (match doMatch with + | Unchanged when dependenciesMatch -> + change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged + | Unchanged -> + (* no diff is stored, also when comparing functions based on CFG because currently there is no mechanism to detect which part was affected by the *) + append_to_changed ~unchangedHeader:true ~diff:None + | Changed -> append_to_changed ~unchangedHeader:true ~diff:diff + | _ -> (* this can only be ForceReanalyze or ChangedFunHeader *) + change_info.exclude_from_rel_destab <- VarinfoSet.add f1.svar change_info.exclude_from_rel_destab; + append_to_changed ~unchangedHeader:false ~diff:None); + addToFinalMatchesMapping f1.svar f2.svar final_matches in + + match gc_old.def, gc_new.def with + | Some (Var v1), Some (Var v2) when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm + | Some (Fun f1), Some (Fun f2) when matchFuns -> change_info, compare_same_name_fundec_check_contained_renames f1 f2 + | None, None -> (match gc_old.decls, gc_new.decls with + | Some v1, Some v2 when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm + | _ -> change_info, final_matches) + | _ -> change_info, final_matches + with Not_found -> change_info, final_matches in + + (empty_change_info (), (VarinfoMap.empty, VarinfoMap.empty)) (* change_info and final_matches (bi-directional) is propagated *) + |> GlobalMap.fold (matchGlobal ~matchVars:true ~matchFuns:false) oldMap + |> GlobalMap.fold (matchGlobal ~matchVars:false ~matchFuns:true) oldMap + |> GlobalMap.fold addNewGlobals newMap + |> GlobalMap.fold addOldGlobals oldMap + let eq_glob (old: global_col) (current: global_col) (cfgs : (cfg * (cfg * cfg)) option) = let identical, diff, renamesOnSuccess = match old.def, current.def with | Some (Var x), Some (Var y) -> let identical, (_,_,_,renamesOnSuccess) = eq_varinfo x y ~rename_mapping:empty_rename_mapping in unchanged_to_change_status identical, None, renamesOnSuccess (* ignore the init_info - a changed init of a global will lead to a different start state *) - | Some (Fun f), Some (Fun g) -> ( - let identical, diffOpt, funDep, globVarDep, renamesOnSuccess = CompareGlobals.eqF f g cfgs VarinfoMap.empty VarinfoMap.empty in + | Some (Fun f), Some (Fun g) -> + let identical, diffOpt, funDep, globVarDep, renamesOnSuccess = eqF f g cfgs VarinfoMap.empty VarinfoMap.empty in (*Perform renames no matter what.*) - match identical with - | Unchanged when not (VarinfoMap.is_empty funDep && VarinfoMap.for_all (fun ov nv -> ov.vname = nv.vname) globVarDep) -> Changed, diffOpt, renamesOnSuccess - | s -> s, diffOpt, renamesOnSuccess) + (match identical with + | Unchanged when not (VarinfoMap.is_empty funDep && VarinfoMap.for_all (fun ov nv -> ov.vname = nv.vname) globVarDep) -> Changed, diffOpt, renamesOnSuccess + | s -> s, diffOpt, renamesOnSuccess) | None, None -> (match old.decls, current.decls with | Some x, Some y -> let identical, (_,_,_,renamesOnSuccess) = eq_varinfo x y ~rename_mapping:empty_rename_mapping in diff --git a/src/incremental/compareGlobals.ml b/src/incremental/compareGlobals.ml deleted file mode 100644 index 57883fff7c..0000000000 --- a/src/incremental/compareGlobals.ml +++ /dev/null @@ -1,122 +0,0 @@ -open GoblintCil -open MyCFG -open CilMaps -include CompareAST -include CompareCFG - -module GlobalMap = Map.Make(String) - -type global_def = Var of varinfo | Fun of fundec -type global_col = {decls: varinfo option; def: global_def option} - -let name_of_global_col gc = match gc.def with - | Some (Fun f) -> f.svar.vname - | Some (Var v) -> v.vname - | None -> match gc.decls with - | Some v -> v.vname - | None -> raise (Failure "empty global record") - -let compare_global_col gc1 gc2 = compare (name_of_global_col gc1) (name_of_global_col gc2) - -module GlobalColMap = Map.Make( - struct - type t = global_col - let compare = compare_global_col - end) - -let name_of_global g = match g with - | GVar (v,_,_) -> v.vname - | GFun (f,_) -> f.svar.vname - | GVarDecl (v,_) -> v.vname - | _ -> failwith "global constructor not supported" - -type nodes_diff = { - unchangedNodes: (node * node) list; - primObsoleteNodes: node list; (** primary obsolete nodes -> all obsolete nodes are reachable from these *) -} - -type unchanged_global = { - old: global_col; - current: global_col -} -(** For semantically unchanged globals, still keep old and current version of global for resetting current to old. *) - -type changed_global = { - old: global_col; - current: global_col; - unchangedHeader: bool; - diff: nodes_diff option -} - -module VarinfoSet = Set.Make(CilType.Varinfo) - -type change_info = { - mutable changed: changed_global list; - mutable unchanged: unchanged_global list; - mutable removed: global_col list; - mutable added: global_col list; - mutable exclude_from_rel_destab: VarinfoSet.t; - (** Set of functions that are to be force-reanalyzed. - These functions are additionally included in the [changed] field, among the other changed globals. *) -} - -let empty_change_info () : change_info = - {added = []; removed = []; changed = []; unchanged = []; exclude_from_rel_destab = VarinfoSet.empty} - -(* 'ChangedFunHeader' is used for functions whose varinfo or formal parameters changed. 'Changed' is used only for - * changed functions whose header is unchanged and changed non-function globals *) -type change_status = Unchanged | Changed | ChangedFunHeader of Cil.fundec | ForceReanalyze of Cil.fundec - -(** Given a boolean that indicates whether the code object is identical to the previous version, returns the corresponding [change_status]*) -let unchanged_to_change_status = function - | true -> Unchanged - | false -> Changed - -let empty_rename_mapping: rename_mapping = (StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, ([], [])) - -let should_reanalyze (fdec: Cil.fundec) = - List.mem fdec.svar.vname (GobConfig.get_string_list "incremental.force-reanalyze.funs") - -(* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which - * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is - * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) -let eqF (old: Cil.fundec) (current: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) option) (global_function_rename_mapping: method_rename_assumptions) (global_var_rename_mapping: glob_var_rename_assumptions) = - let identical, diffOpt, (_, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess) = - if should_reanalyze current then - ForceReanalyze current, None, empty_rename_mapping - else - - let add_locals_to_rename_mapping la lb map = - try - List.fold_left (fun map (a, b) -> StringMap.add a.vname b.vname map) map (List.combine la lb) - with Invalid_argument _ -> map in - - let parameterMapping = add_locals_to_rename_mapping old.sformals current.sformals StringMap.empty in - let renameMapping = (parameterMapping, global_function_rename_mapping, global_var_rename_mapping, ([], [])) in - - (* compare the function header based on the collected rename assumptions for parameters *) - let unchangedHeader, renameMapping = eq_varinfo old.svar current.svar ~rename_mapping:renameMapping - &&>> forward_list_equal eq_varinfo old.sformals current.sformals in - - if not unchangedHeader then ChangedFunHeader current, None, empty_rename_mapping - else - (* include matching of local variables into rename mapping *) - let renameMapping = match renameMapping with - | (pm, gf, gv, re) -> (add_locals_to_rename_mapping old.slocals current.slocals pm, gf, gv, re) in - let sameLocals, renameMapping = forward_list_equal eq_varinfo old.slocals current.slocals ~rename_mapping:renameMapping in - - if not sameLocals then - (Changed, None, empty_rename_mapping) - else - match cfgs with - | None -> - let (identical, new_rename_mapping) = eq_block (old.sbody, old) (current.sbody, current) ~rename_mapping:renameMapping in - unchanged_to_change_status identical, None, new_rename_mapping - | Some (cfgOld, (cfgNew, cfgNewBack)) -> - let module CfgOld : MyCFG.CfgForward = struct let next = cfgOld end in - let module CfgNew : MyCFG.CfgBidir = struct let prev = cfgNewBack let next = cfgNew end in - let matches, diffNodes1, updated_rename_mapping = compareFun (module CfgOld) (module CfgNew) old current renameMapping in - if diffNodes1 = [] then (Unchanged, None, updated_rename_mapping) - else (Changed, Some {unchangedNodes = matches; primObsoleteNodes = diffNodes1}, updated_rename_mapping) - in - identical, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess diff --git a/src/incremental/detectRenamedFunctions.ml b/src/incremental/detectRenamedFunctions.ml deleted file mode 100644 index 39e0c13850..0000000000 --- a/src/incremental/detectRenamedFunctions.ml +++ /dev/null @@ -1,144 +0,0 @@ -open GoblintCil -include CompareGlobals -open CilMaps - -let performRenames (renamesOnSuccess: renamesOnSuccess) = - begin - let (compinfoRenames, enumRenames) = renamesOnSuccess in - List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname; compinfo2.ckey <- compinfo1.ckey) compinfoRenames; - List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; - end - -let preservesSameNameMatches n_old oldMap n_new newMap = n_old = n_new || (not (GlobalMap.mem n_old newMap) && not (GlobalMap.mem n_new oldMap)) - -let addToFinalMatchesMapping oV nV final_matches = - VarinfoMap.add oV nV (fst final_matches), VarinfoMap.add nV oV (snd final_matches) - -(* TODO: possibly merge with eq_varinfo, provide only varinfo and mapping from varinfo to global_col *) -(* Compares two varinfos. finalizeOnlyExactMatch=true allows to check a rename assumption and discard the comparison result in case they do not match *) -let compare_varinfo ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new newMap change_info final_matches = - if not (preservesSameNameMatches oV.vname oldMap nV.vname newMap) then - (* do not allow for matches between differently named variables if one of the variables names exists in both, the new and old file *) - false, change_info, final_matches - else ( - (* TODO does the emptyness of the dependencies need to be checked? *) - let identical, (_, function_dependencies, global_var_dependencies, renamesOnSuccess) = eq_varinfo oV nV ~rename_mapping:empty_rename_mapping in - - if not finalizeOnlyExactMatch || identical then - performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) - if identical then ( - change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; - true, change_info, addToFinalMatchesMapping oV nV final_matches - ) else if not finalizeOnlyExactMatch then ( - change_info.changed <- {old = gc_old; current = gc_new; unchangedHeader = true; diff = None} :: change_info.changed; - false, change_info, addToFinalMatchesMapping oV nV final_matches - ) else - false, change_info, final_matches - ) -let compare_varinfo_exact = compare_varinfo ~finalizeOnlyExactMatch:true - -let get_varinfo gc = match gc.decls, gc.def with - | _, Some (Var v) -> v - | _, Some (Fun f) -> f.svar - | Some v, _ -> v - | _ -> failwith "A global should have at least a declaration or a definition" -let addNewGlobals name gc_new (change_info, final_matches) = - if not (VarinfoMap.mem (get_varinfo gc_new) (snd final_matches)) then - change_info.added <- gc_new :: change_info.added; - (change_info, final_matches) - -let addOldGlobals name gc_old (change_info, final_matches) = - if not (VarinfoMap.mem (get_varinfo gc_old) (fst final_matches)) then - change_info.removed <- gc_old :: change_info.removed; - (change_info, final_matches) - -let iname cg = List.mem (name_of_global_col cg) ["main"; "foo"; "bar"] -let inamev v = List.mem v.vname ["main"; "foo"; "bar"] - -let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) = - let extract_fundecs _ gc map = match gc.def with - | Some (Fun f) -> VarinfoMap.add f.svar f map - | _ -> map in - let var_fun_old = GlobalMap.fold extract_fundecs oldMap VarinfoMap.empty in - let var_fun_new = GlobalMap.fold extract_fundecs newMap VarinfoMap.empty in - let extract_globs _ gc map = - let v = get_varinfo gc in - VarinfoMap.add v gc map in - let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in - let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in - let empty_rename_assms m = VarinfoMap.for_all (fun vo vn -> vo.vname = vn.vname) m in (* TODO or in final_matches? *) - - let compare_fundec_exact_match f1 f2 change_info final_matches = - (* check that names of match are each only contained in new or old file *) - if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then ( - false, change_info, final_matches - ) else - let doMatch, diff, fun_deps, global_deps, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in - match doMatch with - | Unchanged when empty_rename_assms (VarinfoMap.filter (fun vo vn -> not (vo.vname = f1.svar.vname && vn.vname = f2.svar.vname)) fun_deps) && empty_rename_assms global_deps -> - performRenames renamesOnSuccess; - change_info.unchanged <- {old = VarinfoMap.find f1.svar var_glob_old; current = VarinfoMap.find f2.svar var_glob_new} :: change_info.unchanged; - let final_matches = addToFinalMatchesMapping f1.svar f2.svar final_matches in - true, change_info, final_matches - | Unchanged -> false, change_info, final_matches - | Changed -> false, change_info, final_matches - | ChangedFunHeader _ -> false, change_info, final_matches - | ForceReanalyze _ -> false, change_info, final_matches - - in - - let matchGlobal ~matchVars ~matchFuns name gc_old (change_info, final_matches) = - try - let gc_new = StringMap.find name newMap in - - let compare_same_name_fundec_check_contained_renames f1 f2 = - let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = CompareGlobals.eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in - performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) - let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> - match VarinfoMap.find_opt f_old_var (fst final_matches) with - | None -> - let f_old = VarinfoMap.find f_old_var var_fun_old in - let f_new = VarinfoMap.find f_new_var var_fun_new in (* TODO: what happens if there exists no fundec for this varinfo? *) - if acc then - compare_fundec_exact_match f_old f_new ci fm - else false, ci, fm - | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in - let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> - match VarinfoMap.find_opt old_var (fst final_matches) with - | None -> - if acc then - compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm - else false, ci, fm - | Some v -> v = new_var, ci, fm - ) global_var_dependencies (true, change_info, final_matches) in - let dependenciesMatch = funDependenciesMatch && globalDependenciesMatch in - let append_to_changed ~unchangedHeader ~diff = - change_info.changed <- {current = gc_new; old = gc_old; unchangedHeader; diff} :: change_info.changed - in - (* TODO: merge with no-rename-detection case in compareCIL.compareCilFiles *) - (match doMatch with - | Unchanged when dependenciesMatch -> - change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged - | Unchanged -> - (* no diff is stored, also when comparing functions based on CFG because currently there is no mechanism to detect which part was affected by the *) - append_to_changed ~unchangedHeader:true ~diff:None - | Changed -> append_to_changed ~unchangedHeader:true ~diff:diff - | _ -> (* this can only be ForceReanalyze or ChangedFunHeader *) - change_info.exclude_from_rel_destab <- VarinfoSet.add f1.svar change_info.exclude_from_rel_destab; - append_to_changed ~unchangedHeader:false ~diff:None); - addToFinalMatchesMapping f1.svar f2.svar final_matches in - - match gc_old.def, gc_new.def with - | Some (Var v1), Some (Var v2) when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm - | Some (Fun f1), Some (Fun f2) when matchFuns -> change_info, compare_same_name_fundec_check_contained_renames f1 f2 - | None, None -> (match gc_old.decls, gc_new.decls with - | Some v1, Some v2 when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm - | _ -> change_info, final_matches) - | _ -> change_info, final_matches - with Not_found -> change_info, final_matches in - - (empty_change_info (), (VarinfoMap.empty, VarinfoMap.empty)) (* change_info and final_matches (bi-directional) is propagated *) - |> GlobalMap.fold (matchGlobal ~matchVars:true ~matchFuns:false) oldMap - |> GlobalMap.fold (matchGlobal ~matchVars:false ~matchFuns:true) oldMap - |> GlobalMap.fold addNewGlobals newMap - |> GlobalMap.fold addOldGlobals oldMap diff --git a/src/incremental/updateCil.ml b/src/incremental/updateCil.ml index c4516578ae..474254872d 100644 --- a/src/incremental/updateCil.ml +++ b/src/incremental/updateCil.ml @@ -1,5 +1,5 @@ open GoblintCil -open CompareGlobals +open CompareCIL open MaxIdUtil open MyCFG diff --git a/src/util/server.ml b/src/util/server.ml index e260c21965..3dd2adf52d 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -158,7 +158,7 @@ let reparse (s: t) = (* Only called when the file has not been reparsed, so we can skip the expensive CFG comparison. *) let virtual_changes file = let eq (glob: CompareCIL.global_col) _ _ = match glob.def with - | Some (Fun fdec) when CompareGlobals.should_reanalyze fdec -> CompareCIL.ForceReanalyze fdec, None + | Some (Fun fdec) when CompareCIL.should_reanalyze fdec -> CompareCIL.ForceReanalyze fdec, None | _ -> Unchanged, None in CompareCIL.compareCilFiles ~eq file file From 2620cfc7fd2f0b9b2e9631a89a1ccbef42251364 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 12:36:31 +0100 Subject: [PATCH 099/518] remove debugging functions --- src/incremental/compareAST.ml | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index e6ca67f1df..193d98c753 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -39,22 +39,6 @@ let create_locals_rename_mapping (originalLocalNames: string list) (updatedLocal ) else StringMap.empty -let string_tuple_to_string (tuple: (string * string) list) = "[" ^ (tuple |> - List.map (fun x -> match x with (first, second) -> "(" ^ first ^ " -> " ^ second ^ ")") |> - String.concat ", ") ^ "]" - -let rename_mapping_to_string (rename_mapping: rename_mapping) = - let (local, methods, glob_vars, _) = rename_mapping in - let local_string = [%show: (string * string) list] (List.of_seq (StringMap.to_seq local)) in - let methods_string: string = List.of_seq (VarinfoMap.to_seq methods) |> - List.map (fun (oldf, newf) -> "(methodName: " ^ oldf.vname ^ " -> " ^ newf.vname ^ ")") |> - String.concat ", " in - - let global_var_string: string = string_tuple_to_string (List.of_seq (VarinfoMap.to_seq glob_vars) |> - List.map (fun (vold, vnew) -> vold.vname, vnew.vname)) in - - "(local=" ^ local_string ^ "; methods=[" ^ methods_string ^ "]; glob_vars=" ^ global_var_string ^ ")" - let is_rename_mapping_empty (rename_mapping: rename_mapping) = let local, methods, glob_vars, _= rename_mapping in StringMap.is_empty local && VarinfoMap.is_empty methods && VarinfoMap.is_empty glob_vars From 442b6d95d6a51acb50cd55653209de88b69905b5 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 20:06:57 +0100 Subject: [PATCH 100/518] merge comparison with and without rename detection --- src/incremental/compareCIL.ml | 330 ++++++++++++++++------------------ src/util/server.ml | 13 +- 2 files changed, 163 insertions(+), 180 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 136c8434a3..1be02b44d6 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -18,6 +18,16 @@ let name_of_global_col gc = match gc.def with let compare_global_col gc1 gc2 = compare (name_of_global_col gc1) (name_of_global_col gc2) +let get_varinfo gc = match gc.decls, gc.def with + | _, Some (Var v) -> v + | _, Some (Fun f) -> f.svar + | Some v, _ -> v + | _ -> failwith "A global should have at least a declaration or a definition" + +let get_fundec gc = match gc.decls, gc.def with + | _, Some (Fun f) -> f + | _ -> failwith "Global does not have a function definition" + module GlobalColMap = Map.Make( struct type t = global_col @@ -77,6 +87,41 @@ let empty_rename_mapping: rename_mapping = (StringMap.empty, VarinfoMap.empty, V let should_reanalyze (fdec: Cil.fundec) = List.mem fdec.svar.vname (GobConfig.get_string_list "incremental.force-reanalyze.funs") +let performRenames (renamesOnSuccess: renamesOnSuccess) = + begin + let (compinfoRenames, enumRenames) = renamesOnSuccess in + List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname; compinfo2.ckey <- compinfo1.ckey) compinfoRenames; + List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; + end + +let preservesSameNameMatches n_old oldMap n_new newMap = n_old = n_new || (not (GlobalMap.mem n_old newMap) && not (GlobalMap.mem n_new oldMap)) + +let addToFinalMatchesMapping oV nV final_matches = + VarinfoMap.add oV nV (fst final_matches), VarinfoMap.add nV oV (snd final_matches) + +let empty_rename_assms m = VarinfoMap.for_all (fun vo vn -> vo.vname = vn.vname) m + +(* Compares two varinfos of globals. finalizeOnlyExactMatch=true allows to check a rename assumption and discard the comparison result in case they do not match *) +let eq_glob_var ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new newMap change_info final_matches = + if not (preservesSameNameMatches oV.vname oldMap nV.vname newMap) then + (* do not allow for matches between differently named variables if one of the variables names exists in both, the new and old file *) + false, change_info, final_matches + else ( + let identical, (_, function_dependencies, global_var_dependencies, renamesOnSuccess) = eq_varinfo oV nV ~rename_mapping:empty_rename_mapping in + + if not finalizeOnlyExactMatch || identical then + performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) + if identical then ( + change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; + true, change_info, addToFinalMatchesMapping oV nV final_matches + ) else if not finalizeOnlyExactMatch then ( + change_info.changed <- {old = gc_old; current = gc_new; unchangedHeader = true; diff = None} :: change_info.changed; + false, change_info, addToFinalMatchesMapping oV nV final_matches + ) else + false, change_info, final_matches + ) +let compare_varinfo_exact = eq_glob_var ~finalizeOnlyExactMatch:true + (* If some CFGs of the two functions to be compared are provided, a fine-grained CFG comparison is done that also determines which * nodes of the function changed. If on the other hand no CFGs are provided, the "old" AST comparison on the CIL.file is * used for functions. Then no information is collected regarding which parts/nodes of the function changed. *) @@ -121,46 +166,96 @@ let eqF (old: Cil.fundec) (current: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) opti in identical, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess -let performRenames (renamesOnSuccess: renamesOnSuccess) = - begin - let (compinfoRenames, enumRenames) = renamesOnSuccess in - List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname; compinfo2.ckey <- compinfo1.ckey) compinfoRenames; - List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; - end - -let preservesSameNameMatches n_old oldMap n_new newMap = n_old = n_new || (not (GlobalMap.mem n_old newMap) && not (GlobalMap.mem n_new oldMap)) - -let addToFinalMatchesMapping oV nV final_matches = - VarinfoMap.add oV nV (fst final_matches), VarinfoMap.add nV oV (snd final_matches) - -(* TODO: possibly merge with eq_varinfo, provide only varinfo and mapping from varinfo to global_col *) -(* Compares two varinfos. finalizeOnlyExactMatch=true allows to check a rename assumption and discard the comparison result in case they do not match *) -let compare_varinfo ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new newMap change_info final_matches = - if not (preservesSameNameMatches oV.vname oldMap nV.vname newMap) then - (* do not allow for matches between differently named variables if one of the variables names exists in both, the new and old file *) +let eqF_only_consider_exact_match f1 f2 change_info final_matches oldMap newMap var_glob_old var_glob_new = + (* check that names of match are each only contained in new or old file *) + if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then ( false, change_info, final_matches - else ( - (* TODO does the emptyness of the dependencies need to be checked? *) - let identical, (_, function_dependencies, global_var_dependencies, renamesOnSuccess) = eq_varinfo oV nV ~rename_mapping:empty_rename_mapping in - - if not finalizeOnlyExactMatch || identical then - performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) - if identical then ( - change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; - true, change_info, addToFinalMatchesMapping oV nV final_matches - ) else if not finalizeOnlyExactMatch then ( - change_info.changed <- {old = gc_old; current = gc_new; unchangedHeader = true; diff = None} :: change_info.changed; - false, change_info, addToFinalMatchesMapping oV nV final_matches - ) else - false, change_info, final_matches - ) -let compare_varinfo_exact = compare_varinfo ~finalizeOnlyExactMatch:true + ) else + (* the exact comparison is always uses the AST comparison because only when unchanged this match is manifested *) + let doMatch, diff, fun_deps, global_deps, renamesOnSuccess = eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in + match doMatch with + | Unchanged when empty_rename_assms (VarinfoMap.filter (fun vo vn -> not (vo.vname = f1.svar.vname && vn.vname = f2.svar.vname)) fun_deps) && empty_rename_assms global_deps -> + performRenames renamesOnSuccess; + change_info.unchanged <- {old = VarinfoMap.find f1.svar var_glob_old; current = VarinfoMap.find f2.svar var_glob_new} :: change_info.unchanged; + let final_matches = addToFinalMatchesMapping f1.svar f2.svar final_matches in + true, change_info, final_matches + | Unchanged -> false, change_info, final_matches + | Changed -> false, change_info, final_matches + | ChangedFunHeader _ -> false, change_info, final_matches + | ForceReanalyze _ -> false, change_info, final_matches + +let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old gc_new (change_info, final_matches) = + let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = eqF f1 f2 cfgs VarinfoMap.empty VarinfoMap.empty in + performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) + + (* for rename detection, check whether the rename assumptions collected during the function comparison actually match exactly, + otherwise check that the function comparison was successful without collecting any rename assumptions *) + let dependenciesMatch = + if renameDetection then + let funDependenciesMatch, change_info, final_matches = + let extract_globs _ gc map = + let v = get_varinfo gc in + VarinfoMap.add v gc map in + let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in + let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in + VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> + match VarinfoMap.find_opt f_old_var (fst final_matches) with + | None -> + let f_old = get_fundec (VarinfoMap.find f_old_var var_glob_old) in + let f_new = get_fundec (VarinfoMap.find f_new_var var_glob_new) in (* TODO: what happens if there exists no fundec for this varinfo? *) + if acc then + eqF_only_consider_exact_match f_old f_new ci fm oldMap newMap var_glob_old var_glob_new + else false, ci, fm + | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in + let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> + match VarinfoMap.find_opt old_var (fst final_matches) with + | None -> + if acc then + compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm + else false, ci, fm + | Some v -> v = new_var, ci, fm + ) global_var_dependencies (true, change_info, final_matches) in + funDependenciesMatch && globalDependenciesMatch + else + empty_rename_assms function_dependencies && empty_rename_assms global_var_dependencies in -let get_varinfo gc = match gc.decls, gc.def with - | _, Some (Var v) -> v - | _, Some (Fun f) -> f.svar - | Some v, _ -> v - | _ -> failwith "A global should have at least a declaration or a definition" + let append_to_changed ~unchangedHeader ~diff = + change_info.changed <- {current = gc_new; old = gc_old; unchangedHeader; diff} :: change_info.changed + in + (match doMatch with + | Unchanged when dependenciesMatch -> + change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged + | Unchanged -> + (* no diff is stored, also when comparing functions based on CFG because currently there is no mechanism to detect which part was affected by the *) + append_to_changed ~unchangedHeader:true ~diff:None + | Changed -> append_to_changed ~unchangedHeader:true ~diff:diff + | _ -> (* this can only be ForceReanalyze or ChangedFunHeader *) + change_info.exclude_from_rel_destab <- VarinfoSet.add f1.svar change_info.exclude_from_rel_destab; + append_to_changed ~unchangedHeader:false ~diff:None); + change_info, addToFinalMatchesMapping f1.svar f2.svar final_matches + +let eq_glob ?(matchVars=true) ?(matchFuns=true) ?(renameDetection=false) oldMap newMap cfgs gc_old gc_new (change_info, final_matches) = + match gc_old.def, gc_new.def with + | Some (Var v1), Some (Var v2) when matchVars -> let _, ci, fm = eq_glob_var v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm + | Some (Fun f1), Some (Fun f2) when matchFuns -> + eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old gc_new (change_info, final_matches) + | None, None -> (match gc_old.decls, gc_new.decls with + | Some v1, Some v2 when matchVars -> let _, ci, fm = eq_glob_var v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm + | _ -> change_info, final_matches (* a global collection should never be empty *)) + (* Without rename detection a global definition or declaration that does not have respective counterpart in the other version is considered to be changed (not added or removed) + because a global collection only exists in the map if there is at least one declaration or definition for this global. + For the rename detection they can only be added to changed when the according flag is set, because there would be duplicates when iterating over the globals several times. *) + | Some (Var _), None + | None, Some (Var _) -> if matchVars then ( + change_info.changed <- {old = gc_old; current = gc_new; diff = None; unchangedHeader = true} :: change_info.changed; + change_info, addToFinalMatchesMapping (get_varinfo gc_old) (get_varinfo gc_new) final_matches) + else + change_info, final_matches + | _, _ -> if matchVars && matchFuns then ( + change_info.changed <- {old = gc_old; current = gc_new; diff = None; unchangedHeader = true} :: change_info.changed; + change_info, addToFinalMatchesMapping (get_varinfo gc_old) (get_varinfo gc_new) final_matches) + else + change_info, final_matches let addNewGlobals name gc_new (change_info, final_matches) = if not (VarinfoMap.mem (get_varinfo gc_new) (snd final_matches)) then @@ -172,114 +267,6 @@ let addOldGlobals name gc_old (change_info, final_matches) = change_info.removed <- gc_old :: change_info.removed; (change_info, final_matches) -let detectRenamedFunctions (oldMap : global_col StringMap.t) (newMap : global_col StringMap.t) = - let extract_fundecs _ gc map = match gc.def with - | Some (Fun f) -> VarinfoMap.add f.svar f map - | _ -> map in - let var_fun_old = GlobalMap.fold extract_fundecs oldMap VarinfoMap.empty in - let var_fun_new = GlobalMap.fold extract_fundecs newMap VarinfoMap.empty in - let extract_globs _ gc map = - let v = get_varinfo gc in - VarinfoMap.add v gc map in - let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in - let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in - let empty_rename_assms m = VarinfoMap.for_all (fun vo vn -> vo.vname = vn.vname) m in (* TODO or in final_matches? *) - - let compare_fundec_exact_match f1 f2 change_info final_matches = - (* check that names of match are each only contained in new or old file *) - if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then ( - false, change_info, final_matches - ) else - let doMatch, diff, fun_deps, global_deps, renamesOnSuccess = eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in - match doMatch with - | Unchanged when empty_rename_assms (VarinfoMap.filter (fun vo vn -> not (vo.vname = f1.svar.vname && vn.vname = f2.svar.vname)) fun_deps) && empty_rename_assms global_deps -> - performRenames renamesOnSuccess; - change_info.unchanged <- {old = VarinfoMap.find f1.svar var_glob_old; current = VarinfoMap.find f2.svar var_glob_new} :: change_info.unchanged; - let final_matches = addToFinalMatchesMapping f1.svar f2.svar final_matches in - true, change_info, final_matches - | Unchanged -> false, change_info, final_matches - | Changed -> false, change_info, final_matches - | ChangedFunHeader _ -> false, change_info, final_matches - | ForceReanalyze _ -> false, change_info, final_matches - - in - - let matchGlobal ~matchVars ~matchFuns name gc_old (change_info, final_matches) = - try - let gc_new = StringMap.find name newMap in - - let compare_same_name_fundec_check_contained_renames f1 f2 = - let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in - performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during comparison of this matched function *) - let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> - match VarinfoMap.find_opt f_old_var (fst final_matches) with - | None -> - let f_old = VarinfoMap.find f_old_var var_fun_old in - let f_new = VarinfoMap.find f_new_var var_fun_new in (* TODO: what happens if there exists no fundec for this varinfo? *) - if acc then - compare_fundec_exact_match f_old f_new ci fm - else false, ci, fm - | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in - let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> - match VarinfoMap.find_opt old_var (fst final_matches) with - | None -> - if acc then - compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm - else false, ci, fm - | Some v -> v = new_var, ci, fm - ) global_var_dependencies (true, change_info, final_matches) in - let dependenciesMatch = funDependenciesMatch && globalDependenciesMatch in - let append_to_changed ~unchangedHeader ~diff = - change_info.changed <- {current = gc_new; old = gc_old; unchangedHeader; diff} :: change_info.changed - in - (* TODO: merge with no-rename-detection case in compareCIL.compareCilFiles *) - (match doMatch with - | Unchanged when dependenciesMatch -> - change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged - | Unchanged -> - (* no diff is stored, also when comparing functions based on CFG because currently there is no mechanism to detect which part was affected by the *) - append_to_changed ~unchangedHeader:true ~diff:None - | Changed -> append_to_changed ~unchangedHeader:true ~diff:diff - | _ -> (* this can only be ForceReanalyze or ChangedFunHeader *) - change_info.exclude_from_rel_destab <- VarinfoSet.add f1.svar change_info.exclude_from_rel_destab; - append_to_changed ~unchangedHeader:false ~diff:None); - addToFinalMatchesMapping f1.svar f2.svar final_matches in - - match gc_old.def, gc_new.def with - | Some (Var v1), Some (Var v2) when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm - | Some (Fun f1), Some (Fun f2) when matchFuns -> change_info, compare_same_name_fundec_check_contained_renames f1 f2 - | None, None -> (match gc_old.decls, gc_new.decls with - | Some v1, Some v2 when matchVars -> let _, ci, fm = compare_varinfo v1 gc_old oldMap v2 gc_new newMap change_info final_matches in ci, fm - | _ -> change_info, final_matches) - | _ -> change_info, final_matches - with Not_found -> change_info, final_matches in - - (empty_change_info (), (VarinfoMap.empty, VarinfoMap.empty)) (* change_info and final_matches (bi-directional) is propagated *) - |> GlobalMap.fold (matchGlobal ~matchVars:true ~matchFuns:false) oldMap - |> GlobalMap.fold (matchGlobal ~matchVars:false ~matchFuns:true) oldMap - |> GlobalMap.fold addNewGlobals newMap - |> GlobalMap.fold addOldGlobals oldMap - -let eq_glob (old: global_col) (current: global_col) (cfgs : (cfg * (cfg * cfg)) option) = - let identical, diff, renamesOnSuccess = match old.def, current.def with - | Some (Var x), Some (Var y) -> - let identical, (_,_,_,renamesOnSuccess) = eq_varinfo x y ~rename_mapping:empty_rename_mapping in - unchanged_to_change_status identical, None, renamesOnSuccess (* ignore the init_info - a changed init of a global will lead to a different start state *) - | Some (Fun f), Some (Fun g) -> - let identical, diffOpt, funDep, globVarDep, renamesOnSuccess = eqF f g cfgs VarinfoMap.empty VarinfoMap.empty in - (*Perform renames no matter what.*) - (match identical with - | Unchanged when not (VarinfoMap.is_empty funDep && VarinfoMap.for_all (fun ov nv -> ov.vname = nv.vname) globVarDep) -> Changed, diffOpt, renamesOnSuccess - | s -> s, diffOpt, renamesOnSuccess) - | None, None -> (match old.decls, current.decls with - | Some x, Some y -> - let identical, (_,_,_,renamesOnSuccess) = eq_varinfo x y ~rename_mapping:empty_rename_mapping in - unchanged_to_change_status identical, None, renamesOnSuccess - | _, _ -> failwith "should never collect any empty entries in GlobalMap") - | _, _ -> Changed, None, ([], []) (* it is considered to be changed (not added or removed) because a global collection only exists in the map if there is at least one declaration or definition for this global *) in - performRenames renamesOnSuccess; (* updates enum names and compinfo names and keys that were collected during successful comparisons *) - identical, diff - let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let cfgs = if GobConfig.get_string "incremental.compare" = "cfg" then Some (CfgTools.getCFG oldAST |> fst, CfgTools.getCFG newAST) @@ -312,37 +299,30 @@ let compareCilFiles ?(eq=eq_glob) (oldAST: file) (newAST: file) = let changes = empty_change_info () in global_typ_acc := []; - if GobConfig.get_bool "incremental.detect-renames" then ( - let (change_info, final_mapping) = detectRenamedFunctions oldMap newMap in - changes.added <- change_info.added; - changes.removed <- change_info.removed; - changes.changed <- change_info.changed; - changes.unchanged <- change_info.unchanged; - changes.exclude_from_rel_destab <- change_info.exclude_from_rel_destab + let findChanges ?(matchVars=true) ?(matchFuns=true) ?(renameDetection=false) oldMap newMap cfgs name gc_new (change_info, final_matches) = + try + let gc_old = GlobalMap.find name oldMap in + eq ~matchVars ~matchFuns ~renameDetection oldMap newMap cfgs gc_old gc_new (change_info, final_matches) + with Not_found -> + if not renameDetection then + change_info.added <- gc_new::change_info.added; (* Global could not be found in old map -> added *) + change_info, final_matches in + if GobConfig.get_bool "incremental.detect-renames" then ( + let _ = + (changes, (VarinfoMap.empty, VarinfoMap.empty)) (* change_info and final_matches (bi-directional) is propagated *) + |> GlobalMap.fold (findChanges ~matchVars:true ~matchFuns:false ~renameDetection:true oldMap newMap cfgs) newMap + |> GlobalMap.fold (findChanges ~matchVars:false ~matchFuns:true ~renameDetection:true oldMap newMap cfgs) newMap + |> GlobalMap.fold addNewGlobals newMap + |> GlobalMap.fold addOldGlobals oldMap in + + () ) else ( - let findChanges map name current_global = - try - let old_global = GlobalMap.find name map in - let change_status, diff = eq old_global current_global cfgs in - let append_to_changed ~unchangedHeader = - changes.changed <- {current = current_global; old = old_global; unchangedHeader; diff} :: changes.changed - in - match change_status with - | Changed -> - append_to_changed ~unchangedHeader:true - | Unchanged -> changes.unchanged <- {current = current_global; old = old_global} :: changes.unchanged - | ChangedFunHeader f - | ForceReanalyze f -> - changes.exclude_from_rel_destab <- VarinfoSet.add f.svar changes.exclude_from_rel_destab; - append_to_changed ~unchangedHeader:false - with Not_found -> changes.added <- current_global::changes.added (* Global could not be found in old map -> added *) - in - - (* For each function in the new file, check whether a function with the same name - already existed in the old version, and whether it is the same function. *) - GlobalMap.iter (fun name glob_col -> findChanges oldMap name glob_col) newMap; - GlobalMap.iter (fun name glob -> if not (GlobalMap.mem name newMap) then changes.removed <- (glob::changes.removed)) oldMap; + let _ = + (changes, (VarinfoMap.empty, VarinfoMap.empty)) (* change_info and final_matches (bi-directional) is propagated *) + |> GlobalMap.fold (findChanges oldMap newMap cfgs) newMap + |> GlobalMap.fold addOldGlobals oldMap in + () ); changes diff --git a/src/util/server.ml b/src/util/server.ml index 3dd2adf52d..7905acb1f0 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -1,6 +1,7 @@ open Batteries open Jsonrpc open GoblintCil +include CompareCIL type t = { mutable file: Cil.file option; @@ -157,16 +158,18 @@ let reparse (s: t) = (* Only called when the file has not been reparsed, so we can skip the expensive CFG comparison. *) let virtual_changes file = - let eq (glob: CompareCIL.global_col) _ _ = match glob.def with - | Some (Fun fdec) when CompareCIL.should_reanalyze fdec -> CompareCIL.ForceReanalyze fdec, None - | _ -> Unchanged, None + let eq ?(matchVars=true) ?(matchFuns=true) ?(renameDetection=false) _ _ _ gc_old (gc_new: global_col) (change_info, final_matches) = (match gc_new.def with + | Some (Fun fdec) when should_reanalyze fdec -> + change_info.exclude_from_rel_destab <- VarinfoSet.add fdec.svar change_info.exclude_from_rel_destab + | _ -> change_info.unchanged <- {old = gc_old; current= gc_new} :: change_info.unchanged); + change_info, final_matches in - CompareCIL.compareCilFiles ~eq file file + compareCilFiles ~eq file file let increment_data (s: t) file reparsed = match Serialize.Cache.get_opt_data SolverData with | Some solver_data when reparsed -> let s_file = Option.get s.file in - let changes = CompareCIL.compareCilFiles s_file file in + let changes = compareCilFiles s_file file in s.max_ids <- UpdateCil.update_ids s_file s.max_ids file changes; (* TODO: get globals for restarting from config *) Some { server = true; Analyses.changes; solver_data; restarting = [] }, false From 6ba71fc9a44d593a76b259ac2b6b0a6a209cc899 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 13 Mar 2023 20:09:53 +0100 Subject: [PATCH 101/518] make semgrep happy --- src/incremental/compareCIL.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 1be02b44d6..f210647aa0 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -133,7 +133,7 @@ let eqF (old: Cil.fundec) (current: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) opti let add_locals_to_rename_mapping la lb map = try - List.fold_left (fun map (a, b) -> StringMap.add a.vname b.vname map) map (List.combine la lb) + List.fold_left2 (fun map a b -> StringMap.add a.vname b.vname map) map la lb with Invalid_argument _ -> map in let parameterMapping = add_locals_to_rename_mapping old.sformals current.sformals StringMap.empty in From aeaf301216a692ec2d3180efde3dae888cb19161 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 23 Mar 2023 10:54:25 +0100 Subject: [PATCH 102/518] add incremental cram tests to CI --- .github/workflows/locked.yml | 3 +++ .github/workflows/unlocked.yml | 6 ++++++ 2 files changed, 9 insertions(+) diff --git a/.github/workflows/locked.yml b/.github/workflows/locked.yml index 685fdc0afd..fe2cbe4955 100644 --- a/.github/workflows/locked.yml +++ b/.github/workflows/locked.yml @@ -64,6 +64,9 @@ jobs: - name: Test regression cram run: opam exec -- dune runtest tests/regression + - name: Test incremental cram + run: opam exec -- dune runtest tests/incremental + - name: Test unit run: opam exec -- dune runtest unittest diff --git a/.github/workflows/unlocked.yml b/.github/workflows/unlocked.yml index 5455bb0cb7..2bec6b72fb 100644 --- a/.github/workflows/unlocked.yml +++ b/.github/workflows/unlocked.yml @@ -94,6 +94,9 @@ jobs: - name: Test regression cram run: opam exec -- dune runtest tests/regression + - name: Test incremental cram + run: opam exec -- dune runtest tests/incremental + - name: Test unit run: opam exec -- dune runtest unittest @@ -179,6 +182,9 @@ jobs: - name: Test regression cram run: opam exec -- dune runtest tests/regression + - name: Test incremental cram + run: opam exec -- dune runtest tests/incremental + - name: Test unit run: opam exec -- dune runtest unittest From 033555adc3c58c7a46a6a1869a4730f26447c845 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 23 Mar 2023 14:01:20 +0100 Subject: [PATCH 103/518] refine implementation based on review comments --- src/framework/constraints.ml | 2 +- src/incremental/compareAST.ml | 44 ++++++++++--------- src/incremental/compareCFG.ml | 6 +-- src/util/server.ml | 11 +++-- .../04-var-rename/01-rename_and_shuffle.t | 5 --- .../04-var-rename/02-rename_with_usage.t | 5 --- .../04-var-rename/04-renamed_param.t | 5 --- .../05-renamed_param_usage_changed.t | 5 --- .../05-method-rename/00-simple_rename.t | 5 --- .../05-method-rename/01-dependent_rename.t | 5 --- .../02-cyclic_rename_dependency.t | 5 --- .../05-method-rename/03-cyclic_with_swap.t | 5 --- .../05-method-rename/04-deep_change.t | 5 --- .../05-method-rename/05-common_rename.t | 5 --- .../05-method-rename/06-recursive_rename.t | 5 --- .../06-glob-var-rename/00-simple_rename.t | 5 --- .../01-duplicate_local_global.t | 5 --- .../06-glob-var-rename/02-add_new_gvar.t | 5 --- 18 files changed, 33 insertions(+), 100 deletions(-) diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index aeb13d0b5b..3c734e9694 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -827,7 +827,7 @@ struct | Some {changes; _} -> changes | None -> empty_change_info () in - List.(Printf.printf "change_info = { unchanged = %d; changed = %d (with unchangedHeader = %d); added = %d; removed = %d }\n" (length c.unchanged) (length c.changed) (length (List.filter (fun c -> c.unchangedHeader) c.changed)) (length c.added) (length c.removed)); + List.(Printf.printf "change_info = { unchanged = %d; changed = %d (with unchangedHeader = %d); added = %d; removed = %d }\n" (length c.unchanged) (length c.changed) (BatList.count_matching (fun c -> c.unchangedHeader) c.changed) (length c.added) (length c.removed)); let changed_funs = List.filter_map (function | {old = {def = Some (Fun f); _}; diff = None; _} -> diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 193d98c753..006c5eadb1 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -3,18 +3,25 @@ open CilMaps module StringMap = Map.Make(String) +(* Mapping with rename assumptions about functions collected during the comparison. An assumption means that the + comparison result so far is only correct, if the varinfos of a key-value pair in the mapping represent the same but + renamed function. It is a mapping from a varinfo in the old version to one in the new version. *) type method_rename_assumptions = varinfo VarinfoMap.t + +(* Similiarly to method_rename_assumptions, just that rename assumptions about global variables are collected. *) type glob_var_rename_assumptions = varinfo VarinfoMap.t -(*On a successful match, these compinfo and enuminfo names have to be set to the snd element of the tuple. *) +(* On a successful match, these compinfo and enuminfo names have to be set to the snd element of the tuple. *) type renamesOnSuccess = (compinfo * compinfo) list * (enuminfo * enuminfo) list -(*rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions.*) +(* The rename_mapping is carried through the stack when comparing the AST. Holds a list of rename assumptions. The first + component is a map of rename assumptions about locals, i.e., parameters and local variables and is only used when + comparing functions. *) type rename_mapping = (string StringMap.t) * method_rename_assumptions * glob_var_rename_assumptions * renamesOnSuccess -(*Compares two names, being aware of the rename_mapping. Returns true iff: - 1. there is a rename for name1 -> name2 = rename(name1) - 2. there is no rename for name1 -> name1 = name2*) +(* Compares two names, being aware of the rename_mapping. Returns true iff: + 1. there is a rename for name1 -> name2 = rename(name1) + 2. there is no rename for name1 -> name1 = name2 *) let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename_mapping: rename_mapping) = if GobConfig.get_bool "incremental.detect-renames" then ( let (local_c, method_c, _, _) = rename_mapping in @@ -24,13 +31,13 @@ let rename_mapping_aware_name_comparison (name1: string) (name2: string) (rename | Some now -> now = name2 | None -> - name1 = name2 (*Var names differ, but there is no assumption, so this can't be good*) + name1 = name2 (* Var names differ, but there is no assumption, so this can't be good *) ) else name1 = name2 -(*Creates the mapping of local renames. If the locals do not match in size, an empty mapping is returned.*) +(* Creates the mapping of local renames. If the locals do not match in size, an empty mapping is returned. *) let create_locals_rename_mapping (originalLocalNames: string list) (updatedLocalNames: string list): string StringMap.t = - if (List.length originalLocalNames) = (List.length updatedLocalNames) then + if List.compare_lengths originalLocalNames updatedLocalNames = 0 then List.combine originalLocalNames updatedLocalNames |> List.filter (fun (original, now) -> not (original = now)) |> List.map (fun (original, now) -> (original, now)) |> @@ -43,18 +50,18 @@ let is_rename_mapping_empty (rename_mapping: rename_mapping) = let local, methods, glob_vars, _= rename_mapping in StringMap.is_empty local && VarinfoMap.is_empty methods && VarinfoMap.is_empty glob_vars -(*rename mapping forward propagation, takes the result from a call and propagates the rename mapping to the next call. - the second call is only executed if the previous call returned true*) +(* rename mapping forward propagation, takes the result from a call and propagates the rename mapping to the next call. + the second call is only executed if the previous call returned true *) let (&&>>) (prev_result: bool * rename_mapping) f : bool * rename_mapping = let (prev_equal, updated_rename_mapping) = prev_result in if prev_equal then f ~rename_mapping:updated_rename_mapping else false, updated_rename_mapping -(*Same as && but propagates the rename mapping*) +(* Same as && but propagates the rename mapping *) let (&&>) (prev_result: bool * rename_mapping) (b: bool) : bool * rename_mapping = let (prev_equal, rename_mapping) = prev_result in (prev_equal && b, rename_mapping) -(*Same as Goblist.eq but propagates the rename_mapping*) +(* Same as Goblist.eq but propagates the rename_mapping *) let forward_list_equal ?(propF = (&&>>)) f l1 l2 ~(rename_mapping: rename_mapping) : bool * rename_mapping = if ((List.compare_lengths l1 l2) = 0) then List.fold_left2 (fun (b, r) x y -> propF (b, r) (f x y)) (true, rename_mapping) l1 l2 @@ -107,8 +114,8 @@ and pretty_length () l = Pretty.num (List.length l) and eq_typ_acc ?(fun_parameter_name_comparison_enabled: bool = true) (a: typ) (b: typ) ~(rename_mapping: rename_mapping) ~(acc: (typ * typ) list) : bool * rename_mapping = (* Registers a compinfo rename or a enum rename*) let register_rename_on_success = fun rename_mapping compinfo_option enum_option -> - let maybeAddTuple = fun list option -> - Option.value ~default:list (Option.bind option (fun elem -> Some(elem :: list))) + let maybeAddTuple list option = + BatOption.map_default (fun v -> v :: list) list option in let (a, b, c, renames_on_success) = rename_mapping in @@ -127,7 +134,7 @@ and eq_typ_acc ?(fun_parameter_name_comparison_enabled: bool = true) (a: typ) (b | TArray (typ1, None, attr1), TArray (typ2, None, attr2) -> eq_typ_acc typ1 typ2 ~rename_mapping ~acc &&>> forward_list_equal (eq_attribute ~acc) attr1 attr2 | TFun (typ1, (Some list1), varArg1, attr1), TFun (typ2, (Some list2), varArg2, attr2) -> eq_typ_acc typ1 typ2 ~rename_mapping ~acc &&>> - forward_list_equal (eq_args ~fun_parameter_name_comparison_enabled:fun_parameter_name_comparison_enabled ~acc) list1 list2 &&> + forward_list_equal (eq_args ~fun_parameter_name_comparison_enabled ~acc) list1 list2 &&> (varArg1 = varArg2) &&>> forward_list_equal (eq_attribute ~acc) attr1 attr2 | TFun (typ1, None, varArg1, attr1), TFun (typ2, None, varArg2, attr2) -> @@ -237,10 +244,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) ~(acc: (typ * typ) list) ~(rename_mappi true, VarinfoMap.add a b method_rename_mappings, glob_vars else true, method_rename_mappings, glob_vars ) - | TInt (_, _), TInt (_, _) -> compare_local_and_global_var - | TFloat (_, _), TFloat (_, _) -> compare_local_and_global_var - | TPtr (_, _), TPtr(_, _) -> compare_local_and_global_var - | _, _ -> rename_mapping_aware_name_comparison a.vname b.vname rename_mapping, method_rename_mappings, glob_vars + | _, _ -> compare_local_and_global_var in (*If the following is a method call, we need to check if we have a mapping for that method call. *) @@ -250,7 +254,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) ~(acc: (typ * typ) list) ~(rename_mappi in (*Ignore rename mapping for type check, as it doesn't change anyway. We only need the renames_on_success*) - let (typeCheck, (_, _, _, updated_renames_on_success)) = eq_typ_acc ~fun_parameter_name_comparison_enabled:fun_parameter_name_comparison_enabled a.vtype b.vtype ~rename_mapping:(StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, renames_on_success) ~acc in + let (typeCheck, (_, _, _, updated_renames_on_success)) = eq_typ_acc ~fun_parameter_name_comparison_enabled a.vtype b.vtype ~rename_mapping:(StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, renames_on_success) ~acc in (isNamingOk && typeCheck, (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping, updated_renames_on_success)) &&>> forward_list_equal (eq_attribute ~acc ) a.vattr b.vattr &&> diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 0c23edea9e..dff0867b40 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -63,7 +63,7 @@ let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 f let same = {node1to2=NH.create 113; node2to1=NH.create 113} in let waitingList : (node * node) t = Queue.create () in - let rec compareNext () rename_mapping : rename_mapping = + let rec compareNext rename_mapping : rename_mapping = if Queue.is_empty waitingList then rename_mapping else let fromNode1, fromNode2 = Queue.take waitingList in @@ -104,14 +104,14 @@ let compareCfgs (module CfgOld : CfgForward) (module CfgNew : CfgForward) fun1 f if posAmbigEdge edgeList1 then (NH.replace diff toNode1 (); rename_mapping) else findMatch (edgeList1, toNode1) rename_mapping in let updatedRenameMapping = List.fold_left (fun rm e -> iterOuts e rm) rename_mapping outList1 in - compareNext () updatedRenameMapping + compareNext updatedRenameMapping in let entryNode1, entryNode2 = (FunctionEntry fun1, FunctionEntry fun2) in NH.replace same.node1to2 entryNode1 entryNode2; NH.replace same.node2to1 entryNode2 entryNode1; Queue.push (entryNode1,entryNode2) waitingList; - let updatedRenameMapping = compareNext () rename_mapping in + let updatedRenameMapping = compareNext rename_mapping in same, diff, updatedRenameMapping (* This is the second phase of the CFG comparison of functions. It removes the nodes from the matching node set 'same' diff --git a/src/util/server.ml b/src/util/server.ml index 7905acb1f0..6c6901cf0f 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -1,7 +1,6 @@ open Batteries open Jsonrpc open GoblintCil -include CompareCIL type t = { mutable file: Cil.file option; @@ -158,18 +157,18 @@ let reparse (s: t) = (* Only called when the file has not been reparsed, so we can skip the expensive CFG comparison. *) let virtual_changes file = - let eq ?(matchVars=true) ?(matchFuns=true) ?(renameDetection=false) _ _ _ gc_old (gc_new: global_col) (change_info, final_matches) = (match gc_new.def with - | Some (Fun fdec) when should_reanalyze fdec -> - change_info.exclude_from_rel_destab <- VarinfoSet.add fdec.svar change_info.exclude_from_rel_destab + let eq ?(matchVars=true) ?(matchFuns=true) ?(renameDetection=false) _ _ _ gc_old (gc_new: CompareCIL.global_col) ((change_info : CompareCIL.change_info), final_matches) = (match gc_new.def with + | Some (Fun fdec) when CompareCIL.should_reanalyze fdec -> + change_info.exclude_from_rel_destab <- CompareCIL.VarinfoSet.add fdec.svar change_info.exclude_from_rel_destab | _ -> change_info.unchanged <- {old = gc_old; current= gc_new} :: change_info.unchanged); change_info, final_matches in - compareCilFiles ~eq file file + CompareCIL.compareCilFiles ~eq file file let increment_data (s: t) file reparsed = match Serialize.Cache.get_opt_data SolverData with | Some solver_data when reparsed -> let s_file = Option.get s.file in - let changes = compareCilFiles s_file file in + let changes = CompareCIL.compareCilFiles s_file file in s.max_ids <- UpdateCil.update_ids s_file s.max_ids file changes; (* TODO: get globals for restarting from config *) Some { server = true; Analyses.changes; solver_data; restarting = [] }, false diff --git a/tests/incremental/04-var-rename/01-rename_and_shuffle.t b/tests/incremental/04-var-rename/01-rename_and_shuffle.t index 5cfb03eb54..8f3b57f797 100644 --- a/tests/incremental/04-var-rename/01-rename_and_shuffle.t +++ b/tests/incremental/04-var-rename/01-rename_and_shuffle.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 01-rename_and_shuffle.json --enable incremental.load 01-rename_and_shuffle.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <01-rename_and_shuffle.patch - patching file 01-rename_and_shuffle.c diff --git a/tests/incremental/04-var-rename/02-rename_with_usage.t b/tests/incremental/04-var-rename/02-rename_with_usage.t index 2abea2988f..1e2818ed4d 100644 --- a/tests/incremental/04-var-rename/02-rename_with_usage.t +++ b/tests/incremental/04-var-rename/02-rename_with_usage.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 02-rename_with_usage.json --enable incremental.load 02-rename_with_usage.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <02-rename_with_usage.patch - patching file 02-rename_with_usage.c diff --git a/tests/incremental/04-var-rename/04-renamed_param.t b/tests/incremental/04-var-rename/04-renamed_param.t index ed13d38fd7..9da6d5e888 100644 --- a/tests/incremental/04-var-rename/04-renamed_param.t +++ b/tests/incremental/04-var-rename/04-renamed_param.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 04-renamed_param.json --enable incremental.load 04-renamed_param.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <04-renamed_param.patch - patching file 04-renamed_param.c diff --git a/tests/incremental/04-var-rename/05-renamed_param_usage_changed.t b/tests/incremental/04-var-rename/05-renamed_param_usage_changed.t index 7f23cd649f..a465b2b6f2 100644 --- a/tests/incremental/04-var-rename/05-renamed_param_usage_changed.t +++ b/tests/incremental/04-var-rename/05-renamed_param_usage_changed.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 05-renamed_param_usage_changed.json --enable incremental.load 05-renamed_param_usage_changed.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <05-renamed_param_usage_changed.patch - patching file 05-renamed_param_usage_changed.c diff --git a/tests/incremental/05-method-rename/00-simple_rename.t b/tests/incremental/05-method-rename/00-simple_rename.t index 59a1cfa469..1855b903eb 100644 --- a/tests/incremental/05-method-rename/00-simple_rename.t +++ b/tests/incremental/05-method-rename/00-simple_rename.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 00-simple_rename.json --enable incremental.load 00-simple_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <00-simple_rename.patch - patching file 00-simple_rename.c diff --git a/tests/incremental/05-method-rename/01-dependent_rename.t b/tests/incremental/05-method-rename/01-dependent_rename.t index 75c5797c2a..bb0628447b 100644 --- a/tests/incremental/05-method-rename/01-dependent_rename.t +++ b/tests/incremental/05-method-rename/01-dependent_rename.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 01-dependent_rename.json --enable incremental.load 01-dependent_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 1 (with unchangedHeader = 1); added = 2; removed = 2 - -Revert patch - - $ patch -b -R <01-dependent_rename.patch - patching file 01-dependent_rename.c diff --git a/tests/incremental/05-method-rename/02-cyclic_rename_dependency.t b/tests/incremental/05-method-rename/02-cyclic_rename_dependency.t index 0d706cf320..de9aa48e6c 100644 --- a/tests/incremental/05-method-rename/02-cyclic_rename_dependency.t +++ b/tests/incremental/05-method-rename/02-cyclic_rename_dependency.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 02-cyclic_rename_dependency.json --enable incremental.load 02-cyclic_rename_dependency.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 1 (with unchangedHeader = 1); added = 2; removed = 2 - -Revert patch - - $ patch -b -R <02-cyclic_rename_dependency.patch - patching file 02-cyclic_rename_dependency.c diff --git a/tests/incremental/05-method-rename/03-cyclic_with_swap.t b/tests/incremental/05-method-rename/03-cyclic_with_swap.t index 8bed0df5e9..d2e8dd6d97 100644 --- a/tests/incremental/05-method-rename/03-cyclic_with_swap.t +++ b/tests/incremental/05-method-rename/03-cyclic_with_swap.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 03-cyclic_with_swap.json --enable incremental.load 03-cyclic_with_swap.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 1 (with unchangedHeader = 1); added = 3; removed = 2 - -Revert patch - - $ patch -b -R <03-cyclic_with_swap.patch - patching file 03-cyclic_with_swap.c diff --git a/tests/incremental/05-method-rename/04-deep_change.t b/tests/incremental/05-method-rename/04-deep_change.t index 3ac9ac649c..1adcb56276 100644 --- a/tests/incremental/05-method-rename/04-deep_change.t +++ b/tests/incremental/05-method-rename/04-deep_change.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 04-deep_change.json --enable incremental.load 04-deep_change.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 1 (with unchangedHeader = 1); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <04-deep_change.patch - patching file 04-deep_change.c diff --git a/tests/incremental/05-method-rename/05-common_rename.t b/tests/incremental/05-method-rename/05-common_rename.t index faa7ae9f7f..62e99c6c80 100644 --- a/tests/incremental/05-method-rename/05-common_rename.t +++ b/tests/incremental/05-method-rename/05-common_rename.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 05-common_rename.json --enable incremental.load 05-common_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <05-common_rename.patch - patching file 05-common_rename.c diff --git a/tests/incremental/05-method-rename/06-recursive_rename.t b/tests/incremental/05-method-rename/06-recursive_rename.t index b7d0fabe3e..dce0894ff1 100644 --- a/tests/incremental/05-method-rename/06-recursive_rename.t +++ b/tests/incremental/05-method-rename/06-recursive_rename.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 06-recursive_rename.json --enable incremental.load 06-recursive_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <06-recursive_rename.patch - patching file 06-recursive_rename.c diff --git a/tests/incremental/06-glob-var-rename/00-simple_rename.t b/tests/incremental/06-glob-var-rename/00-simple_rename.t index 59a1cfa469..1855b903eb 100644 --- a/tests/incremental/06-glob-var-rename/00-simple_rename.t +++ b/tests/incremental/06-glob-var-rename/00-simple_rename.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 00-simple_rename.json --enable incremental.load 00-simple_rename.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <00-simple_rename.patch - patching file 00-simple_rename.c diff --git a/tests/incremental/06-glob-var-rename/01-duplicate_local_global.t b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.t index b1b73f4f26..cd2c5c0fea 100644 --- a/tests/incremental/06-glob-var-rename/01-duplicate_local_global.t +++ b/tests/incremental/06-glob-var-rename/01-duplicate_local_global.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 01-duplicate_local_global.json --enable incremental.load 01-duplicate_local_global.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 0 (with unchangedHeader = 0); added = 0; removed = 0 - -Revert patch - - $ patch -b -R <01-duplicate_local_global.patch - patching file 01-duplicate_local_global.c diff --git a/tests/incremental/06-glob-var-rename/02-add_new_gvar.t b/tests/incremental/06-glob-var-rename/02-add_new_gvar.t index 8450df2d47..c71cd6808f 100644 --- a/tests/incremental/06-glob-var-rename/02-add_new_gvar.t +++ b/tests/incremental/06-glob-var-rename/02-add_new_gvar.t @@ -12,8 +12,3 @@ Run Goblint incrementally on new program version and check the change detection $ goblint --conf 02-add_new_gvar.json --enable incremental.load 02-add_new_gvar.c | grep 'change_info' | sed -r 's/^change_info = \{ unchanged = [[:digit:]]+; (.*) \}$/\1/' changed = 1 (with unchangedHeader = 1); added = 1; removed = 0 - -Revert patch - - $ patch -b -R <02-add_new_gvar.patch - patching file 02-add_new_gvar.c From e293a7f09e8e043b8209b6653412508039efd426 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 23 Mar 2023 15:28:03 +0100 Subject: [PATCH 104/518] missing propagation of change_info and final_matches --- src/incremental/compareCIL.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index f210647aa0..10cf6361a3 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -190,7 +190,7 @@ let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old (* for rename detection, check whether the rename assumptions collected during the function comparison actually match exactly, otherwise check that the function comparison was successful without collecting any rename assumptions *) - let dependenciesMatch = + let dependenciesMatch, change_info, final_matches = if renameDetection then let funDependenciesMatch, change_info, final_matches = let extract_globs _ gc map = @@ -199,7 +199,7 @@ let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> - match VarinfoMap.find_opt f_old_var (fst final_matches) with + match VarinfoMap.find_opt f_old_var (fst fm) with | None -> let f_old = get_fundec (VarinfoMap.find f_old_var var_glob_old) in let f_new = get_fundec (VarinfoMap.find f_new_var var_glob_new) in (* TODO: what happens if there exists no fundec for this varinfo? *) @@ -208,16 +208,16 @@ let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old else false, ci, fm | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> - match VarinfoMap.find_opt old_var (fst final_matches) with + match VarinfoMap.find_opt old_var (fst fm) with | None -> if acc then compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm else false, ci, fm | Some v -> v = new_var, ci, fm ) global_var_dependencies (true, change_info, final_matches) in - funDependenciesMatch && globalDependenciesMatch + funDependenciesMatch && globalDependenciesMatch, change_info, final_matches else - empty_rename_assms function_dependencies && empty_rename_assms global_var_dependencies in + empty_rename_assms function_dependencies && empty_rename_assms global_var_dependencies, change_info, final_matches in let append_to_changed ~unchangedHeader ~diff = change_info.changed <- {current = gc_new; old = gc_old; unchangedHeader; diff} :: change_info.changed From e8ce672697664b72023b2cf0bb20730fea54c9a6 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 23 Mar 2023 15:31:12 +0100 Subject: [PATCH 105/518] remove test script because of restricted parser and few working cases --- scripts/test-refactorings-rename.py | 450 ---------------------------- 1 file changed, 450 deletions(-) delete mode 100644 scripts/test-refactorings-rename.py diff --git a/scripts/test-refactorings-rename.py b/scripts/test-refactorings-rename.py deleted file mode 100644 index 4339113eac..0000000000 --- a/scripts/test-refactorings-rename.py +++ /dev/null @@ -1,450 +0,0 @@ -#!/usr/bin/python -import dataclasses -import os -import pathlib -import re -import shutil -import subprocess -import sys -import tempfile -from os.path import isdir -from pathlib import Path -from pycparser import c_ast, c_parser, parse_file -from pycparser.c_ast import TypeDecl, ArrayDecl, PtrDecl, IdentifierType -from pycparser.c_generator import CGenerator - -parser_errors = 0 -struct_occurrences = 0 -skips = 0 -includes = 0 -includes_only_assert = 0 -invalid_solver = 0 -introduced_changes = 0 -renamed_a_function = 0 - -# to support library headers, first clone https://github.com/eliben/pycparser to the directory next of the analyzer folder. -# Then comment the lines out and in that are described that way. - -def main(): - regression_folder = Path("./tests/regression") - - task = TaskRenameLocals(False) - - test = regression_folder / "25-vla/02-loop.c" - execute_validation_test(test.parent, test, task) - return - - excluded = [ - "44-trier_analyzer/33-recA.c", - # Even though the same file is read in, the type of rec#i differes from int * to int?! - "04-mutex/53-kernel-spinlock.c", # Kernel is broken. - "56-witness/01-base-lor-enums.c", # 0evals? - "56-witness/02-base-lor-addr.c", # 0evals? - "56-witness/03-int-log-short.c", # 0evals? - "56-witness/04-base-priv-sync-prune.c", # 0evals? - "44-trier_analyzer/09-G1.c", # Also renamed glob var - "44-trier_analyzer/21-Pproc.c" # renamed function. - ] - - # folder = regression_folder / "07-uninit" - # for testFile in folder.iterdir(): - # filename, extension = os.path.splitext(testFile.name) - # identifier = f"{folder.name}/{testFile.name}" - # - # if extension == ".c" and not (identifier in excluded): - # execute_validation_test(folder, testFile) - - total_tests = 0 - executed_tests = 0 - - for folder in regression_folder.iterdir(): - if isdir(folder): - for testFile in folder.iterdir(): - filename, extension = os.path.splitext(testFile.name) - if extension == ".c" and not (f"{folder.name}/{testFile.name}" in excluded): - total_tests += 1 - if execute_validation_test(folder, testFile, task): - executed_tests += 1 - - global introduced_changes - global renamed_a_function - - print(f"Executed {executed_tests}/{total_tests}") - if isinstance(task, TaskRenameLocals) and task.introduce_changes: - print(f"Introduced changes in {introduced_changes}/{executed_tests}") - - if isinstance(task, TaskRenameFunction): - print(f"Renamed a function in {renamed_a_function}/{executed_tests}") - - global parser_errors - global struct_occurrences - global skips - global includes - global invalid_solver - global includes_only_assert - - print("Skipped due tue:") - print("Parser errors: " + str(parser_errors)) - print("Struct occurrences: " + str(struct_occurrences)) - print("Skips (//Skip): " + str(skips)) - print(f"Includes: {includes}, of those only assert: {includes_only_assert}") - print("Invalid solver: " + str(invalid_solver)) - - -def execute_validation_test(folder: Path, test_file: Path, task): - print(f"Executing test: {folder.name}/{test_file.name}") - - global parser_errors - global struct_occurrences - global skips - global includes - global invalid_solver - global includes_only_assert - global introduced_changes - global renamed_a_function - - extra_params = "" - - with open(test_file, "r") as filehandle: - lines = filehandle.readlines() - if lines[0].startswith("// PARAM:"): - extra_params = lines[0][len("// PARAM:"):-1] - if lines[0].startswith("// SKIP"): - print("Skipped test.") - skips += 1 - return False - # comment this if out if you want to support library headers - if any(x.startswith("#include") for x in lines): - print("Skipped test because of include") - includes += 1 - - include_lines = [x for x in lines if x.startswith("#include")] - - if all("assert.h" in x for x in include_lines): - includes_only_assert += 1 - - return False - if any("struct" in x for x in lines): - print("Skipped because struct") - struct_occurrences += 1 - return False - - if "slr3" in extra_params or "slr4" in extra_params: - print("Aborted test due to invalid solver.") - invalid_solver += 1 - return False - - modified_file_result = create_modified_file(test_file, task) - - if modified_file_result is None: - print("Aborted test due to parsing error.") - parser_errors += 1 - return False - - base = "./" - - args = f"--enable dbg.debug --enable printstats -v {extra_params}" - - # uncomment to support library headers. - # with tempfile.NamedTemporaryFile() as t: - # subprocess.run(f"cpp -E -I../pycparser/utils/fake_libc_include {test_file} > {t.name}", shell=True) - # - # - # x = subprocess.run(f"./goblint {args} --enable incremental.save {t.name}", shell=True, text=True, capture_output=True) - # if x.returncode != 0: - # includes += 1 - # return False - - subprocess.run(f"./goblint {args} --enable incremental.save {test_file}", shell=True, capture_output=True) - - command = subprocess.run( - f"./goblint {args} --enable incremental.load --set save_run {base}/{test_file}-incrementalrun {modified_file_result.tmp.name}", - shell=True, text=True, capture_output=True) - - found_line = False - - for line in command.stdout.splitlines(): - if line.startswith("change_info = "): - match = re.search("; changed = (\d+)", line) - change_count = int(match.group(1)) - - if modified_file_result.introduced_changes: - invalid_change_count = change_count == 0 - expected = "> 0" - else: - invalid_change_count = change_count != 0 - expected = "= 0" - - if invalid_change_count != 0: - print("-----------------------------------------------------------------") - print(command.stdout) - print("-----------------------------------------------------------------") - print(f"Invalid change count={change_count}. Expected {expected}.") - cleanup(folder, test_file, modified_file_result.tmp) - sys.exit(-1) - found_line = True - break - - if not found_line: - print("Could not find line with change count.") - print(command.stdout) - cleanup(folder, test_file, modified_file_result.tmp) - sys.exit(-1) - - if modified_file_result.introduced_changes: - introduced_changes += 1 - - if modified_file_result.renamed_anything and isinstance(task, TaskRenameFunction): - renamed_a_function += 1 - - cleanup(folder, test_file, modified_file_result.tmp) - - return True - - -def cleanup(folder: Path, test: Path, updated_file): - updated_file.close() - shutil.rmtree(folder / f"{test.name}-incrementalrun") - - -def find_local_vars(node, on_node_found): - if node.body.block_items is not None: - for child in node.body.block_items: - if isinstance(child, c_ast.Decl): - if isinstance(child.type, c_ast.TypeDecl) or isinstance(child.type, c_ast.ArrayDecl): - on_node_found(child) - - -def rename_decl(node, new_name): - if isinstance(node.type, TypeDecl) or isinstance(node.type, ArrayDecl) or isinstance(node.type, PtrDecl): - node.name = new_name - if isinstance(node.type, TypeDecl): - node.type.declname = new_name - if isinstance(node.type, ArrayDecl): - node.type.type.declname = new_name - if isinstance(node.type, PtrDecl): - node.type.type.declname = new_name - -def visit_rest_of_func_def(self, node): - self.visit(node.decl) - if node.param_decls is not None: - self.visit(node.param_decls) - - self.visit(node.body) - -class VarDeclVisitor(c_ast.NodeVisitor): - - def __init__(self): - self.local_variables = {} - self.function_params = {} - - def visit_FuncDef(self, node): - lv = [] - fp = [] - - find_local_vars(node, lambda f: lv.append(f.name)) - if isinstance(node.decl, c_ast.Decl) and isinstance(node.decl.type, c_ast.FuncDecl): - func_decl = node.decl.type - if isinstance(func_decl.args, c_ast.ParamList): - for arg in func_decl.args.params: - if isinstance(arg, c_ast.Decl): - fp.append(arg.name) - - self.local_variables[node.decl.name] = lv - self.function_params[node.decl.name] = fp - - -class RenameVariableVisitor(c_ast.NodeVisitor): - - def __init__(self, rename_mapping): - self.map = rename_mapping - - def visit_ID(self, node): - if node.name in self.map: - node.name = self.map[node.name] - - def visit_Decl(self, node): - if node.name in self.map: - rename_decl(node, self.map[node.name]) - - if node.init is not None: - self.visit(node.init) - - self.visit(node.type) - - -class IntroduceSemanticChangeVisitor(c_ast.NodeVisitor): - - # legal_local_variables: Only these variables may be used to introduce a change - def __init__(self, legal_local_variables): - self.in_fun = False - self.fun_name = None - - self.introduced_change = False - self.found_vars = [] - self.introduced_changes = [] - self.legal_local_variables = legal_local_variables - - def visit_ID(self, node): - if self.in_fun: - if any(found_var for found_var in self.found_vars if found_var.name == node.name): - known_var = [found_var for found_var in self.found_vars if found_var.name == node.name][0] - - # check if we can find another already declared var with the same type - other_decls = [var for var in self.found_vars if - var.type == known_var.type and - var.name != known_var.name and - var.name in self.legal_local_variables[self.fun_name] - ] - - # only introduce change if not already done so for this variable - if len(other_decls) > 0 and known_var.name not in self.introduced_changes: - node.name = other_decls[0].name - self.introduced_change = True - self.introduced_changes.append(known_var.name) - else: - node.name = known_var.name - - - def visit_FuncDef(self, node): - self.in_fun = True - self.fun_name = node.decl.name - self.found_vars = [] - self.introduced_changes = [] - visit_rest_of_func_def(self, node) - self.in_fun = False - self.fun_name = None - - def visit_Decl(self, node): - if self.in_fun and isinstance(node.type, c_ast.TypeDecl) or isinstance(node.type, c_ast.ArrayDecl): - if isinstance(node.type, TypeDecl) and isinstance(node.type.type, IdentifierType): - if len(node.type.type.names) == 1: - self.found_vars.append(LocalVar(node.name, node.type.type.names[0], node.name + "_updated")) - if node.init is not None: - self.visit(node.init) - - self.visit(node.type) - - -# find a single function to rename, but never main -class FindFunctionToRenameVisitor(c_ast.NodeVisitor): - - def __init__(self): - self.fun_name = None - self.updated_fun_name = None - - - def visit_FuncDef(self, node): - fun_name = node.decl.name - if fun_name != "main" and self.fun_name is None: - self.fun_name = fun_name - self.updated_fun_name = fun_name + "_updated" - - -class RenameFunctionVisitor(c_ast.NodeVisitor): - - def __init__(self, function_to_rename_name, updated_name): - self.function_to_rename_name = function_to_rename_name - self.updated_name = updated_name - - def visit_FuncDef(self, node): - fun_name = node.decl.name - if fun_name == self.function_to_rename_name: - node.decl.name = self.updated_name - node.decl.type.type.declname = self.updated_name - - visit_rest_of_func_def(self, node) - - - def visit_ID(self, node): - if node.name == self.function_to_rename_name: - node.name = self.updated_name - - -def create_modified_file(source_file: Path, task): - try: - # uncommet to support library headers. - # gcc = subprocess.run(f"cpp -E -I../pycparser/utils/fake_libc_include {source_file}", shell=True, capture_output=True, text=True) - - # ast = c_parser.CParser().parse(gcc.stdout) - ast = parse_file(source_file, use_cpp=True) - - introduced_change = False - renamed_anything = False - - if isinstance(task, TaskRenameLocals): - v = VarDeclVisitor() - v.visit(ast) - - rename_mapping = {} - local_vars = [x for xs in (list(v.local_variables.values()) + list(v.function_params.values())) for x in xs] - for local_var in local_vars: - rename_mapping[local_var] = local_var + "_updated" - - if task.introduce_changes: - x = IntroduceSemanticChangeVisitor(v.local_variables) - x.visit(ast) - - # print(CGenerator().visit(ast)) - # print("Introduced change:" + str(x.introduced_change)) - - introduced_change = x.introduced_change - else: - introduced_change = False - - RenameVariableVisitor(rename_mapping).visit(ast) - renamed_anything = len(local_vars) > 0 - - if isinstance(task, TaskRenameFunction): - v = FindFunctionToRenameVisitor() - v.visit(ast) - - renamed_anything = v.fun_name is not None - - if v.fun_name is not None: - v = RenameFunctionVisitor(v.fun_name, v.updated_fun_name) - v.visit(ast) - - introduced_change = False - - # print(CGenerator().visit(ast)) - - tmp = tempfile.NamedTemporaryFile() - with open(tmp.name, "w") as f: - f.write(CGenerator().visit(ast)) - - return ModifiedFileResult(tmp, introduced_change, renamed_anything) - except: - return None - - -@dataclasses.dataclass -class ModifiedFileResult: - tmp: tempfile.NamedTemporaryFile - introduced_changes: bool - renamed_anything: bool - - -@dataclasses.dataclass -class LocalVar: - name: str - type: str - new_name: str - - -@dataclasses.dataclass -class TaskRenameLocals: - introduce_changes: bool - - -@dataclasses.dataclass -class TaskRenameFunction: - def __init__(self): - self - - -if __name__ == '__main__': - # result = create_modified_file(Path("scripts/test.c"), TaskRenameFunction()) - # print(result.introduced_changes) - # result.tmp.close() - main() From af79fb2855528663dca6fd95b1d634648fd9f990 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 23 Mar 2023 16:56:14 +0100 Subject: [PATCH 106/518] no structural comparison when looking through collected final_matches --- src/incremental/compareCIL.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 10cf6361a3..a6cd7cb68b 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -206,14 +206,14 @@ let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old if acc then eqF_only_consider_exact_match f_old f_new ci fm oldMap newMap var_glob_old var_glob_new else false, ci, fm - | Some v -> v = f_new_var, ci, fm) function_dependencies (true, change_info, final_matches) in + | Some v -> v.vid = f_new_var.vid, ci, fm) function_dependencies (true, change_info, final_matches) in let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> match VarinfoMap.find_opt old_var (fst fm) with | None -> if acc then compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm else false, ci, fm - | Some v -> v = new_var, ci, fm + | Some v -> v.vid = new_var.vid, ci, fm ) global_var_dependencies (true, change_info, final_matches) in funDependenciesMatch && globalDependenciesMatch, change_info, final_matches else From 7d68cf22035f141ca101afb4349a55445d7b7ace Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 23 Mar 2023 18:01:31 +0100 Subject: [PATCH 107/518] fix check whether already matched as unchanged --- src/incremental/compareAST.ml | 2 +- src/incremental/compareCIL.ml | 36 +++++++++++++++++++---------------- 2 files changed, 21 insertions(+), 17 deletions(-) diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 006c5eadb1..269e90a4d7 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -257,7 +257,7 @@ and eq_varinfo (a: varinfo) (b: varinfo) ~(acc: (typ * typ) list) ~(rename_mappi let (typeCheck, (_, _, _, updated_renames_on_success)) = eq_typ_acc ~fun_parameter_name_comparison_enabled a.vtype b.vtype ~rename_mapping:(StringMap.empty, VarinfoMap.empty, VarinfoMap.empty, renames_on_success) ~acc in (isNamingOk && typeCheck, (locals_renames, updated_method_rename_mappings, updatedGlobVarMapping, updated_renames_on_success)) &&>> - forward_list_equal (eq_attribute ~acc ) a.vattr b.vattr &&> + forward_list_equal (eq_attribute ~acc) a.vattr b.vattr &&> (a.vstorage = b.vstorage) &&> (a.vglob = b.vglob) &&> (a.vaddrof = b.vaddrof) (* Ignore the location, vid, vreferenced, vdescr, vdescrpure, vinline *) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index a6cd7cb68b..6425e12d21 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -192,28 +192,32 @@ let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old otherwise check that the function comparison was successful without collecting any rename assumptions *) let dependenciesMatch, change_info, final_matches = if renameDetection then - let funDependenciesMatch, change_info, final_matches = - let extract_globs _ gc map = - let v = get_varinfo gc in - VarinfoMap.add v gc map in - let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in - let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in - VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> - match VarinfoMap.find_opt f_old_var (fst fm) with - | None -> - let f_old = get_fundec (VarinfoMap.find f_old_var var_glob_old) in - let f_new = get_fundec (VarinfoMap.find f_new_var var_glob_new) in (* TODO: what happens if there exists no fundec for this varinfo? *) - if acc then - eqF_only_consider_exact_match f_old f_new ci fm oldMap newMap var_glob_old var_glob_new - else false, ci, fm - | Some v -> v.vid = f_new_var.vid, ci, fm) function_dependencies (true, change_info, final_matches) in + let extract_globs _ gc map = + let v = get_varinfo gc in + VarinfoMap.add v gc map in + let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in + let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in + let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> + let glob_old = VarinfoMap.find f_old_var var_glob_old in + let glob_new = VarinfoMap.find f_new_var var_glob_new in + match VarinfoMap.find_opt f_old_var (fst fm) with + | None -> + let f_old = get_fundec glob_old in + let f_new = get_fundec glob_new in (* TODO: what happens if there exists no fundec for this varinfo? *) + if acc then + eqF_only_consider_exact_match f_old f_new ci fm oldMap newMap var_glob_old var_glob_new + else false, ci, fm + | Some v -> acc && v.vid = f_new_var.vid && List.mem {old=glob_old; current=glob_new} ci.unchanged, ci, fm + ) function_dependencies (true, change_info, final_matches) in let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> + let glob_old = VarinfoMap.find old_var var_glob_old in + let glob_new = VarinfoMap.find new_var var_glob_new in match VarinfoMap.find_opt old_var (fst fm) with | None -> if acc then compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm else false, ci, fm - | Some v -> v.vid = new_var.vid, ci, fm + | Some v -> acc && v.vid = new_var.vid && List.mem {old=glob_old; current=glob_new} ci.unchanged, ci, fm ) global_var_dependencies (true, change_info, final_matches) in funDependenciesMatch && globalDependenciesMatch, change_info, final_matches else From 53112a0ac95da4c4b3ab841372f6c9d96c9874e7 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 27 Mar 2023 19:48:39 +0200 Subject: [PATCH 108/518] Dynamically lookup constants --- src/cdomains/mutexAttrDomain.ml | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/src/cdomains/mutexAttrDomain.ml b/src/cdomains/mutexAttrDomain.ml index 7396687876..6b57bc69b9 100644 --- a/src/cdomains/mutexAttrDomain.ml +++ b/src/cdomains/mutexAttrDomain.ml @@ -16,11 +16,26 @@ end include Lattice.Flat(MutexKind) (struct let bot_name = "Uninitialized" let top_name = "Top" end) +(* Needed because OS X is weird and assigns different constants than normal systems... :( *) +let recursive_int = lazy ( + let res = ref None in + GoblintCil.iterGlobals !Cilfacade.current_file (function + | GEnumTag (einfo, _) -> + List.iter (fun (name, exp, _) -> + if name = "PTHREAD_MUTEX_RECURSIVE" then + res := GoblintCil.getInteger exp + ) einfo.eitems + | _ -> () + ); + !res +) + let of_int z = if Z.equal z Z.zero then `Lifted MutexKind.NonRec - else if Z.equal z Z.one then - `Lifted MutexKind.Recursive else - `Top + let recursive_int = Lazy.force recursive_int in + match recursive_int with + | Some r when Z.equal z r -> `Lifted MutexKind.Recursive + | _ -> `Top From 99f4261d79c7920f545cd3291a751fb25e453bec Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 27 Mar 2023 19:51:11 +0200 Subject: [PATCH 109/518] Cleanup Co-authored-by: Simmo Saan --- src/analyses/mutexTypeAnalysis.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index b6282d67f3..c709ecca4f 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -19,7 +19,7 @@ struct (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = match lval with - | Var v, Field (f1, Field (f2, NoOffset)) when ValueDomain.Compound.is_mutex_type v.vtype && f1.fname = "__data" && f2.fname = "__kind" -> + | Var v, Field ({fname = "__data"; _}, Field ({fname = "__kind"; _}, NoOffset)) when ValueDomain.Compound.is_mutex_type v.vtype -> let kind = (match Cil.constFold true rval with | Const (CInt (c, _, _)) -> MAttr.of_int c From 792e4ec698dfd02c2e4c5b427d0f6d56ea35472f Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 27 Mar 2023 19:58:43 +0200 Subject: [PATCH 110/518] Make conditions more clear Co-authored-by: Simmo Saan --- src/analyses/mayLocks.ml | 2 +- src/analyses/mutexAnalysis.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 27acd07bbd..fd7b844b4d 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -30,7 +30,7 @@ struct let exitstate v = D.top () (* TODO: why? *) let return ctx exp fundec = - if not @@ D.is_bot ctx.local && ThreadReturn.is_current (Analyses.ask_of_ctx ctx) then M.warn "Exiting thread while still holding a mutex!"; + if not (D.is_bot ctx.local) && ThreadReturn.is_current (Analyses.ask_of_ctx ctx) then M.warn "Exiting thread while still holding a mutex!"; ctx.local let special ctx (lv:lval option) (f: varinfo) (args: exp list) = diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index df6199e8e7..c57dbd5bf4 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -71,7 +71,7 @@ struct D.add l ctx.local let remove ctx l = - if not @@ D.mem (l,true) ctx.local && not @@ D.mem (l,false) ctx.local then M.warn "unlocking mutex which may not be held"; + if not (D.mem (l,true) ctx.local || D.mem (l,false) ctx.local) then M.warn "unlocking mutex which may not be held"; D.remove (l, true) (D.remove (l, false) ctx.local) let remove_all ctx = From 208fcf1e76d3333ed081c160c8c737c56b7bc31d Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 27 Mar 2023 20:01:28 +0200 Subject: [PATCH 111/518] Slim down tests by removing unused code --- tests/regression/68-doublelocking/02-unknown.c | 7 ------- .../68-doublelocking/03-thread-exit-with-mutex.c | 8 -------- 2 files changed, 15 deletions(-) diff --git a/tests/regression/68-doublelocking/02-unknown.c b/tests/regression/68-doublelocking/02-unknown.c index f7c55b13fb..b0ae74c79b 100644 --- a/tests/regression/68-doublelocking/02-unknown.c +++ b/tests/regression/68-doublelocking/02-unknown.c @@ -13,13 +13,6 @@ void* f1(void* ptr) { x = 3; } - void* ptr2; - if(top) { - ptr2 = &mut[x]; - } else { - ptr2 = &mut[3]; - } - pthread_mutex_lock(&mut[x]); pthread_mutex_lock(&mut[3]); //WARN diff --git a/tests/regression/68-doublelocking/03-thread-exit-with-mutex.c b/tests/regression/68-doublelocking/03-thread-exit-with-mutex.c index 3014a044a9..371a5e955f 100644 --- a/tests/regression/68-doublelocking/03-thread-exit-with-mutex.c +++ b/tests/regression/68-doublelocking/03-thread-exit-with-mutex.c @@ -13,14 +13,6 @@ void* f1(void* ptr) { x = 3; } - void* ptr2; - if(top) { - ptr2 = &mut[x]; - } else { - ptr2 = &mut[3]; - } - - pthread_mutex_lock(&mut[x]); if(top) { From bab294bedef601dd339cb9299f238b6c553a7a5f Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 27 Mar 2023 20:03:03 +0200 Subject: [PATCH 112/518] Only trace if tracing is enabled Co-authored-by: Simmo Saan --- src/analyses/base.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index ff9c4d438a..ef749a2537 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2105,7 +2105,9 @@ struct | `Int x -> begin match ID.to_int x with - | Some z -> M.tracel "attr" "setting\n"; set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.of_int z)) + | Some z -> + if M.tracing then M.tracel "attr" "setting\n"; + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.of_int z)) | None -> set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.top ())) end | _ -> set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.top ())) From e8d0219c94a92776e1d21410b2f4ea394e49ce17 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 28 Mar 2023 11:27:18 +0200 Subject: [PATCH 113/518] Finally fix it for OS X --- src/cdomains/mutexAttrDomain.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/mutexAttrDomain.ml b/src/cdomains/mutexAttrDomain.ml index 6b57bc69b9..88d9c5e5a5 100644 --- a/src/cdomains/mutexAttrDomain.ml +++ b/src/cdomains/mutexAttrDomain.ml @@ -18,12 +18,12 @@ include Lattice.Flat(MutexKind) (struct let bot_name = "Uninitialized" let top_n (* Needed because OS X is weird and assigns different constants than normal systems... :( *) let recursive_int = lazy ( - let res = ref None in + let res = ref (Z.of_int 2) in (* Use OS X as the default, it doesn't have the enum *) GoblintCil.iterGlobals !Cilfacade.current_file (function | GEnumTag (einfo, _) -> List.iter (fun (name, exp, _) -> if name = "PTHREAD_MUTEX_RECURSIVE" then - res := GoblintCil.getInteger exp + res := Option.get @@ GoblintCil.getInteger exp ) einfo.eitems | _ -> () ); @@ -37,5 +37,5 @@ let of_int z = else let recursive_int = Lazy.force recursive_int in match recursive_int with - | Some r when Z.equal z r -> `Lifted MutexKind.Recursive + | r when Z.equal z r -> `Lifted MutexKind.Recursive | _ -> `Top From 5d82c5c47507238bde9e961bc8ad16d4d43bac40 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Fri, 31 Mar 2023 16:34:28 +0200 Subject: [PATCH 114/518] Fix compilation warnings for test cases with GCC. Make passing reference to first element in array explicit, pass pointer parameter to pthread_exit. --- tests/regression/69-doublelocking/02-unknown.c | 4 ++-- .../69-doublelocking/03-thread-exit-with-mutex.c | 7 ++++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/tests/regression/69-doublelocking/02-unknown.c b/tests/regression/69-doublelocking/02-unknown.c index b0ae74c79b..9ad70a03b3 100644 --- a/tests/regression/69-doublelocking/02-unknown.c +++ b/tests/regression/69-doublelocking/02-unknown.c @@ -29,8 +29,8 @@ int main(int argc, char const *argv[]) pthread_create(&t1,NULL,f1,NULL); pthread_join(t1, NULL); - pthread_mutex_lock(&mut); //NOWARN - pthread_mutex_unlock(&mut); + pthread_mutex_lock(&mut[0]); //NOWARN + pthread_mutex_unlock(&mut[0]); return 0; } diff --git a/tests/regression/69-doublelocking/03-thread-exit-with-mutex.c b/tests/regression/69-doublelocking/03-thread-exit-with-mutex.c index 371a5e955f..d78e87bc2e 100644 --- a/tests/regression/69-doublelocking/03-thread-exit-with-mutex.c +++ b/tests/regression/69-doublelocking/03-thread-exit-with-mutex.c @@ -3,6 +3,7 @@ #include #include #include +#include pthread_mutex_t mut[8]; @@ -16,7 +17,7 @@ void* f1(void* ptr) { pthread_mutex_lock(&mut[x]); if(top) { - pthread_exit(5); //WARN + pthread_exit(NULL); //WARN } return NULL; //WARN @@ -31,8 +32,8 @@ int main(int argc, char const *argv[]) pthread_create(&t1,NULL,f1,NULL); pthread_join(t1, NULL); - pthread_mutex_lock(&mut); //NOWARN - pthread_mutex_unlock(&mut); + pthread_mutex_lock(&mut[0]); //NOWARN + pthread_mutex_unlock(&mut[0]); return 0; //NOWARN } From 79873fe86bc7cc7cb1bf21fcc8574fc4ee1ef191 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 23 Mar 2023 18:17:11 +0100 Subject: [PATCH 115/518] fix: already matched check needs to consider change_info --- src/incremental/compareCIL.ml | 54 +++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 22 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index 6425e12d21..bb9f25a9b5 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -101,9 +101,22 @@ let addToFinalMatchesMapping oV nV final_matches = let empty_rename_assms m = VarinfoMap.for_all (fun vo vn -> vo.vname = vn.vname) m +let already_matched oV nV final_matches = + match VarinfoMap.find_opt oV (fst final_matches) with + | None -> false + | Some v -> v.vid = oV.vid + +(* looks up the result of the already executed comparison and returns true if it is unchanged, false if it is changed. + Throws an exception if not found. *) +let change_info_lookup old_glob new_glob change_info = + List.mem {old = old_glob; current = new_glob} change_info.unchanged + (* Compares two varinfos of globals. finalizeOnlyExactMatch=true allows to check a rename assumption and discard the comparison result in case they do not match *) let eq_glob_var ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new newMap change_info final_matches = - if not (preservesSameNameMatches oV.vname oldMap nV.vname newMap) then + if already_matched oV nV final_matches then + (* check if this function was already matched and lookup the result *) + change_info_lookup gc_old gc_new change_info, change_info, final_matches + else if not (preservesSameNameMatches oV.vname oldMap nV.vname newMap) then (* do not allow for matches between differently named variables if one of the variables names exists in both, the new and old file *) false, change_info, final_matches else ( @@ -166,17 +179,20 @@ let eqF (old: Cil.fundec) (current: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) opti in identical, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess -let eqF_only_consider_exact_match f1 f2 change_info final_matches oldMap newMap var_glob_old var_glob_new = - (* check that names of match are each only contained in new or old file *) - if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then ( +let eqF_only_consider_exact_match f1 f2 change_info final_matches oldMap newMap gc_old gc_new = + if already_matched f1.svar f2.svar final_matches then + (* check if this function was already matched and lookup the result *) + change_info_lookup gc_old gc_new change_info, change_info, final_matches + else if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then + (* check that names of match are each only contained in new or old file *) false, change_info, final_matches - ) else + else (* the exact comparison is always uses the AST comparison because only when unchanged this match is manifested *) let doMatch, diff, fun_deps, global_deps, renamesOnSuccess = eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in match doMatch with | Unchanged when empty_rename_assms (VarinfoMap.filter (fun vo vn -> not (vo.vname = f1.svar.vname && vn.vname = f2.svar.vname)) fun_deps) && empty_rename_assms global_deps -> performRenames renamesOnSuccess; - change_info.unchanged <- {old = VarinfoMap.find f1.svar var_glob_old; current = VarinfoMap.find f2.svar var_glob_new} :: change_info.unchanged; + change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; let final_matches = addToFinalMatchesMapping f1.svar f2.svar final_matches in true, change_info, final_matches | Unchanged -> false, change_info, final_matches @@ -198,26 +214,20 @@ let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old let var_glob_old = GlobalMap.fold extract_globs oldMap VarinfoMap.empty in let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> - let glob_old = VarinfoMap.find f_old_var var_glob_old in - let glob_new = VarinfoMap.find f_new_var var_glob_new in - match VarinfoMap.find_opt f_old_var (fst fm) with - | None -> - let f_old = get_fundec glob_old in - let f_new = get_fundec glob_new in (* TODO: what happens if there exists no fundec for this varinfo? *) - if acc then - eqF_only_consider_exact_match f_old f_new ci fm oldMap newMap var_glob_old var_glob_new - else false, ci, fm - | Some v -> acc && v.vid = f_new_var.vid && List.mem {old=glob_old; current=glob_new} ci.unchanged, ci, fm + let gc_old = VarinfoMap.find f_old_var var_glob_old in + let gc_new = VarinfoMap.find f_old_var var_glob_new in + let f_old = get_fundec gc_old in + let f_new = get_fundec gc_new in (* TODO: what happens if there exists no fundec for this varinfo? *) + if acc then + eqF_only_consider_exact_match f_old f_new ci fm oldMap newMap gc_old gc_new + else false, ci, fm ) function_dependencies (true, change_info, final_matches) in let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> let glob_old = VarinfoMap.find old_var var_glob_old in let glob_new = VarinfoMap.find new_var var_glob_new in - match VarinfoMap.find_opt old_var (fst fm) with - | None -> - if acc then - compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap ci fm - else false, ci, fm - | Some v -> acc && v.vid = new_var.vid && List.mem {old=glob_old; current=glob_new} ci.unchanged, ci, fm + if acc then + compare_varinfo_exact old_var glob_old oldMap new_var glob_new newMap ci fm + else false, ci, fm ) global_var_dependencies (true, change_info, final_matches) in funDependenciesMatch && globalDependenciesMatch, change_info, final_matches else From 06502b5fb9dd125239208ae04ceefe39a47f7eb3 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 17 Apr 2023 17:28:23 +0200 Subject: [PATCH 116/518] remove polymorphic comparison of global_col --- src/incremental/compareCIL.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index bb9f25a9b5..c61d74c627 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -17,6 +17,7 @@ let name_of_global_col gc = match gc.def with | None -> raise (Failure "empty global record") let compare_global_col gc1 gc2 = compare (name_of_global_col gc1) (name_of_global_col gc2) +let equal_name_global_col gc1 gc2 = compare_global_col gc1 gc2 == 0 let get_varinfo gc = match gc.decls, gc.def with | _, Some (Var v) -> v @@ -90,6 +91,7 @@ let should_reanalyze (fdec: Cil.fundec) = let performRenames (renamesOnSuccess: renamesOnSuccess) = begin let (compinfoRenames, enumRenames) = renamesOnSuccess in + (* Reset cnames and ckeys to the old value. Only affects anonymous structs/unions where names are not checked for equality. *) List.iter (fun (compinfo2, compinfo1) -> compinfo2.cname <- compinfo1.cname; compinfo2.ckey <- compinfo1.ckey) compinfoRenames; List.iter (fun (enum2, enum1) -> enum2.ename <- enum1.ename) enumRenames; end @@ -109,7 +111,7 @@ let already_matched oV nV final_matches = (* looks up the result of the already executed comparison and returns true if it is unchanged, false if it is changed. Throws an exception if not found. *) let change_info_lookup old_glob new_glob change_info = - List.mem {old = old_glob; current = new_glob} change_info.unchanged + List.exists (fun (u : unchanged_global) -> equal_name_global_col u.old old_glob && equal_name_global_col u.current new_glob) change_info.unchanged (* Compares two varinfos of globals. finalizeOnlyExactMatch=true allows to check a rename assumption and discard the comparison result in case they do not match *) let eq_glob_var ?(finalizeOnlyExactMatch=false) oV gc_old oldMap nV gc_new newMap change_info final_matches = From 4533c51b49bc7239d42dfcc99422ea3f50f5a87e Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Sun, 30 Apr 2023 22:57:01 +0200 Subject: [PATCH 117/518] strlen-case in special of base: first draft --- src/analyses/base.ml | 14 ++++++++++++++ src/analyses/libraryDesc.ml | 1 + src/analyses/libraryFunctions.ml | 3 +-- src/cdomains/addressDomain.ml | 1 + src/cdomains/lval.ml | 3 +++ 5 files changed, 20 insertions(+), 2 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 440571a9f1..594a3e89b4 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2103,6 +2103,20 @@ struct in let dest_a = eval_lv (Analyses.ask_of_ctx ctx) gs st dst_lval in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | Strlen s, _ -> + let casted_lval = mkMem ~addr:(Cilfacade.mkCast ~e:s ~newt:(TPtr (charPtrType, []))) ~off:NoOffset in + let address = eval_lv (Analyses.ask_of_ctx ctx) gs st casted_lval in + begin match lv with + | Some v -> + begin match AD.to_string_length address with + |x::xs -> assign ctx v (integer x) + | [] -> + let dest_adr = eval_lv (Analyses.ask_of_ctx ctx) gs st v in + let dest_typ = AD.get_type dest_adr in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_adr dest_typ (VD.top_value (unrollType dest_typ)) + end + |None -> ctx.local + end | Abort, _ -> raise Deadcode | ThreadExit { ret_val = exp }, _ -> begin match ThreadId.get_current (Analyses.ask_of_ctx ctx) with diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index a477fc1809..9391771515 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -60,6 +60,7 @@ type special = | Bzero of { dest: Cil.exp; count: Cil.exp; } | Memcpy of { dest: Cil.exp; src: Cil.exp } | Strcpy of { dest: Cil.exp; src: Cil.exp } (* TODO: add count for strncpy when actually used *) + | Strlen of Cil.exp | Abort | Identity of Cil.exp (** Identity function. Some compiler optimization annotation functions map to this. *) | Setjmp of { env: Cil.exp; } diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 426d1b90b3..57149bc207 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -16,6 +16,7 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__builtin___memcpy_chk", special [__ "dest" [w]; __ "src" [r]; drop "n" []; drop "os" []] @@ fun dest src -> Memcpy { dest; src }); ("strncpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Strcpy { dest; src }); ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src }); + ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); ("malloc", special [__ "size" []] @@ fun size -> Malloc size); ("realloc", special [__ "ptr" [r; f]; __ "size" []] @@ fun ptr size -> Realloc { ptr; size }); ("abort", special [] Abort); @@ -670,7 +671,6 @@ let invalidate_actions = [ "sscanf", writesAllButFirst 2 readsAll;(*drop 2*) "strcmp", readsAll;(*safe*) "strftime", writes [1];(*keep [1]*) - "strlen", readsAll;(*safe*) "strncmp", readsAll;(*safe*) "strncat", writes [1];(*keep [1]*) "strstr", readsAll;(*safe*) @@ -733,7 +733,6 @@ let invalidate_actions = [ "sigaddset", writesAll;(*unsafe*) "pthread_sigmask", writesAllButFirst 2 readsAll;(*unsafe*) "raise", writesAll;(*unsafe*) - "_strlen", readsAll;(*safe*) "__builtin_alloca", readsAll;(*safe*) "dlopen", readsAll;(*safe*) "dlsym", readsAll;(*safe*) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index c6905a5cdc..78dc2e385f 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -104,6 +104,7 @@ struct (* strings *) let from_string x = singleton (Addr.from_string x) let to_string x = List.filter_map Addr.to_string (elements x) + let to_string_length x = List.filter_map Addr.to_string_length (elements x) (* add an & in front of real addresses *) module ShortAddr = diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 96e8db1c86..c157034c3a 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -256,6 +256,9 @@ struct let to_string = function | StrPtr (Some x) -> Some x | _ -> None + let to_string_length = function + | StrPtr (Some x) -> Some (String.length x) + | _ -> None (* exception if the offset can't be followed completely *) exception Type_offset of typ * string From e19c51bec6cd3a405bc61dc5b3ea8402c77da3bc Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 20 Feb 2023 00:24:59 +0100 Subject: [PATCH 118/518] messing around for thread wrappers --- src/analyses/threadSpawnWrapperAnalysis.ml | 141 +++++++++++++++++++++ src/domains/lattice.ml | 2 +- src/util/options.schema.json | 8 ++ 3 files changed, 150 insertions(+), 1 deletion(-) create mode 100644 src/analyses/threadSpawnWrapperAnalysis.ml diff --git a/src/analyses/threadSpawnWrapperAnalysis.ml b/src/analyses/threadSpawnWrapperAnalysis.ml new file mode 100644 index 0000000000..aa0a7fbfa9 --- /dev/null +++ b/src/analyses/threadSpawnWrapperAnalysis.ml @@ -0,0 +1,141 @@ +(** An analysis that handles the case when pthread_create is called from a wrapper function all over the code. *) + +(* TODO: share code with mallocWrapperAnalysis *) + +open Prelude.Ana +open Analyses +open GobConfig +open ThreadIdDomain +module Q = Queries + +module Spec (* : Analyses.MCPSpec *) = +struct + include Analyses.DefaultSpec + + module PL = Lattice.Flat (Node) (struct + let top_name = "Unknown node" + let bot_name = "Unreachable node" + end) + + (* module Chain = Lattice.Chain (struct + let n () = + let p = get_int "ana.malloc.unique_address_count" in + if p < 0 then + failwith "Option ana.malloc.unique_address_count has to be non-negative" + else p + 1 (* Unique addresses + top address *) + + let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x + + end) *) + + (* Map for counting malloc node visits up to n (of the current thread). *) + (* module MallocCounter = struct + include MapDomain.MapBot_LiftTop(PL)(Chain) + + (* Increase counter for given node. If it does not exists yet, create it. *) + let add_malloc counter node = + let malloc = `Lifted node in + let count = find malloc counter in + if Chain.is_top count then + counter + else + remove malloc counter |> add malloc (count + 1) + end *) + + module Node : RichVarinfo.H = struct + include Node + + (* Description that gets appended to the varinfo-name in user output. *) + let describe_varinfo (v: varinfo) node = + let loc = UpdateCil.getLoc node in + CilType.Location.show loc + + let name_varinfo node = + Format.asprintf "(threadSpawn@sid:%s)" (Node.show_id node) + + end + + module NodeVarinfoMap = RichVarinfo.BiVarinfoMap.Make(Node) + let name () = "threadSpawnWrapper" + + module D = PL + module C = D + + let wrappers = Hashtbl.create 13 + + (* transfer functions *) + let assign ctx (lval:lval) (rval:exp) : D.t = + ctx.local + + let branch ctx (exp:exp) (tv:bool) : D.t = + ctx.local + + let body ctx (f:fundec) : D.t = + ctx.local + + let return ctx (exp:exp option) (f:fundec) : D.t = + ctx.local + + let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = + let wrapper_node = ctx.local in + let new_wrapper_node = + if Hashtbl.mem wrappers f.svar.vname then + match wrapper_node with + | `Lifted _ -> wrapper_node (* if an interesting callee is called by an interesting caller, then we remember the caller context *) + | _ -> (`Lifted ctx.node) (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) + else + PL.top () (* if an uninteresting callee is called, then we forget what was called before *) + in + let callee = new_wrapper_node in + [(ctx.local, callee)] + + let combine ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (au:D.t) (f_ask: Queries.ask) : D.t = + ctx.local + + let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = + ctx.local + + let startstate v = D.bot () + + let threadenter ctx lval f args = [D.top ()] + + let threadspawn ctx lval f args fctx = ctx.local + let exitstate v = D.top () + + type marshal = NodeVarinfoMap.marshal + + let get_heap_var = NodeVarinfoMap.to_varinfo + + + let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = + let wrapper_node = ctx.local in + match q with + (* | Queries.CurrentThreadId -> wrapper_node *) (* don't really know what im doing here!! *) + (* | Q.HeapVar -> + let node = match wrapper_node with + | `Lifted wrapper_node -> wrapper_node + | _ -> ctx.node + in + let count = MallocCounter.find (`Lifted node) counter in + let var = get_heap_var (ctx.ask Q.CurrentThreadId, node, count) in + var.vdecl <- UpdateCil.getLoc node; (* TODO: does this do anything bad for incremental? *) + `Lifted var + | Q.IsHeapVar v -> + NodeVarinfoMap.mem_varinfo v + | Q.IsMultiple v -> + begin match NodeVarinfoMap.from_varinfo v with + | Some (_, _, c) -> Chain.is_top c || not (ctx.ask Q.MustBeUniqueThread) + | None -> false + end *) + | _ -> Queries.Result.top q + + let init marshal = + List.iter (fun wrapper -> Hashtbl.replace wrappers wrapper ()) (get_string_list "ana.thread.wrappers"); + NodeVarinfoMap.unmarshal marshal + + let finalize () = + NodeVarinfoMap.marshal () +end + +let _ = + MCP.register_analysis (module Spec) diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index c1521611fc..2cfe49ccb9 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -598,7 +598,7 @@ struct Pretty.dprintf "%a not leq %a" pretty x pretty y end -module Chain (P: Printable.ChainParams) = +module Chain (P: Printable.ChainParams) : S with type t = int = struct include Printable.Std include Printable.Chain (P) diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 87c0b55b62..335aeca95f 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -975,6 +975,14 @@ "Whether the node at which a thread is created is part of its threadid", "type": "boolean", "default" : true + }, + "wrappers": { + "title": "ana.thread.wrappers", + "description": + "Loads a list of known thread spawn (pthread_create) wrapper functions.", + "type": "array", + "items": { "type": "string" }, + "default": [] } }, "additionalProperties": false From ff54a069a912325cc986eb028691dd48f06cd23e Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 8 Mar 2023 14:21:16 +0100 Subject: [PATCH 119/518] more bits --- src/analyses/mallocWrapperAnalysis.ml | 133 +++++++++++++++++++------- src/util/options.schema.json | 6 ++ 2 files changed, 106 insertions(+), 33 deletions(-) diff --git a/src/analyses/mallocWrapperAnalysis.ml b/src/analyses/mallocWrapperAnalysis.ml index d9a64870ad..84a0f04159 100644 --- a/src/analyses/mallocWrapperAnalysis.ml +++ b/src/analyses/mallocWrapperAnalysis.ml @@ -5,39 +5,46 @@ open Analyses open GobConfig open ThreadIdDomain module Q = Queries + +(* + let n () = + let p = get_int "ana.malloc.unique_address_count" in + if p < 0 then + failwith "Option ana.malloc.unique_address_count has to be non-negative" + else p + 1 (* Unique addresses + top address *) + *) -module Spec: Analyses.MCPSpec = -struct - include Analyses.DefaultSpec + +module MakeModules (N : sig val n : unit -> int end) = struct module PL = Lattice.Flat (Node) (struct - let top_name = "Unknown node" - let bot_name = "Unreachable node" - end) + let top_name = "Unknown node" + let bot_name = "Unreachable node" + end) module Chain = Lattice.Chain (struct - let n () = - let p = get_int "ana.malloc.unique_address_count" in + let n () = + let p = N.n () in if p < 0 then - failwith "Option ana.malloc.unique_address_count has to be non-negative" + failwith "Option has to be non-negative" else p + 1 (* Unique addresses + top address *) - let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x + let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x - end) + end) - (* Map for counting malloc node visits up to n (of the current thread). *) - module MallocCounter = struct +(* Map for counting malloc node visits up to n (of the current thread). *) + module UniqueCallCounter = struct include MapDomain.MapBot_LiftTop(PL)(Chain) (* Increase counter for given node. If it does not exists yet, create it. *) - let add_malloc counter node = - let malloc = `Lifted node in - let count = find malloc counter in + let add_unique_call counter node = + let unique_call = `Lifted node in + let count = find unique_call counter in if Chain.is_top count then counter else - remove malloc counter |> add malloc (count + 1) + remove unique_call counter |> add unique_call (count + 1) end module ThreadNode = struct @@ -45,20 +52,45 @@ struct (* Description that gets appended to the varinfo-name in user output. *) let describe_varinfo (v: varinfo) (t, node, c) = - let loc = UpdateCil.getLoc node in - CilType.Location.show loc + let loc = UpdateCil.getLoc node in + CilType.Location.show loc let name_varinfo (t, node, c) = - Format.asprintf "(alloc@sid:%s@tid:%s(#%s))" (Node.show_id node) (ThreadLifted.show t) (Chain.show c) + Format.asprintf "(alloc@sid:%s@tid:%s(#%s))" (Node.show_id node) (ThreadLifted.show t) (Chain.show c) end module NodeVarinfoMap = RichVarinfo.BiVarinfoMap.Make(ThreadNode) - let name () = "mallocWrapper" - module D = Lattice.Prod (MallocCounter) (PL) + module D = Lattice.Prod (UniqueCallCounter) (PL) module C = D +end + +module type Modules = module type of MakeModules(struct let n () = 0 end) + +module type ModulesArgs = sig + module Modules : Modules + open Modules + open Analyses.DefaultSpec + val name : unit -> string + val get_wrappers : unit -> string list + val query : 'a. ((D.t, G.t, C.t, V.t) ctx) -> ('a Q.t) -> 'a Q.result +end + + + + +module Spec (ModulesArgs : ModulesArgs) : Analyses.MCPSpec = +struct + include Analyses.DefaultSpec + include ModulesArgs.Modules + + let name = ModulesArgs.name + + module D = D + module C = C + let wrappers = Hashtbl.create 13 (* transfer functions *) @@ -95,12 +127,13 @@ struct let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc ((counter, _):D.t) (f_ask: Queries.ask) : D.t = ctx.local + (* TODO *) let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = let desc = LibraryFunctions.find f in match desc.special arglist with | Malloc _ | Calloc _ | Realloc _ -> let counter, wrapper_node = ctx.local in - (MallocCounter.add_malloc counter ctx.node, wrapper_node) + (UniqueCallCounter.add_unique_call counter ctx.node, wrapper_node) | _ -> ctx.local let startstate v = D.bot () @@ -114,8 +147,35 @@ struct type marshal = NodeVarinfoMap.marshal - let get_heap_var = NodeVarinfoMap.to_varinfo + let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = + let _ = ModulesArgs.query ctx in + Q.Result.top q + (* let query = ModulesArgs.query *) + + (* let get_heap_var = NodeVarinfoMap.to_varinfo *) + + let init marshal = + List.iter (fun wrapper -> Hashtbl.replace wrappers wrapper ()) (ModulesArgs.get_wrappers ()); + NodeVarinfoMap.unmarshal marshal + + let finalize () = + NodeVarinfoMap.marshal () +end + + +(* implementations for malloc and pthread_create *) + +module MallocModules = MakeModules(struct let n () = get_int "ana.malloc.unique_address_count" end) +module ThreadModules = MakeModules(struct let n () = get_int "ana.thread.unique_thread_id_count" end) + +module MallocModulesArgs : ModulesArgs = struct + open Analyses.DefaultSpec + module Modules = MallocModules + open Modules + + let name () = "mallocWrapper" + let get_wrappers () = get_string_list "ana.malloc.wrappers" let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = let counter, wrapper_node = ctx.local in @@ -125,8 +185,8 @@ struct | `Lifted wrapper_node -> wrapper_node | _ -> ctx.node in - let count = MallocCounter.find (`Lifted node) counter in - let var = get_heap_var (ctx.ask Q.CurrentThreadId, node, count) in + let count = UniqueCallCounter.find (`Lifted node) counter in + let var = NodeVarinfoMap.to_varinfo (ctx.ask Q.CurrentThreadId, node, count) in var.vdecl <- UpdateCil.getLoc node; (* TODO: does this do anything bad for incremental? *) `Lifted var | Q.IsHeapVar v -> @@ -136,15 +196,22 @@ struct | Some (_, _, c) -> Chain.is_top c || not (ctx.ask Q.MustBeUniqueThread) | None -> false end - | _ -> Queries.Result.top q + | _ -> Q.Result.top q - let init marshal = - List.iter (fun wrapper -> Hashtbl.replace wrappers wrapper ()) (get_string_list "ana.malloc.wrappers"); - NodeVarinfoMap.unmarshal marshal +end + +module ThreadModulesArgs : ModulesArgs = struct + open Analyses.DefaultSpec + module Modules = ThreadModules + open Modules + + let name () = "threadWrapper" + let get_wrappers () = get_string_list "ana.malloc.wrappers" + + let query _ (type a) (q : a Q.t) = Q.Result.top q - let finalize () = - NodeVarinfoMap.marshal () end let _ = - MCP.register_analysis (module Spec) + MCP.register_analysis (module Spec (MallocModulesArgs))(* ; + MCP.register_analysis (module Spec (ThreadModulesArgs)) *) diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 335aeca95f..0d36074a87 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -983,6 +983,12 @@ "type": "array", "items": { "type": "string" }, "default": [] + }, + "unique_thread_id_count": { + "title": "ana.thread.unique_thread_id_count", + "description": "Number of unique thread IDs allocated for each pthread_create node.", + "type": "integer", + "default": 0 } }, "additionalProperties": false From f8b573562a440a6cb707d7a2dd79ef542dc1e439 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Tue, 28 Mar 2023 02:57:58 +0200 Subject: [PATCH 120/518] working, probably --- src/analyses/mallocWrapperAnalysis.ml | 162 +++++++++--------- src/analyses/threadId.ml | 10 +- src/domains/queries.ml | 13 ++ .../66-pthread_create_wrapper/01-wrapper.c | 39 +++++ 4 files changed, 137 insertions(+), 87 deletions(-) create mode 100644 tests/regression/66-pthread_create_wrapper/01-wrapper.c diff --git a/src/analyses/mallocWrapperAnalysis.ml b/src/analyses/mallocWrapperAnalysis.ml index 84a0f04159..8ce5ac5334 100644 --- a/src/analyses/mallocWrapperAnalysis.ml +++ b/src/analyses/mallocWrapperAnalysis.ml @@ -5,37 +5,38 @@ open Analyses open GobConfig open ThreadIdDomain module Q = Queries - -(* - let n () = - let p = get_int "ana.malloc.unique_address_count" in - if p < 0 then - failwith "Option ana.malloc.unique_address_count has to be non-negative" - else p + 1 (* Unique addresses + top address *) - *) +(* Functor argument for creating the chain lattice of unique calls *) +module type UniqueCountArgs = sig + val unique_count : unit -> int + val label : string +end -module MakeModules (N : sig val n : unit -> int end) = struct +(* Functor argument for determining wrapper and wrapped functions *) +module type WrapperArgs = sig + val wrappers : unit -> string list + val is_wrapped : LibraryDesc.special -> bool +end - module PL = Lattice.Flat (Node) (struct - let top_name = "Unknown node" - let bot_name = "Unreachable node" - end) +(* The main analysis, generic to which functions are being wrapped. *) +module SpecBase (UniqueCountArgs : UniqueCountArgs) (WrapperArgs : WrapperArgs) = +struct + include Analyses.DefaultSpec module Chain = Lattice.Chain (struct - let n () = - let p = N.n () in + let n () = + let p = UniqueCountArgs.unique_count () in if p < 0 then - failwith "Option has to be non-negative" + failwith @@ UniqueCountArgs.label ^ " has to be non-negative" else p + 1 (* Unique addresses + top address *) - let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x + let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x - end) + end) -(* Map for counting malloc node visits up to n (of the current thread). *) + (* Map for counting function call node visits up to n (of the current thread). *) module UniqueCallCounter = struct - include MapDomain.MapBot_LiftTop(PL)(Chain) + include MapDomain.MapBot_LiftTop(Q.NodeFlatLattice)(Chain) (* Increase counter for given node. If it does not exists yet, create it. *) let add_unique_call counter node = @@ -52,45 +53,19 @@ module MakeModules (N : sig val n : unit -> int end) = struct (* Description that gets appended to the varinfo-name in user output. *) let describe_varinfo (v: varinfo) (t, node, c) = - let loc = UpdateCil.getLoc node in - CilType.Location.show loc + let loc = UpdateCil.getLoc node in + CilType.Location.show loc let name_varinfo (t, node, c) = - Format.asprintf "(alloc@sid:%s@tid:%s(#%s))" (Node.show_id node) (ThreadLifted.show t) (Chain.show c) + Format.asprintf (* TODO *) "(alloc@sid:%s@tid:%s(#%s))" (Node.show_id node) (ThreadLifted.show t) (Chain.show c) end module NodeVarinfoMap = RichVarinfo.BiVarinfoMap.Make(ThreadNode) - module D = Lattice.Prod (UniqueCallCounter) (PL) + module D = Lattice.Prod (UniqueCallCounter) (Q.NodeFlatLattice) module C = D -end - -module type Modules = module type of MakeModules(struct let n () = 0 end) - -module type ModulesArgs = sig - module Modules : Modules - open Modules - open Analyses.DefaultSpec - val name : unit -> string - val get_wrappers : unit -> string list - val query : 'a. ((D.t, G.t, C.t, V.t) ctx) -> ('a Q.t) -> 'a Q.result -end - - - - -module Spec (ModulesArgs : ModulesArgs) : Analyses.MCPSpec = -struct - include Analyses.DefaultSpec - include ModulesArgs.Modules - - let name = ModulesArgs.name - - module D = D - module C = C - let wrappers = Hashtbl.create 13 (* transfer functions *) @@ -111,10 +86,10 @@ struct let new_wrapper_node = if Hashtbl.mem wrappers f.svar.vname then match wrapper_node with - | `Lifted _ -> wrapper_node (* if an interesting callee is called by an interesting caller, then we remember the caller context *) - | _ -> (`Lifted ctx.node) (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) + | `Lifted _ -> wrapper_node (* if an interesting callee is called by an interesting caller, then we remember the caller context *) + | _ -> `Lifted ctx.node (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) else - PL.top () (* if an uninteresting callee is called, then we forget what was called before *) + Q.NodeFlatLattice.top () (* if an uninteresting callee is called, then we forget what was called before *) in let callee = (counter, new_wrapper_node) in [(ctx.local, callee)] @@ -127,14 +102,12 @@ struct let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc ((counter, _):D.t) (f_ask: Queries.ask) : D.t = ctx.local - (* TODO *) let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = let desc = LibraryFunctions.find f in - match desc.special arglist with - | Malloc _ | Calloc _ | Realloc _ -> + if WrapperArgs.is_wrapped @@ desc.special arglist then let counter, wrapper_node = ctx.local in (UniqueCallCounter.add_unique_call counter ctx.node, wrapper_node) - | _ -> ctx.local + else ctx.local let startstate v = D.bot () @@ -147,16 +120,8 @@ struct type marshal = NodeVarinfoMap.marshal - let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = - let _ = ModulesArgs.query ctx in - Q.Result.top q - (* let query = ModulesArgs.query *) - - (* let get_heap_var = NodeVarinfoMap.to_varinfo *) - - let init marshal = - List.iter (fun wrapper -> Hashtbl.replace wrappers wrapper ()) (ModulesArgs.get_wrappers ()); + List.iter (fun wrapper -> Hashtbl.replace wrappers wrapper ()) (WrapperArgs.wrappers ()); NodeVarinfoMap.unmarshal marshal let finalize () = @@ -164,18 +129,32 @@ struct end -(* implementations for malloc and pthread_create *) +(* module UniqueCountArgsFromConfig (Option : sig val key : string end) : UniqueCountArgs = struct + let unique_count () = get_int Option.key + let label = "Option " ^ Option.key +end *) + +(* Create the chain argument-module, given the config key to loop up *) +let unique_count_args_from_config key = (module struct + let unique_count () = get_int key + let label = "Option " ^ key +end : UniqueCountArgs) + + +module MallocWrapper : MCPSpec = struct -module MallocModules = MakeModules(struct let n () = get_int "ana.malloc.unique_address_count" end) -module ThreadModules = MakeModules(struct let n () = get_int "ana.thread.unique_thread_id_count" end) + include SpecBase + (* (UniqueCountArgsFromConfig (struct let key = "ana.malloc.unique_address_count" end)) *) + (val unique_count_args_from_config "ana.malloc.unique_address_count") + (struct + let wrappers () = get_string_list "ana.malloc.wrappers" -module MallocModulesArgs : ModulesArgs = struct - open Analyses.DefaultSpec - module Modules = MallocModules - open Modules + let is_wrapped = function + | LibraryDesc.Malloc _ | Calloc _ | Realloc _ -> true + | _ -> false + end) let name () = "mallocWrapper" - let get_wrappers () = get_string_list "ana.malloc.wrappers" let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = let counter, wrapper_node = ctx.local in @@ -196,22 +175,35 @@ module MallocModulesArgs : ModulesArgs = struct | Some (_, _, c) -> Chain.is_top c || not (ctx.ask Q.MustBeUniqueThread) | None -> false end - | _ -> Q.Result.top q + | _ -> Queries.Result.top q end -module ThreadModulesArgs : ModulesArgs = struct - open Analyses.DefaultSpec - module Modules = ThreadModules - open Modules - let name () = "threadWrapper" - let get_wrappers () = get_string_list "ana.malloc.wrappers" +module ThreadCreateWrapper : MCPSpec = struct - let query _ (type a) (q : a Q.t) = Q.Result.top q + include SpecBase + (* (UniqueCountArgsFromConfig (struct let key = "ana.thread.unique_thread_id_count" end)) *) + (val unique_count_args_from_config "ana.thread.unique_thread_id_count") + (struct + let wrappers () = get_string_list "ana.thread.wrappers" + + let is_wrapped = function + | LibraryDesc.ThreadCreate _ -> true + | _ -> false + + end) + + let name () = "threadCreateWrapper" + + let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = + let counter, wrapper_node = ctx.local in + match q with + | Q.ThreadId -> `Lifted (match wrapper_node with + | `Lifted wrapper_node -> wrapper_node + | _ -> ctx.node) + | _ -> Queries.Result.top q end -let _ = - MCP.register_analysis (module Spec (MallocModulesArgs))(* ; - MCP.register_analysis (module Spec (ThreadModulesArgs)) *) +let _ = List.iter MCP.register_analysis [(module MallocWrapper); (module ThreadCreateWrapper)]; diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index 43f957bd69..fcf1393330 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -87,13 +87,19 @@ struct else None + let node_for_ctx ctx = match (ctx.ask Queries.ThreadId) with + | `Lifted node -> node + | _ -> ctx.prev_node + let threadenter ctx lval f args = - let+ tid = create_tid ctx.local ctx.prev_node f in + (* x *) + let+ tid = create_tid ctx.local (node_for_ctx ctx) f in (tid, TD.bot ()) let threadspawn ctx lval f args fctx = let (current, td) = ctx.local in - (current, Thread.threadspawn td ctx.prev_node f) + (* x *) + (current, Thread.threadspawn td (node_for_ctx ctx) f) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) let init (m:marshal option): unit = diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 66db991826..2a9a241398 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -13,6 +13,14 @@ module TS = SetDomain.ToppedSet (CilType.Typ) (struct let topname = "All" end) module ES = SetDomain.Reverse (SetDomain.ToppedSet (CilType.Exp) (struct let topname = "All" end)) module VS = SetDomain.ToppedSet (CilType.Varinfo) (struct let topname = "All" end) + +(* TODO: where to put this *) +module NodeFlatLattice = Lattice.Flat (Node) (struct + let top_name = "Unknown node" + let bot_name = "Unreachable node" +end) + + module VI = Lattice.Flat (Basetype.Variables) (struct let top_name = "Unknown line" let bot_name = "Unreachable line" @@ -69,6 +77,7 @@ type _ t = | MustBeSingleThreaded: MustBool.t t | MustBeUniqueThread: MustBool.t t | CurrentThreadId: ThreadIdDomain.ThreadLifted.t t + | ThreadId: NodeFlatLattice.t t | MayBeThreadReturn: MayBool.t t | EvalFunvar: exp -> LS.t t | EvalInt: exp -> ID.t t @@ -137,6 +146,7 @@ struct | EvalValue _ -> (module VD) | BlobSize _ -> (module ID) | CurrentThreadId -> (module ThreadIdDomain.ThreadLifted) + | ThreadId -> (module NodeFlatLattice) | HeapVar -> (module VI) | EvalStr _ -> (module SD) | IterPrevVars _ -> (module Unit) @@ -196,6 +206,7 @@ struct | EvalValue _ -> VD.top () | BlobSize _ -> ID.top () | CurrentThreadId -> ThreadIdDomain.ThreadLifted.top () + | ThreadId -> NodeFlatLattice.top () | HeapVar -> VI.top () | EvalStr _ -> SD.top () | IterPrevVars _ -> Unit.top () @@ -244,6 +255,7 @@ struct | Any MustBeSingleThreaded -> 12 | Any MustBeUniqueThread -> 13 | Any CurrentThreadId -> 14 + | Any ThreadId -> 9999999 | Any MayBeThreadReturn -> 15 | Any (EvalFunvar _) -> 16 | Any (EvalInt _) -> 17 @@ -374,6 +386,7 @@ struct | Any MustBeSingleThreaded -> Pretty.dprintf "MustBeSingleThreaded" | Any MustBeUniqueThread -> Pretty.dprintf "MustBeUniqueThread" | Any CurrentThreadId -> Pretty.dprintf "CurrentThreadId" + | Any ThreadId -> Pretty.dprintf "ThreadId" | Any MayBeThreadReturn -> Pretty.dprintf "MayBeThreadReturn" | Any (EvalFunvar e) -> Pretty.dprintf "EvalFunvar %a" CilType.Exp.pretty e | Any (EvalInt e) -> Pretty.dprintf "EvalInt %a" CilType.Exp.pretty e diff --git a/tests/regression/66-pthread_create_wrapper/01-wrapper.c b/tests/regression/66-pthread_create_wrapper/01-wrapper.c new file mode 100644 index 0000000000..89cddd87bb --- /dev/null +++ b/tests/regression/66-pthread_create_wrapper/01-wrapper.c @@ -0,0 +1,39 @@ +// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.wrappers[+] my_pthread_create +#include +#include + +int my_pthread_create( + pthread_t *restrict thread, + const pthread_attr_t *restrict attr, + void *(*start_routine)(void *), + void *restrict arg +) { + return pthread_create(thread, attr, start_routine, arg); +} + +// uncomment to remove the wrapper +// #define my_pthread_create pthread_create + +int g = 0; +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&A); + g = 1; + pthread_mutex_unlock(&A); + return NULL; +} + +int main() { + pthread_t id1; + my_pthread_create(&id1, NULL, t_fun, NULL); + pthread_t id2; + my_pthread_create(&id2, NULL, t_fun, NULL); + + pthread_join(id1, NULL); + pthread_join(id2, NULL); + + g = 2; // NORACE + + return 0; +} From 8ea858ab28b9c82087f333e8f81d4334d03634af Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Tue, 28 Mar 2023 03:15:02 +0200 Subject: [PATCH 121/518] rename module, remove unused file --- src/analyses/threadSpawnWrapperAnalysis.ml | 141 ------------------ ...Analysis.ml => wrapperFunctionAnalysis.ml} | 4 +- 2 files changed, 3 insertions(+), 142 deletions(-) delete mode 100644 src/analyses/threadSpawnWrapperAnalysis.ml rename src/analyses/{mallocWrapperAnalysis.ml => wrapperFunctionAnalysis.ml} (96%) diff --git a/src/analyses/threadSpawnWrapperAnalysis.ml b/src/analyses/threadSpawnWrapperAnalysis.ml deleted file mode 100644 index aa0a7fbfa9..0000000000 --- a/src/analyses/threadSpawnWrapperAnalysis.ml +++ /dev/null @@ -1,141 +0,0 @@ -(** An analysis that handles the case when pthread_create is called from a wrapper function all over the code. *) - -(* TODO: share code with mallocWrapperAnalysis *) - -open Prelude.Ana -open Analyses -open GobConfig -open ThreadIdDomain -module Q = Queries - -module Spec (* : Analyses.MCPSpec *) = -struct - include Analyses.DefaultSpec - - module PL = Lattice.Flat (Node) (struct - let top_name = "Unknown node" - let bot_name = "Unreachable node" - end) - - (* module Chain = Lattice.Chain (struct - let n () = - let p = get_int "ana.malloc.unique_address_count" in - if p < 0 then - failwith "Option ana.malloc.unique_address_count has to be non-negative" - else p + 1 (* Unique addresses + top address *) - - let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x - - end) *) - - (* Map for counting malloc node visits up to n (of the current thread). *) - (* module MallocCounter = struct - include MapDomain.MapBot_LiftTop(PL)(Chain) - - (* Increase counter for given node. If it does not exists yet, create it. *) - let add_malloc counter node = - let malloc = `Lifted node in - let count = find malloc counter in - if Chain.is_top count then - counter - else - remove malloc counter |> add malloc (count + 1) - end *) - - module Node : RichVarinfo.H = struct - include Node - - (* Description that gets appended to the varinfo-name in user output. *) - let describe_varinfo (v: varinfo) node = - let loc = UpdateCil.getLoc node in - CilType.Location.show loc - - let name_varinfo node = - Format.asprintf "(threadSpawn@sid:%s)" (Node.show_id node) - - end - - module NodeVarinfoMap = RichVarinfo.BiVarinfoMap.Make(Node) - let name () = "threadSpawnWrapper" - - module D = PL - module C = D - - let wrappers = Hashtbl.create 13 - - (* transfer functions *) - let assign ctx (lval:lval) (rval:exp) : D.t = - ctx.local - - let branch ctx (exp:exp) (tv:bool) : D.t = - ctx.local - - let body ctx (f:fundec) : D.t = - ctx.local - - let return ctx (exp:exp option) (f:fundec) : D.t = - ctx.local - - let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = - let wrapper_node = ctx.local in - let new_wrapper_node = - if Hashtbl.mem wrappers f.svar.vname then - match wrapper_node with - | `Lifted _ -> wrapper_node (* if an interesting callee is called by an interesting caller, then we remember the caller context *) - | _ -> (`Lifted ctx.node) (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) - else - PL.top () (* if an uninteresting callee is called, then we forget what was called before *) - in - let callee = new_wrapper_node in - [(ctx.local, callee)] - - let combine ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (au:D.t) (f_ask: Queries.ask) : D.t = - ctx.local - - let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = - ctx.local - - let startstate v = D.bot () - - let threadenter ctx lval f args = [D.top ()] - - let threadspawn ctx lval f args fctx = ctx.local - let exitstate v = D.top () - - type marshal = NodeVarinfoMap.marshal - - let get_heap_var = NodeVarinfoMap.to_varinfo - - - let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = - let wrapper_node = ctx.local in - match q with - (* | Queries.CurrentThreadId -> wrapper_node *) (* don't really know what im doing here!! *) - (* | Q.HeapVar -> - let node = match wrapper_node with - | `Lifted wrapper_node -> wrapper_node - | _ -> ctx.node - in - let count = MallocCounter.find (`Lifted node) counter in - let var = get_heap_var (ctx.ask Q.CurrentThreadId, node, count) in - var.vdecl <- UpdateCil.getLoc node; (* TODO: does this do anything bad for incremental? *) - `Lifted var - | Q.IsHeapVar v -> - NodeVarinfoMap.mem_varinfo v - | Q.IsMultiple v -> - begin match NodeVarinfoMap.from_varinfo v with - | Some (_, _, c) -> Chain.is_top c || not (ctx.ask Q.MustBeUniqueThread) - | None -> false - end *) - | _ -> Queries.Result.top q - - let init marshal = - List.iter (fun wrapper -> Hashtbl.replace wrappers wrapper ()) (get_string_list "ana.thread.wrappers"); - NodeVarinfoMap.unmarshal marshal - - let finalize () = - NodeVarinfoMap.marshal () -end - -let _ = - MCP.register_analysis (module Spec) diff --git a/src/analyses/mallocWrapperAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml similarity index 96% rename from src/analyses/mallocWrapperAnalysis.ml rename to src/analyses/wrapperFunctionAnalysis.ml index 8ce5ac5334..e694a66213 100644 --- a/src/analyses/mallocWrapperAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -1,4 +1,6 @@ -(** An analysis that handles the case when malloc is called from a wrapper function all over the code. *) +(** An analysis that handles the case when an interesting function is called + from a wrapper function all over the code. Currently handles the [malloc]- + family of memory allocation functions, as well as [pthread_create] *) open Prelude.Ana open Analyses From 2e683c941d6da1cad074713adcee2cc0dd3d9ef5 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 19 Apr 2023 11:24:14 +0200 Subject: [PATCH 122/518] working more or less --- src/analyses/threadId.ml | 31 +++++-- src/analyses/wrapperFunctionAnalysis.ml | 90 +++++++++++++------ src/cdomains/threadIdDomain.ml | 73 +++++++++------ src/domains/lattice.ml | 19 ++++ src/domains/printable.ml | 10 +++ src/domains/queries.ml | 11 +-- src/util/debug.ml | 6 ++ .../02-unique-counter.c | 49 ++++++++++ 8 files changed, 219 insertions(+), 70 deletions(-) create mode 100644 src/util/debug.ml create mode 100644 tests/regression/66-pthread_create_wrapper/02-unique-counter.c diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index fcf1393330..e0ef997d94 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -7,6 +7,8 @@ open Prelude.Ana open Analyses open GobList.Syntax +open Debug + module Thread = ThreadIdDomain.Thread module ThreadLifted = ThreadIdDomain.ThreadLifted @@ -41,10 +43,10 @@ struct Hashtbl.replace !tids tid (); (`Lifted (tid), TD.bot ()) - let create_tid (current, td) (node: Node.t) v = + let create_tid (current, td) ((node, index): Node.t * int option) v = match current with | `Lifted current -> - let+ tid = Thread.threadenter (current, td) node v in + let+ tid = Thread.threadenter (current, td) node index v in if GobConfig.get_bool "dbg.print_tids" then Hashtbl.replace !tids tid (); `Lifted tid @@ -87,19 +89,32 @@ struct else None - let node_for_ctx ctx = match (ctx.ask Queries.ThreadId) with - | `Lifted node -> node - | _ -> ctx.prev_node - + let indexed_node_for_ctx ?(increment=false) ctx = + let ni = ctx.ask Queries.ThreadCreateIndexedNode in (* should this be ctx.prev_node? *) + dpf"%a" Queries.ThreadNodeLattice.pretty ni; + let ni = match ni with + (* would be better if lifted node always had count (see *1* ) *) + | `Lifted node, `Lifted count -> node, Some (if increment then succ count else count) + | `Lifted node, `Bot when increment -> node, Some 1 (* todo: bot and top are both 0, then this should stay None *) + | `Lifted node, _ -> node, None + | _ -> ctx.prev_node, None + in + dpf"%a %s" Node.pretty (fst ni) (Stdlib.Option.fold ~some:(f"Some[%d]") ~none:"None" @@ snd ni); + ni + + (* todo: should `f` also come from wrapper?? *) let threadenter ctx lval f args = (* x *) - let+ tid = create_tid ctx.local (node_for_ctx ctx) f in + pf "threadenter"; + let+ tid = create_tid ctx.local (indexed_node_for_ctx ~increment:true ctx |> Tuple2.map2 (Option.map succ)) f in (tid, TD.bot ()) let threadspawn ctx lval f args fctx = + pf "threadspawn"; let (current, td) = ctx.local in + let node, index = indexed_node_for_ctx ctx in (* x *) - (current, Thread.threadspawn td (node_for_ctx ctx) f) + (current, Thread.threadspawn td node index f) (* todo *) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) let init (m:marshal option): unit = diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index e694a66213..2a1c21b8e3 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -8,6 +8,8 @@ open GobConfig open ThreadIdDomain module Q = Queries +open Debug + (* Functor argument for creating the chain lattice of unique calls *) module type UniqueCountArgs = sig val unique_count : unit -> int @@ -25,6 +27,9 @@ module SpecBase (UniqueCountArgs : UniqueCountArgs) (WrapperArgs : WrapperArgs) struct include Analyses.DefaultSpec + let dbg = WrapperArgs.is_wrapped (LibraryDesc.ThreadCreate { thread = Cil.integer 1; start_routine = Cil.integer 1; arg = Cil.integer 1; }) + + (* replace this entirely with LiftedChain? then check unique_count in UniqueCallCounter... *) module Chain = Lattice.Chain (struct let n () = let p = UniqueCountArgs.unique_count () in @@ -44,27 +49,15 @@ struct let add_unique_call counter node = let unique_call = `Lifted node in let count = find unique_call counter in - if Chain.is_top count then + let c' = if Chain.is_top count then counter else remove unique_call counter |> add unique_call (count + 1) + in + if dbg then dpf"add_unique_call node=<%a> count_before=%d count_after=%d" Node.pretty node count (find unique_call c'); + c' end - module ThreadNode = struct - include Printable.Prod3 (ThreadIdDomain.ThreadLifted) (Node) (Chain) - - (* Description that gets appended to the varinfo-name in user output. *) - let describe_varinfo (v: varinfo) (t, node, c) = - let loc = UpdateCil.getLoc node in - CilType.Location.show loc - - let name_varinfo (t, node, c) = - Format.asprintf (* TODO *) "(alloc@sid:%s@tid:%s(#%s))" (Node.show_id node) (ThreadLifted.show t) (Chain.show c) - - end - - module NodeVarinfoMap = RichVarinfo.BiVarinfoMap.Make(ThreadNode) - module D = Lattice.Prod (UniqueCallCounter) (Q.NodeFlatLattice) module C = D @@ -81,15 +74,21 @@ struct ctx.local let return ctx (exp:exp option) (f:fundec) : D.t = + if dbg then dpf"return f=<%a>" CilType.Fundec.pretty f; ctx.local let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = + if dbg then dpf"enter f=<%a>" CilType.Fundec.pretty f; let counter, wrapper_node = ctx.local in let new_wrapper_node = if Hashtbl.mem wrappers f.svar.vname then + begin + if dbg then dpf"is wrapper"; match wrapper_node with - | `Lifted _ -> wrapper_node (* if an interesting callee is called by an interesting caller, then we remember the caller context *) - | _ -> `Lifted ctx.node (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) + | `Lifted _ -> if dbg then dpf"interesting caller, keep caller context"; wrapper_node (* if an interesting callee is called by an interesting caller, then we remember the caller context *) + (* todo: does malloc want prev_node??? *) + | _ -> if dbg then dpf"uninteresting caller, keep callee context";`Lifted ctx.prev_node (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) + end else Q.NodeFlatLattice.top () (* if an uninteresting callee is called, then we forget what was called before *) in @@ -97,6 +96,7 @@ struct [(ctx.local, callee)] let combine_env ctx lval fexp f args fc (counter, _) f_ask = + if dbg then dpf"combine f=<%a>" CilType.Fundec.pretty f; (* Keep (potentially higher) counter from callee and keep wrapper node from caller *) let _, lnode = ctx.local in (counter, lnode) @@ -105,29 +105,31 @@ struct ctx.local let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = + if dbg then dpf"special f=<%a>" CilType.Varinfo.pretty f; let desc = LibraryFunctions.find f in if WrapperArgs.is_wrapped @@ desc.special arglist then let counter, wrapper_node = ctx.local in - (UniqueCallCounter.add_unique_call counter ctx.node, wrapper_node) + (* previously, unique count isn't by wrapper node but by wrapped node. why? *) + (* does malloc want prev_node?? *) + (UniqueCallCounter.add_unique_call counter (match wrapper_node with `Lifted node -> node | _ -> ctx.prev_node), wrapper_node) else ctx.local let startstate v = D.bot () let threadenter ctx lval f args = + if dbg then dpf"threadenter f=<%a>" CilType.Varinfo.pretty f; (* The new thread receives a fresh counter *) [D.bot ()] - let threadspawn ctx lval f args fctx = ctx.local + let threadspawn ctx lval f args fctx = + if dbg then dpf"threadspawn f=<%a>" CilType.Varinfo.pretty f; ctx.local let exitstate v = D.top () - type marshal = NodeVarinfoMap.marshal + type marshal = unit - let init marshal = - List.iter (fun wrapper -> Hashtbl.replace wrappers wrapper ()) (WrapperArgs.wrappers ()); - NodeVarinfoMap.unmarshal marshal + let init (_ : marshal option) = + List.iter (fun wrapper -> Hashtbl.replace wrappers wrapper ()) (WrapperArgs.wrappers ()) - let finalize () = - NodeVarinfoMap.marshal () end @@ -156,6 +158,21 @@ module MallocWrapper : MCPSpec = struct | _ -> false end) + module ThreadNode = struct + include Printable.Prod3 (ThreadIdDomain.ThreadLifted) (Node) (Chain) + + (* Description that gets appended to the varinfo-name in user output. *) + let describe_varinfo (v: varinfo) (t, node, c) = + let loc = UpdateCil.getLoc node in + CilType.Location.show loc + + let name_varinfo (t, node, c) = + Format.asprintf "(alloc@sid:%s@tid:%s(#%s))" (Node.show_id node) (ThreadLifted.show t) (Chain.show c) + + end + + module NodeVarinfoMap = RichVarinfo.BiVarinfoMap.Make(ThreadNode) + let name () = "mallocWrapper" let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = @@ -179,6 +196,15 @@ module MallocWrapper : MCPSpec = struct end | _ -> Queries.Result.top q + type marshal = NodeVarinfoMap.marshal + + let init marshal = + (* call init from SpecBase *) + init None; + NodeVarinfoMap.unmarshal marshal + + let finalize () = + NodeVarinfoMap.marshal () end @@ -201,9 +227,17 @@ module ThreadCreateWrapper : MCPSpec = struct let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = let counter, wrapper_node = ctx.local in match q with - | Q.ThreadId -> `Lifted (match wrapper_node with + | Q.ThreadCreateIndexedNode -> + dpf"query node=<%a> prev_node=<%a>" Node.pretty ctx.node Node.pretty ctx.prev_node; + let node = match wrapper_node with | `Lifted wrapper_node -> wrapper_node - | _ -> ctx.node) + | _ -> ctx.prev_node + in + let count = + Lattice.lifted_of_chain (module Chain) + @@ UniqueCallCounter.find (`Lifted node) counter + in + `Lifted node, count | _ -> Queries.Result.top q end diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index c3f05b6c84..9a1ac37b1d 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -21,7 +21,7 @@ module type Stateless = sig include S - val threadenter: Node.t -> varinfo -> t + val threadenter: Node.t -> int option -> varinfo -> t end module type Stateful = @@ -30,8 +30,8 @@ sig module D: Lattice.S - val threadenter: t * D.t -> Node.t -> varinfo -> t list - val threadspawn: D.t -> Node.t -> varinfo -> D.t + val threadenter: t * D.t -> Node.t -> int option -> varinfo -> t list + val threadspawn: D.t -> Node.t -> int option -> varinfo -> D.t (** If it is possible to get a list of unique thread create thus far, get it *) val created: t -> D.t -> (t list) option @@ -41,10 +41,22 @@ end (** Type to represent an abstract thread ID. *) module FunNode: Stateless = struct - include Printable.Prod (CilType.Varinfo) (Printable.Option (Node) (struct let name = "no node" end)) + include + Printable.Prod + (CilType.Varinfo) + (Printable.Option + (Printable.Prod + (Node) + (Printable.Option + (Printable.Int) + (struct let name = "no index" end))) + (struct let name = "no node" end)) let show = function - | (f, Some n) -> f.vname ^ "@" ^ (CilType.Location.show (UpdateCil.getLoc n)) + | (f, Some (n, i)) -> + f.vname + ^ "@" ^ (CilType.Location.show (UpdateCil.getLoc n)) + ^ "#" ^ Option.fold ~none:"??" ~some:string_of_int i | (f, None) -> f.vname include Printable.SimpleShow ( @@ -55,12 +67,13 @@ struct ) let threadinit v ~multiple: t = (v, None) - let threadenter l v: t = + let threadenter l i v: t = if GobConfig.get_bool "ana.thread.include-node" then - (v, Some l) + (v, Some (l, i)) else (v, None) + (* shouldn't this check configured mainfun?? *) let is_main = function | ({vname = "main"; _}, None) -> true | _ -> false @@ -77,8 +90,8 @@ struct module D = Lattice.Unit - let threadenter _ n v = [threadenter n v] - let threadspawn () _ _ = () + let threadenter _ n i v = [threadenter n i v] + let threadspawn () _ _ _ = () let created _ _ = None end @@ -145,10 +158,11 @@ struct else ([base_tid], S.empty ()) - let threadenter ((p, _ ) as current, cs) (n: Node.t) v = - let n = Base.threadenter n v in - let ((p', s') as composed) = compose current n in - if is_unique composed && S.mem n cs then + (*x*) + let threadenter ((p, _ ) as current, cs) (n: Node.t) i v = + let n = Base.threadenter n i v in + let ((p', s') as composed) = compose current n in (* todo: use i here *) + if is_unique composed && S.mem n cs then (* todo: use i here *) [(p, S.singleton n); composed] (* also respawn unique version of the thread to keep it reachable while thread ID sets refer to it *) else [composed] @@ -157,8 +171,9 @@ struct let els = D.elements cs in Some (List.map (compose current) els) - let threadspawn cs l v = - S.add (Base.threadenter l v) cs + (*x*) + let threadspawn cs l i v = + S.add (Base.threadenter l i v) cs let is_main = function | ([fl], s) when S.is_empty s && Base.is_main fl -> true @@ -228,24 +243,24 @@ struct | (None, Some x'), `Top -> liftp x' (P.D.top ()) | _ -> None - let threadenter x n v = + let threadenter x n i v = match x with - | ((Some x', None), `Lifted1 d) -> H.threadenter (x',d) n v |> List.map (fun t -> (Some t, None)) - | ((Some x', None), `Bot) -> H.threadenter (x',H.D.bot ()) n v |> List.map (fun t -> (Some t, None)) - | ((Some x', None), `Top) -> H.threadenter (x',H.D.top ()) n v |> List.map (fun t -> (Some t, None)) - | ((None, Some x'), `Lifted2 d) -> P.threadenter (x',d) n v |> List.map (fun t -> (None, Some t)) - | ((None, Some x'), `Bot) -> P.threadenter (x',P.D.bot ()) n v |> List.map (fun t -> (None, Some t)) - | ((None, Some x'), `Top) -> P.threadenter (x',P.D.top ()) n v |> List.map (fun t -> (None, Some t)) + | ((Some x', None), `Lifted1 d) -> H.threadenter (x',d) n i v |> List.map (fun t -> (Some t, None)) + | ((Some x', None), `Bot) -> H.threadenter (x',H.D.bot ()) n i v |> List.map (fun t -> (Some t, None)) + | ((Some x', None), `Top) -> H.threadenter (x',H.D.top ()) n i v |> List.map (fun t -> (Some t, None)) + | ((None, Some x'), `Lifted2 d) -> P.threadenter (x',d) n i v |> List.map (fun t -> (None, Some t)) + | ((None, Some x'), `Bot) -> P.threadenter (x',P.D.bot ()) n i v |> List.map (fun t -> (None, Some t)) + | ((None, Some x'), `Top) -> P.threadenter (x',P.D.top ()) n i v |> List.map (fun t -> (None, Some t)) | _ -> failwith "FlagConfiguredTID received a value where not exactly one component is set" - let threadspawn x n v = + let threadspawn x n i v = match x with - | `Lifted1 x' -> `Lifted1 (H.threadspawn x' n v) - | `Lifted2 x' -> `Lifted2 (P.threadspawn x' n v) - | `Bot when history_enabled () -> `Lifted1 (H.threadspawn (H.D.bot ()) n v) - | `Bot -> `Lifted2 (P.threadspawn (P.D.bot ()) n v) - | `Top when history_enabled () -> `Lifted1 (H.threadspawn (H.D.top ()) n v) - | `Top -> `Lifted2 (P.threadspawn (P.D.top ()) n v) + | `Lifted1 x' -> `Lifted1 (H.threadspawn x' n i v) + | `Lifted2 x' -> `Lifted2 (P.threadspawn x' n i v) + | `Bot when history_enabled () -> `Lifted1 (H.threadspawn (H.D.bot ()) n i v) + | `Bot -> `Lifted2 (P.threadspawn (P.D.bot ()) n i v) + | `Top when history_enabled () -> `Lifted1 (H.threadspawn (H.D.top ()) n i v) + | `Top -> `Lifted2 (P.threadspawn (P.D.top ()) n i v) let name () = "FlagConfiguredTID: " ^ if history_enabled () then H.name () else P.name () end diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index 2cfe49ccb9..e18dae58dc 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -617,3 +617,22 @@ struct let pretty_diff () ((x:t),(y:t)): Pretty.doc = Pretty.dprintf "%a not leq %a" pretty x pretty y end + +(* ints are totally ordered... that's fine. *) +module IntPO : PO with type t = int = struct + include Printable.Int + let leq = (<=) + let join = max + let meet = min + let widen = join + let narrow = meet + let pretty_diff () (x, y) = Pretty.dprintf "%a not leq %a" pretty x pretty y +end + +module LiftedInt = LiftPO (IntPO) (struct let bot_name = "bot" let top_name = "top" end) + +(* todo: 0 is top and bot when n=0 *) +let lifted_of_chain (module Chain : S with type t = int) x = + if Chain.is_bot x then `Bot + else if Chain.is_top x then `Top + else `Lifted x diff --git a/src/domains/printable.ml b/src/domains/printable.ml index 6b4e1ecdf3..38b865ee51 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -594,6 +594,16 @@ struct let relift _ = failwith Message.message end +module Int : S with type t = int = struct + include Std + include Int + let hash = Hashtbl.hash + let show = string_of_int + let pretty () = Pretty.num + let printXml f x = BatPrintf.fprintf f "\n\n%d\n\n\n" x + let name () = "Int" + let to_yojson x = `Int x +end (** Concatenates a list of strings that fit in the given character constraint *) diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 2a9a241398..f71014e61e 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -20,6 +20,7 @@ module NodeFlatLattice = Lattice.Flat (Node) (struct let bot_name = "Unreachable node" end) +module ThreadNodeLattice = Lattice.Prod (NodeFlatLattice) (Lattice.LiftedInt) module VI = Lattice.Flat (Basetype.Variables) (struct let top_name = "Unknown line" @@ -77,7 +78,7 @@ type _ t = | MustBeSingleThreaded: MustBool.t t | MustBeUniqueThread: MustBool.t t | CurrentThreadId: ThreadIdDomain.ThreadLifted.t t - | ThreadId: NodeFlatLattice.t t + | ThreadCreateIndexedNode: ThreadNodeLattice.t t (* ~~todo: name that shows that id is included~~ *) (* todo: indexed node lattice should really be `Lifted (node, `Lifted id) not (`Lifted node, `Lifted id) see *1* *) | MayBeThreadReturn: MayBool.t t | EvalFunvar: exp -> LS.t t | EvalInt: exp -> ID.t t @@ -146,7 +147,7 @@ struct | EvalValue _ -> (module VD) | BlobSize _ -> (module ID) | CurrentThreadId -> (module ThreadIdDomain.ThreadLifted) - | ThreadId -> (module NodeFlatLattice) + | ThreadCreateIndexedNode -> (module ThreadNodeLattice) | HeapVar -> (module VI) | EvalStr _ -> (module SD) | IterPrevVars _ -> (module Unit) @@ -206,7 +207,7 @@ struct | EvalValue _ -> VD.top () | BlobSize _ -> ID.top () | CurrentThreadId -> ThreadIdDomain.ThreadLifted.top () - | ThreadId -> NodeFlatLattice.top () + | ThreadCreateIndexedNode -> ThreadNodeLattice.top () | HeapVar -> VI.top () | EvalStr _ -> SD.top () | IterPrevVars _ -> Unit.top () @@ -255,7 +256,7 @@ struct | Any MustBeSingleThreaded -> 12 | Any MustBeUniqueThread -> 13 | Any CurrentThreadId -> 14 - | Any ThreadId -> 9999999 + | Any ThreadCreateIndexedNode -> 9999999 | Any MayBeThreadReturn -> 15 | Any (EvalFunvar _) -> 16 | Any (EvalInt _) -> 17 @@ -386,7 +387,7 @@ struct | Any MustBeSingleThreaded -> Pretty.dprintf "MustBeSingleThreaded" | Any MustBeUniqueThread -> Pretty.dprintf "MustBeUniqueThread" | Any CurrentThreadId -> Pretty.dprintf "CurrentThreadId" - | Any ThreadId -> Pretty.dprintf "ThreadId" + | Any ThreadCreateIndexedNode -> Pretty.dprintf "ThreadCreateIndexedNode" | Any MayBeThreadReturn -> Pretty.dprintf "MayBeThreadReturn" | Any (EvalFunvar e) -> Pretty.dprintf "EvalFunvar %a" CilType.Exp.pretty e | Any (EvalInt e) -> Pretty.dprintf "EvalInt %a" CilType.Exp.pretty e diff --git a/src/util/debug.ml b/src/util/debug.ml new file mode 100644 index 0000000000..a0ac548b61 --- /dev/null +++ b/src/util/debug.ml @@ -0,0 +1,6 @@ +open GoblintCil + +let f = Printf.sprintf +let pf fmt = Printf.ksprintf print_endline fmt +let df fmt = Pretty.gprintf (Pretty.sprint ~width:max_int) fmt +let dpf fmt = Pretty.gprintf (fun doc -> print_endline @@ Pretty.sprint ~width:max_int doc) fmt diff --git a/tests/regression/66-pthread_create_wrapper/02-unique-counter.c b/tests/regression/66-pthread_create_wrapper/02-unique-counter.c new file mode 100644 index 0000000000..e719868e7c --- /dev/null +++ b/tests/regression/66-pthread_create_wrapper/02-unique-counter.c @@ -0,0 +1,49 @@ +// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.unique_thread_id_count 2 +#include +#include + +// not marked as a wrapper this time: instead, the two calls are given unique IDs +int my_pthread_create( + pthread_t *restrict thread, + const pthread_attr_t *restrict attr, + void *(*start_routine)(void *), + void *restrict arg +) { + return pthread_create(thread, attr, start_routine, arg); +} + +// int my_pthread_create2( +// pthread_t *restrict thread, +// const pthread_attr_t *restrict attr, +// void *(*start_routine)(void *), +// void *restrict arg +// ) { +// return my_pthread_create(thread, attr, start_routine, arg); +// } + +// uncomment to remove the wrapper +// #define my_pthread_create pthread_create + +int g = 0; +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&A); + g = 1; + pthread_mutex_unlock(&A); + return NULL; +} + +int main() { + pthread_t id1; + my_pthread_create(&id1, NULL, t_fun, NULL); + pthread_t id2; + my_pthread_create(&id2, NULL, t_fun, NULL); + + pthread_join(id1, NULL); + pthread_join(id2, NULL); + + g = 2; // NORACE + + return 0; +} From 2d1b0fb69cc2bcc441e9706f18bb105aeb96975c Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 1 May 2023 16:34:34 +0200 Subject: [PATCH 123/518] more work --- src/analyses/threadId.ml | 33 ++++----- src/analyses/wrapperFunctionAnalysis.ml | 74 +++++++++++-------- src/cdomains/threadIdDomain.ml | 53 +++++++------ src/domains/lattice.ml | 6 +- src/domains/queries.ml | 11 +-- src/util/gobList.ml | 7 ++ .../02-unique-counter.c | 9 --- .../03-wrapper-unique-counter.c | 50 +++++++++++++ 8 files changed, 146 insertions(+), 97 deletions(-) create mode 100644 tests/regression/66-pthread_create_wrapper/03-wrapper-unique-counter.c diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index e0ef997d94..1ffad5b3fb 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -7,8 +7,6 @@ open Prelude.Ana open Analyses open GobList.Syntax -open Debug - module Thread = ThreadIdDomain.Thread module ThreadLifted = ThreadIdDomain.ThreadLifted @@ -89,32 +87,27 @@ struct else None - let indexed_node_for_ctx ?(increment=false) ctx = - let ni = ctx.ask Queries.ThreadCreateIndexedNode in (* should this be ctx.prev_node? *) - dpf"%a" Queries.ThreadNodeLattice.pretty ni; - let ni = match ni with - (* would be better if lifted node always had count (see *1* ) *) - | `Lifted node, `Lifted count -> node, Some (if increment then succ count else count) - | `Lifted node, `Bot when increment -> node, Some 1 (* todo: bot and top are both 0, then this should stay None *) + let indexed_node_for_ctx ?(increment = false) ctx = + match ctx.ask (Queries.ThreadCreateIndexedNode increment) with + | `Lifted node, `Lifted count -> node, Some count + | `Lifted node, `Bot -> node, Some 0 | `Lifted node, _ -> node, None - | _ -> ctx.prev_node, None - in - dpf"%a %s" Node.pretty (fst ni) (Stdlib.Option.fold ~some:(f"Some[%d]") ~none:"None" @@ snd ni); - ni + | _ -> ctx.node, None - (* todo: should `f` also come from wrapper?? *) + open Debug let threadenter ctx lval f args = - (* x *) - pf "threadenter"; - let+ tid = create_tid ctx.local (indexed_node_for_ctx ~increment:true ctx |> Tuple2.map2 (Option.map succ)) f in + (* [ctx] here is the same as in [special], i.e. before incrementing the unique-counter; + thus we manually increment here so that it matches with [threadspawn], + where the context does contain the incremented counter *) + let+ tid = create_tid ctx.local (indexed_node_for_ctx ~increment:true ctx) f in + dpf"threadenter tid=%a" Thread.pretty (match tid with `Lifted x -> x | _ -> failwith "ah"); (tid, TD.bot ()) let threadspawn ctx lval f args fctx = - pf "threadspawn"; let (current, td) = ctx.local in let node, index = indexed_node_for_ctx ctx in - (* x *) - (current, Thread.threadspawn td node index f) (* todo *) + dpf"threadspawn tid=%a" (fun () -> function | `Lifted x -> Thread.pretty () x | `Bot -> Pretty.text "bot" | `Top -> Pretty.text "top") current; + (current, Thread.threadspawn td node index f) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) let init (m:marshal option): unit = diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 2a1c21b8e3..95827e4742 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -14,6 +14,7 @@ open Debug module type UniqueCountArgs = sig val unique_count : unit -> int val label : string + val use_previous_node : bool end (* Functor argument for determining wrapper and wrapped functions *) @@ -28,8 +29,14 @@ struct include Analyses.DefaultSpec let dbg = WrapperArgs.is_wrapped (LibraryDesc.ThreadCreate { thread = Cil.integer 1; start_routine = Cil.integer 1; arg = Cil.integer 1; }) + let st name ctx = if dbg then dpf"----------------------------------\n[%s] prev_node=%a => node=%a" name Node.pretty ctx.prev_node Node.pretty ctx.node + + (* TODO: + Does it matter if this is node or prev_node? [malloc] analysis used ctx.node and seemed to care. + Thread ID analysis is using ctx.prev_node (which makes more sense, since that's where the thread_create edge is, + and would keep two wrapper calls apart if they are e.g. both on edges leading into a join point) *) + let node_for_ctx ctx = if UniqueCountArgs.use_previous_node then ctx.prev_node else ctx.node - (* replace this entirely with LiftedChain? then check unique_count in UniqueCallCounter... *) module Chain = Lattice.Chain (struct let n () = let p = UniqueCountArgs.unique_count () in @@ -45,7 +52,7 @@ struct module UniqueCallCounter = struct include MapDomain.MapBot_LiftTop(Q.NodeFlatLattice)(Chain) - (* Increase counter for given node. If it does not exists yet, create it. *) + (* Increase counter for given node. If it does not exist yet, create it. *) let add_unique_call counter node = let unique_call = `Lifted node in let count = find unique_call counter in @@ -78,16 +85,19 @@ struct ctx.local let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = - if dbg then dpf"enter f=<%a>" CilType.Fundec.pretty f; + st "enter" ctx; let counter, wrapper_node = ctx.local in let new_wrapper_node = if Hashtbl.mem wrappers f.svar.vname then begin if dbg then dpf"is wrapper"; match wrapper_node with - | `Lifted _ -> if dbg then dpf"interesting caller, keep caller context"; wrapper_node (* if an interesting callee is called by an interesting caller, then we remember the caller context *) - (* todo: does malloc want prev_node??? *) - | _ -> if dbg then dpf"uninteresting caller, keep callee context";`Lifted ctx.prev_node (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) + (* if an interesting callee is called by an interesting caller, then we remember the caller context *) + | `Lifted _ -> wrapper_node + (* if dbg then dpf"interesting caller, keep caller context"; *) + (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) + | _ -> `Lifted (node_for_ctx ctx) + (* if dbg then dpf"uninteresting caller, keep callee context"; *) end else Q.NodeFlatLattice.top () (* if an uninteresting callee is called, then we forget what was called before *) @@ -104,25 +114,29 @@ struct let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc ((counter, _):D.t) (f_ask: Queries.ask) : D.t = ctx.local - let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = - if dbg then dpf"special f=<%a>" CilType.Varinfo.pretty f; + let add_unique_call ctx = + let counter, wrapper_node = ctx.local in + (* TODO: previously, unique count isn't by wrapper node (e.g. my_malloc_wrapper), but by wrapped node (e.g. malloc). Why, and is it safe to change? *) + (UniqueCallCounter.add_unique_call counter (match wrapper_node with `Lifted node -> node | _ -> node_for_ctx ctx), wrapper_node) + + let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f: varinfo) (arglist:exp list) : D.t = + st "special" ctx; let desc = LibraryFunctions.find f in - if WrapperArgs.is_wrapped @@ desc.special arglist then - let counter, wrapper_node = ctx.local in - (* previously, unique count isn't by wrapper node but by wrapped node. why? *) - (* does malloc want prev_node?? *) - (UniqueCallCounter.add_unique_call counter (match wrapper_node with `Lifted node -> node | _ -> ctx.prev_node), wrapper_node) - else ctx.local + if WrapperArgs.is_wrapped @@ desc.special arglist then add_unique_call ctx else ctx.local let startstate v = D.bot () let threadenter ctx lval f args = - if dbg then dpf"threadenter f=<%a>" CilType.Varinfo.pretty f; + st "threadenter" ctx; + if dbg then dpf" f=%a" CilType.Varinfo.pretty f; (* The new thread receives a fresh counter *) [D.bot ()] let threadspawn ctx lval f args fctx = - if dbg then dpf"threadspawn f=<%a>" CilType.Varinfo.pretty f; ctx.local + st "threadspawn" ctx; + if dbg then dpf" f=%a" CilType.Varinfo.pretty f; + ctx.local + let exitstate v = D.top () type marshal = unit @@ -132,23 +146,17 @@ struct end - -(* module UniqueCountArgsFromConfig (Option : sig val key : string end) : UniqueCountArgs = struct - let unique_count () = get_int Option.key - let label = "Option " ^ Option.key -end *) - (* Create the chain argument-module, given the config key to loop up *) -let unique_count_args_from_config key = (module struct +let unique_count_args_from_config ?(use_previous_node = false) key = (module struct let unique_count () = get_int key let label = "Option " ^ key + let use_previous_node = use_previous_node end : UniqueCountArgs) module MallocWrapper : MCPSpec = struct include SpecBase - (* (UniqueCountArgsFromConfig (struct let key = "ana.malloc.unique_address_count" end)) *) (val unique_count_args_from_config "ana.malloc.unique_address_count") (struct let wrappers () = get_string_list "ana.malloc.wrappers" @@ -181,7 +189,7 @@ module MallocWrapper : MCPSpec = struct | Q.HeapVar -> let node = match wrapper_node with | `Lifted wrapper_node -> wrapper_node - | _ -> ctx.node + | _ -> node_for_ctx ctx in let count = UniqueCallCounter.find (`Lifted node) counter in let var = NodeVarinfoMap.to_varinfo (ctx.ask Q.CurrentThreadId, node, count) in @@ -211,8 +219,7 @@ end module ThreadCreateWrapper : MCPSpec = struct include SpecBase - (* (UniqueCountArgsFromConfig (struct let key = "ana.thread.unique_thread_id_count" end)) *) - (val unique_count_args_from_config "ana.thread.unique_thread_id_count") + (val unique_count_args_from_config ~use_previous_node:true "ana.thread.unique_thread_id_count") (struct let wrappers () = get_string_list "ana.thread.wrappers" @@ -225,18 +232,21 @@ module ThreadCreateWrapper : MCPSpec = struct let name () = "threadCreateWrapper" let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = - let counter, wrapper_node = ctx.local in match q with - | Q.ThreadCreateIndexedNode -> - dpf"query node=<%a> prev_node=<%a>" Node.pretty ctx.node Node.pretty ctx.prev_node; + | Q.ThreadCreateIndexedNode (increment : bool) -> + st "query" ctx; + if dbg then dpf" q=%a increment=%b" Queries.Any.pretty (Queries.Any q) increment; + + let counter, wrapper_node = if increment then add_unique_call ctx else ctx.local in let node = match wrapper_node with | `Lifted wrapper_node -> wrapper_node - | _ -> ctx.prev_node + | _ -> node_for_ctx ctx in let count = Lattice.lifted_of_chain (module Chain) - @@ UniqueCallCounter.find (`Lifted node) counter + @@ max 0 (UniqueCallCounter.find (`Lifted node) counter - 1) in + dpf" thread_create_ni node=%a index=%a" Node.pretty node Lattice.LiftedInt.pretty count; `Lifted node, count | _ -> Queries.Result.top q diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index 9a1ac37b1d..d1d507a4d3 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -1,5 +1,6 @@ open GoblintCil open FlagHelper +open BatPervasives module type S = sig @@ -37,20 +38,21 @@ sig val created: t -> D.t -> (t list) option end +module IndexedFunNodeT = + Printable.Prod + (CilType.Varinfo) + (Printable.Option + (Printable.Prod + (Node) + (Printable.Option + (Printable.Int) + (struct let name = "no index" end))) + (struct let name = "no node" end)) (** Type to represent an abstract thread ID. *) -module FunNode: Stateless = +module FunNode: Stateless with type t = IndexedFunNodeT.t = struct - include - Printable.Prod - (CilType.Varinfo) - (Printable.Option - (Printable.Prod - (Node) - (Printable.Option - (Printable.Int) - (struct let name = "no index" end))) - (struct let name = "no node" end)) + include IndexedFunNodeT let show = function | (f, Some (n, i)) -> @@ -67,15 +69,16 @@ struct ) let threadinit v ~multiple: t = (v, None) + let threadenter l i v: t = if GobConfig.get_bool "ana.thread.include-node" then (v, Some (l, i)) else (v, None) - (* shouldn't this check configured mainfun?? *) let is_main = function - | ({vname = "main"; _}, None) -> true + (* shouldn't this check configured mainfun?? *) + | ({vname; _}, None) -> List.mem vname @@ GobConfig.get_string_list "mainfun" | _ -> false let is_unique _ = false (* TODO: should this consider main unique? *) @@ -139,17 +142,15 @@ struct let may_create (p,s) (p',s') = S.subset (S.union (S.of_list p) s) (S.union (S.of_list p') s') - let compose ((p, s) as current) n = - if BatList.mem_cmp Base.compare n p then ( - (* TODO: can be optimized by implementing some kind of partition_while function *) - let s' = S.of_list (BatList.take_while (fun m -> not (Base.equal n m)) p) in - let p' = List.tl (BatList.drop_while (fun m -> not (Base.equal n m)) p) in - (p', S.add n (S.union s s')) + let compose ((p, s) as current) ni = + if BatList.mem_cmp Base.compare ni p then ( + let shared, unique = GobList.span (not % Base.equal ni) p in + (List.tl unique, S.of_list shared |> S.union s |> S.add ni) ) else if is_unique current then - (n :: p, s) + (ni :: p, s) else - (p, S.add n s) + (p, S.add ni s) let threadinit v ~multiple = let base_tid = Base.threadinit v ~multiple in @@ -158,12 +159,11 @@ struct else ([base_tid], S.empty ()) - (*x*) let threadenter ((p, _ ) as current, cs) (n: Node.t) i v = - let n = Base.threadenter n i v in - let ((p', s') as composed) = compose current n in (* todo: use i here *) - if is_unique composed && S.mem n cs then (* todo: use i here *) - [(p, S.singleton n); composed] (* also respawn unique version of the thread to keep it reachable while thread ID sets refer to it *) + let ni = Base.threadenter n i v in + let ((p', s') as composed) = compose current ni in + if is_unique composed && S.mem ni cs then + [(p, S.singleton ni); composed] (* also respawn unique version of the thread to keep it reachable while thread ID sets refer to it *) else [composed] @@ -171,7 +171,6 @@ struct let els = D.elements cs in Some (List.map (compose current) els) - (*x*) let threadspawn cs l i v = S.add (Base.threadenter l i v) cs diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index e18dae58dc..b9c7180872 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -618,7 +618,6 @@ struct Pretty.dprintf "%a not leq %a" pretty x pretty y end -(* ints are totally ordered... that's fine. *) module IntPO : PO with type t = int = struct include Printable.Int let leq = (<=) @@ -631,8 +630,7 @@ end module LiftedInt = LiftPO (IntPO) (struct let bot_name = "bot" let top_name = "top" end) -(* todo: 0 is top and bot when n=0 *) let lifted_of_chain (module Chain : S with type t = int) x = - if Chain.is_bot x then `Bot - else if Chain.is_top x then `Top + if Chain.is_top x then `Top + else if Chain.is_bot x then `Bot else `Lifted x diff --git a/src/domains/queries.ml b/src/domains/queries.ml index f71014e61e..5f124e7329 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -78,7 +78,7 @@ type _ t = | MustBeSingleThreaded: MustBool.t t | MustBeUniqueThread: MustBool.t t | CurrentThreadId: ThreadIdDomain.ThreadLifted.t t - | ThreadCreateIndexedNode: ThreadNodeLattice.t t (* ~~todo: name that shows that id is included~~ *) (* todo: indexed node lattice should really be `Lifted (node, `Lifted id) not (`Lifted node, `Lifted id) see *1* *) + | ThreadCreateIndexedNode: bool -> ThreadNodeLattice.t t (* todo: indexed node lattice should really be `Lifted (node, `Lifted id) not (`Lifted node, `Lifted id) see *1* *) | MayBeThreadReturn: MayBool.t t | EvalFunvar: exp -> LS.t t | EvalInt: exp -> ID.t t @@ -147,7 +147,7 @@ struct | EvalValue _ -> (module VD) | BlobSize _ -> (module ID) | CurrentThreadId -> (module ThreadIdDomain.ThreadLifted) - | ThreadCreateIndexedNode -> (module ThreadNodeLattice) + | ThreadCreateIndexedNode _ -> (module ThreadNodeLattice) | HeapVar -> (module VI) | EvalStr _ -> (module SD) | IterPrevVars _ -> (module Unit) @@ -207,7 +207,7 @@ struct | EvalValue _ -> VD.top () | BlobSize _ -> ID.top () | CurrentThreadId -> ThreadIdDomain.ThreadLifted.top () - | ThreadCreateIndexedNode -> ThreadNodeLattice.top () + | ThreadCreateIndexedNode _ -> ThreadNodeLattice.top () | HeapVar -> VI.top () | EvalStr _ -> SD.top () | IterPrevVars _ -> Unit.top () @@ -256,7 +256,7 @@ struct | Any MustBeSingleThreaded -> 12 | Any MustBeUniqueThread -> 13 | Any CurrentThreadId -> 14 - | Any ThreadCreateIndexedNode -> 9999999 + | Any ThreadCreateIndexedNode _ -> 9999999 | Any MayBeThreadReturn -> 15 | Any (EvalFunvar _) -> 16 | Any (EvalInt _) -> 17 @@ -329,6 +329,7 @@ struct | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 + | Any (ThreadCreateIndexedNode inc1), Any (ThreadCreateIndexedNode inc2) -> compare inc1 inc2 (* only argumentless queries should remain *) | _, _ -> Stdlib.compare (order a) (order b) @@ -387,7 +388,7 @@ struct | Any MustBeSingleThreaded -> Pretty.dprintf "MustBeSingleThreaded" | Any MustBeUniqueThread -> Pretty.dprintf "MustBeUniqueThread" | Any CurrentThreadId -> Pretty.dprintf "CurrentThreadId" - | Any ThreadCreateIndexedNode -> Pretty.dprintf "ThreadCreateIndexedNode" + | Any (ThreadCreateIndexedNode inc) -> Pretty.dprintf "ThreadCreateIndexedNode %b" inc | Any MayBeThreadReturn -> Pretty.dprintf "MayBeThreadReturn" | Any (EvalFunvar e) -> Pretty.dprintf "EvalFunvar %a" CilType.Exp.pretty e | Any (EvalInt e) -> Pretty.dprintf "EvalInt %a" CilType.Exp.pretty e diff --git a/src/util/gobList.ml b/src/util/gobList.ml index 3743b0127e..ee6e6e7b19 100644 --- a/src/util/gobList.ml +++ b/src/util/gobList.ml @@ -30,6 +30,13 @@ let rec fold_while_some (f : 'a -> 'b -> 'a option) (acc: 'a) (xs: 'b list): 'a let equal = List.eq +(** [span p xs] is [take_while p xs, drop_while p xs] but may be more efficient *) +let span p = + let rec span_helper prefix = function + | x :: xs when p x -> span_helper (x :: prefix) xs + | suffix -> List.rev prefix, suffix + in span_helper [] + (** Given a predicate and a list, returns two lists [(l1, l2)]. [l1] contains the prefix of the list until the last element that satisfies the predicate, [l2] contains all subsequent elements. The order of elements is preserved. *) let until_last_with (pred: 'a -> bool) (xs: 'a list) = diff --git a/tests/regression/66-pthread_create_wrapper/02-unique-counter.c b/tests/regression/66-pthread_create_wrapper/02-unique-counter.c index e719868e7c..81d39137de 100644 --- a/tests/regression/66-pthread_create_wrapper/02-unique-counter.c +++ b/tests/regression/66-pthread_create_wrapper/02-unique-counter.c @@ -12,15 +12,6 @@ int my_pthread_create( return pthread_create(thread, attr, start_routine, arg); } -// int my_pthread_create2( -// pthread_t *restrict thread, -// const pthread_attr_t *restrict attr, -// void *(*start_routine)(void *), -// void *restrict arg -// ) { -// return my_pthread_create(thread, attr, start_routine, arg); -// } - // uncomment to remove the wrapper // #define my_pthread_create pthread_create diff --git a/tests/regression/66-pthread_create_wrapper/03-wrapper-unique-counter.c b/tests/regression/66-pthread_create_wrapper/03-wrapper-unique-counter.c new file mode 100644 index 0000000000..3f41ff88aa --- /dev/null +++ b/tests/regression/66-pthread_create_wrapper/03-wrapper-unique-counter.c @@ -0,0 +1,50 @@ +// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.wrappers[+] my_pthread_create --set ana.thread.unique_thread_id_count 2 +#include +#include + +// mark this as a wrapper, which is called multiple times in the same place +int my_pthread_create( + pthread_t *restrict thread, + const pthread_attr_t *restrict attr, + void *(*start_routine)(void *), + void *restrict arg +) { + return pthread_create(thread, attr, start_routine, arg); +} + +// this is not marked as a wrapper; instead each call to my_pthread_create is given a unique ID +int my_other_pthread_create( + pthread_t *restrict thread, + const pthread_attr_t *restrict attr, + void *(*start_routine)(void *), + void *restrict arg +) { + return my_pthread_create(thread, attr, start_routine, arg); +} + +// uncomment to remove the wrapper +// #define my_other_pthread_create pthread_create + +int g = 0; +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&A); + g = 1; + pthread_mutex_unlock(&A); + return NULL; +} + +int main() { + pthread_t id1; + my_other_pthread_create(&id1, NULL, t_fun, NULL); + pthread_t id2; + my_other_pthread_create(&id2, NULL, t_fun, NULL); + + pthread_join(id1, NULL); + pthread_join(id2, NULL); + + g = 2; // NORACE + + return 0; +} From cef41b31b6e25a69d13e4184c09a38455bdd3dcd Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 1 May 2023 17:26:47 +0200 Subject: [PATCH 124/518] add reference to commit --- src/analyses/wrapperFunctionAnalysis.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 95827e4742..ca0e61a37a 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -34,7 +34,9 @@ struct (* TODO: Does it matter if this is node or prev_node? [malloc] analysis used ctx.node and seemed to care. Thread ID analysis is using ctx.prev_node (which makes more sense, since that's where the thread_create edge is, - and would keep two wrapper calls apart if they are e.g. both on edges leading into a join point) *) + and would keep two wrapper calls apart if they are e.g. both on edges leading into a join point) + https://github.com/goblint/analyzer/commit/77c0423640c50bb82e4290bcc97f33d4082715d0 + *) let node_for_ctx ctx = if UniqueCountArgs.use_previous_node then ctx.prev_node else ctx.node module Chain = Lattice.Chain (struct From b9e4129e021568c6b08b304ee237a83ae7a06a61 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 1 May 2023 17:59:32 +0200 Subject: [PATCH 125/518] fix queries --- src/domains/printable.ml | 1 + src/domains/queries.ml | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/domains/printable.ml b/src/domains/printable.ml index 38b865ee51..0f92cb01d9 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -603,6 +603,7 @@ module Int : S with type t = int = struct let printXml f x = BatPrintf.fprintf f "\n\n%d\n\n\n" x let name () = "Int" let to_yojson x = `Int x + let relift x = x end (** Concatenates a list of strings that diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 5f124e7329..aa8f9e4c46 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -78,7 +78,7 @@ type _ t = | MustBeSingleThreaded: MustBool.t t | MustBeUniqueThread: MustBool.t t | CurrentThreadId: ThreadIdDomain.ThreadLifted.t t - | ThreadCreateIndexedNode: bool -> ThreadNodeLattice.t t (* todo: indexed node lattice should really be `Lifted (node, `Lifted id) not (`Lifted node, `Lifted id) see *1* *) + | ThreadCreateIndexedNode: bool -> ThreadNodeLattice.t t (* TODO: indexed node lattice should really be `Lifted (node, `Lifted id) not (`Lifted node, `Lifted id) see *1* *) | MayBeThreadReturn: MayBool.t t | EvalFunvar: exp -> LS.t t | EvalInt: exp -> ID.t t @@ -256,7 +256,6 @@ struct | Any MustBeSingleThreaded -> 12 | Any MustBeUniqueThread -> 13 | Any CurrentThreadId -> 14 - | Any ThreadCreateIndexedNode _ -> 9999999 | Any MayBeThreadReturn -> 15 | Any (EvalFunvar _) -> 16 | Any (EvalInt _) -> 17 @@ -287,6 +286,7 @@ struct | Any ActiveJumpBuf -> 46 | Any ValidLongJmp -> 47 | Any (MayBeModifiedSinceSetjmp _) -> 48 + | Any ThreadCreateIndexedNode _ -> 49 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -303,6 +303,7 @@ struct | Any (MayBePublic x1), Any (MayBePublic x2) -> compare_maybepublic x1 x2 | Any (MayBePublicWithout x1), Any (MayBePublicWithout x2) -> compare_maybepublicwithout x1 x2 | Any (MustBeProtectedBy x1), Any (MustBeProtectedBy x2) -> compare_mustbeprotectedby x1 x2 + | Any (ThreadCreateIndexedNode inc1), Any (ThreadCreateIndexedNode inc2) -> Bool.compare inc1 inc2 | Any (EvalFunvar e1), Any (EvalFunvar e2) -> CilType.Exp.compare e1 e2 | Any (EvalInt e1), Any (EvalInt e2) -> CilType.Exp.compare e1 e2 | Any (EvalStr e1), Any (EvalStr e2) -> CilType.Exp.compare e1 e2 @@ -329,7 +330,6 @@ struct | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 - | Any (ThreadCreateIndexedNode inc1), Any (ThreadCreateIndexedNode inc2) -> compare inc1 inc2 (* only argumentless queries should remain *) | _, _ -> Stdlib.compare (order a) (order b) From 61d15d14a78ab20e153c898552553ef03f0d6eba Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Tue, 2 May 2023 19:28:57 +0200 Subject: [PATCH 126/518] fix new and old global mix-up --- src/incremental/compareCIL.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index c61d74c627..bdb490c096 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -2,7 +2,7 @@ open GoblintCil open MyCFG include CompareAST include CompareCFG -open CilMaps +include CilMaps module GlobalMap = Map.Make(String) @@ -217,7 +217,7 @@ let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old let var_glob_new = GlobalMap.fold extract_globs newMap VarinfoMap.empty in let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> let gc_old = VarinfoMap.find f_old_var var_glob_old in - let gc_new = VarinfoMap.find f_old_var var_glob_new in + let gc_new = VarinfoMap.find f_new_var var_glob_new in let f_old = get_fundec gc_old in let f_new = get_fundec gc_new in (* TODO: what happens if there exists no fundec for this varinfo? *) if acc then From ab075472594ebfdbdad12c3846b56bccf259f37d Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Tue, 2 May 2023 21:59:46 +0200 Subject: [PATCH 127/518] Registering library functions strcat and strstr --- src/analyses/libraryDesc.ml | 4 +++- src/analyses/libraryFunctions.ml | 10 +++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index 9391771515..9e08235f4b 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -59,8 +59,10 @@ type special = | Memset of { dest: Cil.exp; ch: Cil.exp; count: Cil.exp; } | Bzero of { dest: Cil.exp; count: Cil.exp; } | Memcpy of { dest: Cil.exp; src: Cil.exp } - | Strcpy of { dest: Cil.exp; src: Cil.exp } (* TODO: add count for strncpy when actually used *) + | Strcpy of { dest: Cil.exp; src: Cil.exp; } (* TODO: add count for strncpy when actually used *) + | Strcat of { dest: Cil.exp; src: Cil.exp; } | Strlen of Cil.exp + | Strstr of { haystack: Cil.exp; needle: Cil.exp; } | Abort | Identity of Cil.exp (** Identity function. Some compiler optimization annotation functions map to this. *) | Setjmp of { env: Cil.exp; } diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 57149bc207..6ba4257abd 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -14,9 +14,12 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("memcpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Memcpy { dest; src }); ("__builtin_memcpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Memcpy { dest; src }); ("__builtin___memcpy_chk", special [__ "dest" [w]; __ "src" [r]; drop "n" []; drop "os" []] @@ fun dest src -> Memcpy { dest; src }); - ("strncpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Strcpy { dest; src }); - ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src }); + ("strncpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Strcpy { dest; src; }); + ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; }); + ("strncat", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Strcat { dest; src; }); + ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; }); ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); + ("strstr", special [__ "haystack" [r]; __ "needle" [r]] @@ fun haystack needle -> Strstr { haystack; needle; }); ("malloc", special [__ "size" []] @@ fun size -> Malloc size); ("realloc", special [__ "ptr" [r; f]; __ "size" []] @@ fun ptr size -> Realloc { ptr; size }); ("abort", special [] Abort); @@ -672,8 +675,6 @@ let invalidate_actions = [ "strcmp", readsAll;(*safe*) "strftime", writes [1];(*keep [1]*) "strncmp", readsAll;(*safe*) - "strncat", writes [1];(*keep [1]*) - "strstr", readsAll;(*safe*) "strdup", readsAll;(*safe*) "toupper", readsAll;(*safe*) "tolower", readsAll;(*safe*) @@ -743,7 +744,6 @@ let invalidate_actions = [ "__builtin_strchr", readsAll;(*safe*) "__builtin___strcpy", writes [1];(*keep [1]*) "__builtin___strcpy_chk", writes [1];(*keep [1]*) - "strcat", writes [1];(*keep [1]*) "strtok", readsAll;(*safe*) "getpgrp", readsAll;(*safe*) "umount2", readsAll;(*safe*) From 72065a554a267029b6e4e4824c1de1c8e580b47d Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Wed, 3 May 2023 10:11:56 +0200 Subject: [PATCH 128/518] handle functions without definitions in exact comparison --- src/incremental/compareCIL.ml | 56 ++++++++++++++++++----------------- 1 file changed, 29 insertions(+), 27 deletions(-) diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index bdb490c096..709fc9b8bb 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -25,10 +25,6 @@ let get_varinfo gc = match gc.decls, gc.def with | Some v, _ -> v | _ -> failwith "A global should have at least a declaration or a definition" -let get_fundec gc = match gc.decls, gc.def with - | _, Some (Fun f) -> f - | _ -> failwith "Global does not have a function definition" - module GlobalColMap = Map.Make( struct type t = global_col @@ -181,26 +177,34 @@ let eqF (old: Cil.fundec) (current: Cil.fundec) (cfgs : (cfg * (cfg * cfg)) opti in identical, diffOpt, renamed_method_dependencies, renamed_global_vars_dependencies, renamesOnSuccess -let eqF_only_consider_exact_match f1 f2 change_info final_matches oldMap newMap gc_old gc_new = - if already_matched f1.svar f2.svar final_matches then - (* check if this function was already matched and lookup the result *) - change_info_lookup gc_old gc_new change_info, change_info, final_matches - else if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then - (* check that names of match are each only contained in new or old file *) - false, change_info, final_matches - else - (* the exact comparison is always uses the AST comparison because only when unchanged this match is manifested *) - let doMatch, diff, fun_deps, global_deps, renamesOnSuccess = eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in - match doMatch with - | Unchanged when empty_rename_assms (VarinfoMap.filter (fun vo vn -> not (vo.vname = f1.svar.vname && vn.vname = f2.svar.vname)) fun_deps) && empty_rename_assms global_deps -> - performRenames renamesOnSuccess; - change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; - let final_matches = addToFinalMatchesMapping f1.svar f2.svar final_matches in - true, change_info, final_matches - | Unchanged -> false, change_info, final_matches - | Changed -> false, change_info, final_matches - | ChangedFunHeader _ -> false, change_info, final_matches - | ForceReanalyze _ -> false, change_info, final_matches +let eqF_only_consider_exact_match gc_old gc_new change_info final_matches oldMap newMap = + match gc_old.def, gc_new.def with + | None, None -> ( + match gc_old.decls, gc_new.decls with + | Some old_var, Some new_var -> + compare_varinfo_exact old_var gc_old oldMap new_var gc_new newMap change_info final_matches + | _ -> failwith "A global collection should never be empty") + | Some (Fun f1), Some (Fun f2) -> ( + if already_matched f1.svar f2.svar final_matches then + (* check if this function was already matched and lookup the result *) + change_info_lookup gc_old gc_new change_info, change_info, final_matches + else if not (preservesSameNameMatches f1.svar.vname oldMap f2.svar.vname newMap) then + (* check that names of match are each only contained in new or old file *) + false, change_info, final_matches + else + (* the exact comparison is always uses the AST comparison because only when unchanged this match is manifested *) + let doMatch, diff, fun_deps, global_deps, renamesOnSuccess = eqF f1 f2 None VarinfoMap.empty VarinfoMap.empty in + match doMatch with + | Unchanged when empty_rename_assms (VarinfoMap.filter (fun vo vn -> not (vo.vname = f1.svar.vname && vn.vname = f2.svar.vname)) fun_deps) && empty_rename_assms global_deps -> + performRenames renamesOnSuccess; + change_info.unchanged <- {old = gc_old; current = gc_new} :: change_info.unchanged; + let final_matches = addToFinalMatchesMapping f1.svar f2.svar final_matches in + true, change_info, final_matches + | Unchanged -> false, change_info, final_matches + | Changed -> false, change_info, final_matches + | ChangedFunHeader _ -> false, change_info, final_matches + | ForceReanalyze _ -> false, change_info, final_matches) + | _, _ -> false, change_info, final_matches let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old gc_new (change_info, final_matches) = let doMatch, diff, function_dependencies, global_var_dependencies, renamesOnSuccess = eqF f1 f2 cfgs VarinfoMap.empty VarinfoMap.empty in @@ -218,10 +222,8 @@ let eqF_check_contained_renames ~renameDetection f1 f2 oldMap newMap cfgs gc_old let funDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun f_old_var f_new_var (acc, ci, fm) -> let gc_old = VarinfoMap.find f_old_var var_glob_old in let gc_new = VarinfoMap.find f_new_var var_glob_new in - let f_old = get_fundec gc_old in - let f_new = get_fundec gc_new in (* TODO: what happens if there exists no fundec for this varinfo? *) if acc then - eqF_only_consider_exact_match f_old f_new ci fm oldMap newMap gc_old gc_new + eqF_only_consider_exact_match gc_old gc_new ci fm oldMap newMap else false, ci, fm ) function_dependencies (true, change_info, final_matches) in let globalDependenciesMatch, change_info, final_matches = VarinfoMap.fold (fun old_var new_var (acc, ci, fm) -> From baffd93c846387472d81bef31036642629635b43 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 11:41:49 +0200 Subject: [PATCH 129/518] remove debugging code --- src/analyses/threadId.ml | 3 --- src/analyses/wrapperFunctionAnalysis.ml | 27 +------------------------ src/util/debug.ml | 6 ------ 3 files changed, 1 insertion(+), 35 deletions(-) delete mode 100644 src/util/debug.ml diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index 1ffad5b3fb..c6575b2651 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -94,19 +94,16 @@ struct | `Lifted node, _ -> node, None | _ -> ctx.node, None - open Debug let threadenter ctx lval f args = (* [ctx] here is the same as in [special], i.e. before incrementing the unique-counter; thus we manually increment here so that it matches with [threadspawn], where the context does contain the incremented counter *) let+ tid = create_tid ctx.local (indexed_node_for_ctx ~increment:true ctx) f in - dpf"threadenter tid=%a" Thread.pretty (match tid with `Lifted x -> x | _ -> failwith "ah"); (tid, TD.bot ()) let threadspawn ctx lval f args fctx = let (current, td) = ctx.local in let node, index = indexed_node_for_ctx ctx in - dpf"threadspawn tid=%a" (fun () -> function | `Lifted x -> Thread.pretty () x | `Bot -> Pretty.text "bot" | `Top -> Pretty.text "top") current; (current, Thread.threadspawn td node index f) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index ca0e61a37a..42fe84b424 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -8,8 +8,6 @@ open GobConfig open ThreadIdDomain module Q = Queries -open Debug - (* Functor argument for creating the chain lattice of unique calls *) module type UniqueCountArgs = sig val unique_count : unit -> int @@ -27,9 +25,6 @@ end module SpecBase (UniqueCountArgs : UniqueCountArgs) (WrapperArgs : WrapperArgs) = struct include Analyses.DefaultSpec - - let dbg = WrapperArgs.is_wrapped (LibraryDesc.ThreadCreate { thread = Cil.integer 1; start_routine = Cil.integer 1; arg = Cil.integer 1; }) - let st name ctx = if dbg then dpf"----------------------------------\n[%s] prev_node=%a => node=%a" name Node.pretty ctx.prev_node Node.pretty ctx.node (* TODO: Does it matter if this is node or prev_node? [malloc] analysis used ctx.node and seemed to care. @@ -58,13 +53,10 @@ struct let add_unique_call counter node = let unique_call = `Lifted node in let count = find unique_call counter in - let c' = if Chain.is_top count then + if Chain.is_top count then counter else remove unique_call counter |> add unique_call (count + 1) - in - if dbg then dpf"add_unique_call node=<%a> count_before=%d count_after=%d" Node.pretty node count (find unique_call c'); - c' end module D = Lattice.Prod (UniqueCallCounter) (Q.NodeFlatLattice) @@ -83,24 +75,17 @@ struct ctx.local let return ctx (exp:exp option) (f:fundec) : D.t = - if dbg then dpf"return f=<%a>" CilType.Fundec.pretty f; ctx.local let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = - st "enter" ctx; let counter, wrapper_node = ctx.local in let new_wrapper_node = if Hashtbl.mem wrappers f.svar.vname then - begin - if dbg then dpf"is wrapper"; match wrapper_node with (* if an interesting callee is called by an interesting caller, then we remember the caller context *) | `Lifted _ -> wrapper_node - (* if dbg then dpf"interesting caller, keep caller context"; *) (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) | _ -> `Lifted (node_for_ctx ctx) - (* if dbg then dpf"uninteresting caller, keep callee context"; *) - end else Q.NodeFlatLattice.top () (* if an uninteresting callee is called, then we forget what was called before *) in @@ -108,7 +93,6 @@ struct [(ctx.local, callee)] let combine_env ctx lval fexp f args fc (counter, _) f_ask = - if dbg then dpf"combine f=<%a>" CilType.Fundec.pretty f; (* Keep (potentially higher) counter from callee and keep wrapper node from caller *) let _, lnode = ctx.local in (counter, lnode) @@ -122,21 +106,16 @@ struct (UniqueCallCounter.add_unique_call counter (match wrapper_node with `Lifted node -> node | _ -> node_for_ctx ctx), wrapper_node) let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f: varinfo) (arglist:exp list) : D.t = - st "special" ctx; let desc = LibraryFunctions.find f in if WrapperArgs.is_wrapped @@ desc.special arglist then add_unique_call ctx else ctx.local let startstate v = D.bot () let threadenter ctx lval f args = - st "threadenter" ctx; - if dbg then dpf" f=%a" CilType.Varinfo.pretty f; (* The new thread receives a fresh counter *) [D.bot ()] let threadspawn ctx lval f args fctx = - st "threadspawn" ctx; - if dbg then dpf" f=%a" CilType.Varinfo.pretty f; ctx.local let exitstate v = D.top () @@ -236,9 +215,6 @@ module ThreadCreateWrapper : MCPSpec = struct let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = match q with | Q.ThreadCreateIndexedNode (increment : bool) -> - st "query" ctx; - if dbg then dpf" q=%a increment=%b" Queries.Any.pretty (Queries.Any q) increment; - let counter, wrapper_node = if increment then add_unique_call ctx else ctx.local in let node = match wrapper_node with | `Lifted wrapper_node -> wrapper_node @@ -248,7 +224,6 @@ module ThreadCreateWrapper : MCPSpec = struct Lattice.lifted_of_chain (module Chain) @@ max 0 (UniqueCallCounter.find (`Lifted node) counter - 1) in - dpf" thread_create_ni node=%a index=%a" Node.pretty node Lattice.LiftedInt.pretty count; `Lifted node, count | _ -> Queries.Result.top q diff --git a/src/util/debug.ml b/src/util/debug.ml deleted file mode 100644 index a0ac548b61..0000000000 --- a/src/util/debug.ml +++ /dev/null @@ -1,6 +0,0 @@ -open GoblintCil - -let f = Printf.sprintf -let pf fmt = Printf.ksprintf print_endline fmt -let df fmt = Pretty.gprintf (Pretty.sprint ~width:max_int) fmt -let dpf fmt = Pretty.gprintf (fun doc -> print_endline @@ Pretty.sprint ~width:max_int doc) fmt From b2624c89f272db318c10c157b4ca2d082c6b44d4 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 11:52:33 +0200 Subject: [PATCH 130/518] use prev_node in both malloc and thread create analyses --- src/analyses/threadId.ml | 3 ++- src/analyses/wrapperFunctionAnalysis.ml | 21 +++++++++------------ 2 files changed, 11 insertions(+), 13 deletions(-) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index c6575b2651..7ab04bbbb9 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -87,12 +87,13 @@ struct else None + (** get the node that identifies the current context, possibly that of a wrapper function *) let indexed_node_for_ctx ?(increment = false) ctx = match ctx.ask (Queries.ThreadCreateIndexedNode increment) with | `Lifted node, `Lifted count -> node, Some count | `Lifted node, `Bot -> node, Some 0 | `Lifted node, _ -> node, None - | _ -> ctx.node, None + | _ -> ctx.prev_node, None let threadenter ctx lval f args = (* [ctx] here is the same as in [special], i.e. before incrementing the unique-counter; diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 42fe84b424..aa4f14378e 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -12,7 +12,6 @@ module Q = Queries module type UniqueCountArgs = sig val unique_count : unit -> int val label : string - val use_previous_node : bool end (* Functor argument for determining wrapper and wrapped functions *) @@ -25,14 +24,13 @@ end module SpecBase (UniqueCountArgs : UniqueCountArgs) (WrapperArgs : WrapperArgs) = struct include Analyses.DefaultSpec - - (* TODO: - Does it matter if this is node or prev_node? [malloc] analysis used ctx.node and seemed to care. - Thread ID analysis is using ctx.prev_node (which makes more sense, since that's where the thread_create edge is, - and would keep two wrapper calls apart if they are e.g. both on edges leading into a join point) - https://github.com/goblint/analyzer/commit/77c0423640c50bb82e4290bcc97f33d4082715d0 - *) - let node_for_ctx ctx = if UniqueCountArgs.use_previous_node then ctx.prev_node else ctx.node + + (* Use the previous CFG node (ctx.prev_node) for identifying calls to (wrapper) functions. + For one, this is the node that typically contains the call as its statement. + Additionally, it distinguishes two calls that share the next CFG node (ctx.node), e.g.: + if (cond) { x = malloc(1); } else { x = malloc(2); } + Introduce a function for this to keep things consistent. *) + let node_for_ctx ctx = ctx.prev_node module Chain = Lattice.Chain (struct let n () = @@ -128,10 +126,9 @@ struct end (* Create the chain argument-module, given the config key to loop up *) -let unique_count_args_from_config ?(use_previous_node = false) key = (module struct +let unique_count_args_from_config key = (module struct let unique_count () = get_int key let label = "Option " ^ key - let use_previous_node = use_previous_node end : UniqueCountArgs) @@ -200,7 +197,7 @@ end module ThreadCreateWrapper : MCPSpec = struct include SpecBase - (val unique_count_args_from_config ~use_previous_node:true "ana.thread.unique_thread_id_count") + (val unique_count_args_from_config "ana.thread.unique_thread_id_count") (struct let wrappers () = get_string_list "ana.thread.wrappers" From 26413e00c2a1a770258441e9ba139a7f4d274cf7 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 12:03:09 +0200 Subject: [PATCH 131/518] move tests --- .../01-wrapper.c | 0 .../02-unique-counter.c | 0 .../03-wrapper-unique-counter.c | 0 3 files changed, 0 insertions(+), 0 deletions(-) rename tests/regression/{66-pthread_create_wrapper => 71-thread_create_wrapper}/01-wrapper.c (100%) rename tests/regression/{66-pthread_create_wrapper => 71-thread_create_wrapper}/02-unique-counter.c (100%) rename tests/regression/{66-pthread_create_wrapper => 71-thread_create_wrapper}/03-wrapper-unique-counter.c (100%) diff --git a/tests/regression/66-pthread_create_wrapper/01-wrapper.c b/tests/regression/71-thread_create_wrapper/01-wrapper.c similarity index 100% rename from tests/regression/66-pthread_create_wrapper/01-wrapper.c rename to tests/regression/71-thread_create_wrapper/01-wrapper.c diff --git a/tests/regression/66-pthread_create_wrapper/02-unique-counter.c b/tests/regression/71-thread_create_wrapper/02-unique-counter.c similarity index 100% rename from tests/regression/66-pthread_create_wrapper/02-unique-counter.c rename to tests/regression/71-thread_create_wrapper/02-unique-counter.c diff --git a/tests/regression/66-pthread_create_wrapper/03-wrapper-unique-counter.c b/tests/regression/71-thread_create_wrapper/03-wrapper-unique-counter.c similarity index 100% rename from tests/regression/66-pthread_create_wrapper/03-wrapper-unique-counter.c rename to tests/regression/71-thread_create_wrapper/03-wrapper-unique-counter.c From bae48500a4734e482a9e4beeaf2c3499bff2b075 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 12:07:26 +0200 Subject: [PATCH 132/518] remove TODO --- src/analyses/wrapperFunctionAnalysis.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index aa4f14378e..c4aa26ceff 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -100,8 +100,9 @@ struct let add_unique_call ctx = let counter, wrapper_node = ctx.local in - (* TODO: previously, unique count isn't by wrapper node (e.g. my_malloc_wrapper), but by wrapped node (e.g. malloc). Why, and is it safe to change? *) - (UniqueCallCounter.add_unique_call counter (match wrapper_node with `Lifted node -> node | _ -> node_for_ctx ctx), wrapper_node) + (* track the unique ID per call to the wrapper function, not to the wrapped function *) + (UniqueCallCounter.add_unique_call counter + (match wrapper_node with `Lifted node -> node | _ -> node_for_ctx ctx), wrapper_node) let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f: varinfo) (arglist:exp list) : D.t = let desc = LibraryFunctions.find f in From 8e1c7ee0b2b057b54929daf7f983a61564f630f9 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 12:12:24 +0200 Subject: [PATCH 133/518] remove module type annotations --- src/cdomains/threadIdDomain.ml | 24 ++++++++++++------------ src/domains/printable.ml | 2 +- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index d1d507a4d3..6d3c675f21 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -38,21 +38,21 @@ sig val created: t -> D.t -> (t list) option end -module IndexedFunNodeT = - Printable.Prod - (CilType.Varinfo) - (Printable.Option - (Printable.Prod - (Node) - (Printable.Option - (Printable.Int) - (struct let name = "no index" end))) - (struct let name = "no node" end)) + (** Type to represent an abstract thread ID. *) -module FunNode: Stateless with type t = IndexedFunNodeT.t = +module FunNode: Stateless = struct - include IndexedFunNodeT + include + Printable.Prod + (CilType.Varinfo) + (Printable.Option + (Printable.Prod + (Node) + (Printable.Option + (Printable.Int) + (struct let name = "no index" end))) + (struct let name = "no node" end)) let show = function | (f, Some (n, i)) -> diff --git a/src/domains/printable.ml b/src/domains/printable.ml index 0f92cb01d9..de2f2e1a48 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -470,7 +470,7 @@ module type ChainParams = sig val names: int -> string end -module Chain (P: ChainParams): S with type t = int = +module Chain (P: ChainParams) = struct type t = int [@@deriving eq, ord, hash] include StdLeaf From 06bb1ebc96946490155a91e3768959b6916de47c Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 12:12:36 +0200 Subject: [PATCH 134/518] remove TODO --- src/domains/queries.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/domains/queries.ml b/src/domains/queries.ml index aa8f9e4c46..92173fcb4c 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -14,7 +14,6 @@ module ES = SetDomain.Reverse (SetDomain.ToppedSet (CilType.Exp) (struct let top module VS = SetDomain.ToppedSet (CilType.Varinfo) (struct let topname = "All" end) -(* TODO: where to put this *) module NodeFlatLattice = Lattice.Flat (Node) (struct let top_name = "Unknown node" let bot_name = "Unreachable node" From 21c18d71b51c3557549320d2b2f4b22d539a4dbe Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 15:19:45 +0200 Subject: [PATCH 135/518] properly track previous counter values to account for different context in threadcreate and threadspawn --- src/analyses/threadId.ml | 14 +++++----- src/analyses/wrapperFunctionAnalysis.ml | 36 ++++++++++++------------- src/domains/lattice.ml | 1 + src/domains/queries.ml | 2 +- 4 files changed, 27 insertions(+), 26 deletions(-) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index 7ab04bbbb9..d3ca4ce075 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -88,23 +88,23 @@ struct None (** get the node that identifies the current context, possibly that of a wrapper function *) - let indexed_node_for_ctx ?(increment = false) ctx = - match ctx.ask (Queries.ThreadCreateIndexedNode increment) with + let indexed_node_for_ctx ?(previous = false) ctx = + match ctx.ask (Queries.ThreadCreateIndexedNode previous) with | `Lifted node, `Lifted count -> node, Some count | `Lifted node, `Bot -> node, Some 0 | `Lifted node, _ -> node, None | _ -> ctx.prev_node, None let threadenter ctx lval f args = - (* [ctx] here is the same as in [special], i.e. before incrementing the unique-counter; - thus we manually increment here so that it matches with [threadspawn], - where the context does contain the incremented counter *) - let+ tid = create_tid ctx.local (indexed_node_for_ctx ~increment:true ctx) f in + (* [ctx] here is the same as in [special], i.e. before incrementing the unique-counter, + thus we want the current counter (previous: false) *) + let+ tid = create_tid ctx.local (indexed_node_for_ctx ctx) f in (tid, TD.bot ()) let threadspawn ctx lval f args fctx = let (current, td) = ctx.local in - let node, index = indexed_node_for_ctx ctx in + (* here we see the updated counter, so we want the previous counter value *) + let node, index = indexed_node_for_ctx ~previous:true ctx in (current, Thread.threadspawn td node index f) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index c4aa26ceff..634adb37c4 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -43,18 +43,19 @@ struct end) - (* Map for counting function call node visits up to n (of the current thread). *) + (* Map for counting function call node visits up to n (of the current thread). + Also keep track of the value before the most recent change for a given key. *) module UniqueCallCounter = struct - include MapDomain.MapBot_LiftTop(Q.NodeFlatLattice)(Chain) + include MapDomain.MapBot_LiftTop(Q.NodeFlatLattice)(Lattice.Prod (Chain) (Chain)) (* Increase counter for given node. If it does not exist yet, create it. *) let add_unique_call counter node = let unique_call = `Lifted node in - let count = find unique_call counter in - if Chain.is_top count then - counter - else - remove unique_call counter |> add unique_call (count + 1) + let (count0, count) = find unique_call counter in + let count' = if Chain.is_top count then count else count + 1 in + (* if the old count, the current count, and the new count are all the same, nothing to do *) + if count0 = count && count = count' then counter + else remove unique_call counter |> add unique_call (count, count') end module D = Lattice.Prod (UniqueCallCounter) (Q.NodeFlatLattice) @@ -95,14 +96,15 @@ struct let _, lnode = ctx.local in (counter, lnode) - let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc ((counter, _):D.t) (f_ask: Queries.ask) : D.t = + let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (_:D.t) (f_ask: Queries.ask) : D.t = ctx.local let add_unique_call ctx = let counter, wrapper_node = ctx.local in (* track the unique ID per call to the wrapper function, not to the wrapped function *) - (UniqueCallCounter.add_unique_call counter - (match wrapper_node with `Lifted node -> node | _ -> node_for_ctx ctx), wrapper_node) + UniqueCallCounter.add_unique_call counter + (match wrapper_node with `Lifted node -> node | _ -> node_for_ctx ctx), + wrapper_node let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f: varinfo) (arglist:exp list) : D.t = let desc = LibraryFunctions.find f in @@ -141,7 +143,7 @@ module MallocWrapper : MCPSpec = struct let wrappers () = get_string_list "ana.malloc.wrappers" let is_wrapped = function - | LibraryDesc.Malloc _ | Calloc _ | Realloc _ -> true + | LibraryDesc.(Malloc _ | Calloc _ | Realloc _) -> true | _ -> false end) @@ -170,7 +172,7 @@ module MallocWrapper : MCPSpec = struct | `Lifted wrapper_node -> wrapper_node | _ -> node_for_ctx ctx in - let count = UniqueCallCounter.find (`Lifted node) counter in + let (_, count) = UniqueCallCounter.find (`Lifted node) counter in let var = NodeVarinfoMap.to_varinfo (ctx.ask Q.CurrentThreadId, node, count) in var.vdecl <- UpdateCil.getLoc node; (* TODO: does this do anything bad for incremental? *) `Lifted var @@ -212,16 +214,14 @@ module ThreadCreateWrapper : MCPSpec = struct let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = match q with - | Q.ThreadCreateIndexedNode (increment : bool) -> - let counter, wrapper_node = if increment then add_unique_call ctx else ctx.local in + | Q.ThreadCreateIndexedNode (previous : bool) -> + let counter, wrapper_node = ctx.local in let node = match wrapper_node with | `Lifted wrapper_node -> wrapper_node | _ -> node_for_ctx ctx in - let count = - Lattice.lifted_of_chain (module Chain) - @@ max 0 (UniqueCallCounter.find (`Lifted node) counter - 1) - in + let (count0, count1) = UniqueCallCounter.find (`Lifted node) counter in + let count = Lattice.lifted_of_chain (module Chain) (if previous then count0 else count1) in `Lifted node, count | _ -> Queries.Result.top q diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index b9c7180872..648605692d 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -630,6 +630,7 @@ end module LiftedInt = LiftPO (IntPO) (struct let bot_name = "bot" let top_name = "top" end) +(* note: returns `Top even for single-valued lattices (whose value is really both top and bot) *) let lifted_of_chain (module Chain : S with type t = int) x = if Chain.is_top x then `Top else if Chain.is_bot x then `Bot diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 92173fcb4c..4d7cb37085 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -77,7 +77,7 @@ type _ t = | MustBeSingleThreaded: MustBool.t t | MustBeUniqueThread: MustBool.t t | CurrentThreadId: ThreadIdDomain.ThreadLifted.t t - | ThreadCreateIndexedNode: bool -> ThreadNodeLattice.t t (* TODO: indexed node lattice should really be `Lifted (node, `Lifted id) not (`Lifted node, `Lifted id) see *1* *) + | ThreadCreateIndexedNode: bool -> ThreadNodeLattice.t t (* boolean previous: whether to get the previous unique index *) | MayBeThreadReturn: MayBool.t t | EvalFunvar: exp -> LS.t t | EvalInt: exp -> ID.t t From b5c930607ba7dfae627146c8a2e554f4955090b8 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 15:39:24 +0200 Subject: [PATCH 136/518] only need unique count of 1 for these tests --- tests/regression/71-thread_create_wrapper/02-unique-counter.c | 2 +- .../71-thread_create_wrapper/03-wrapper-unique-counter.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/71-thread_create_wrapper/02-unique-counter.c b/tests/regression/71-thread_create_wrapper/02-unique-counter.c index 81d39137de..081d4dd49d 100644 --- a/tests/regression/71-thread_create_wrapper/02-unique-counter.c +++ b/tests/regression/71-thread_create_wrapper/02-unique-counter.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.unique_thread_id_count 2 +// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.unique_thread_id_count 1 #include #include diff --git a/tests/regression/71-thread_create_wrapper/03-wrapper-unique-counter.c b/tests/regression/71-thread_create_wrapper/03-wrapper-unique-counter.c index 3f41ff88aa..2a6fcbd066 100644 --- a/tests/regression/71-thread_create_wrapper/03-wrapper-unique-counter.c +++ b/tests/regression/71-thread_create_wrapper/03-wrapper-unique-counter.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.wrappers[+] my_pthread_create --set ana.thread.unique_thread_id_count 2 +// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.wrappers[+] my_pthread_create --set ana.thread.unique_thread_id_count 1 #include #include From 1ca5f78a44cef2ccef071057342bedf97ffb6c8c Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 15:55:37 +0200 Subject: [PATCH 137/518] your wish is my command, ocp-indent --- src/cdomains/threadIdDomain.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index 6d3c675f21..44dce0dba3 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -45,11 +45,11 @@ module FunNode: Stateless = struct include Printable.Prod - (CilType.Varinfo) - (Printable.Option - (Printable.Prod - (Node) - (Printable.Option + (CilType.Varinfo) ( + Printable.Option ( + Printable.Prod + (Node) ( + Printable.Option (Printable.Int) (struct let name = "no index" end))) (struct let name = "no node" end)) From 878472bc7f7cd572de29e83169658a7b9bd55e0c Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Wed, 3 May 2023 16:06:33 +0200 Subject: [PATCH 138/518] show #top instead of #?? when unique counter is top (matches malloc wrappers), promote new output --- src/cdomains/threadIdDomain.ml | 2 +- tests/regression/04-mutex/01-simple_rc.t | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index 44dce0dba3..d2fa782505 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -58,7 +58,7 @@ struct | (f, Some (n, i)) -> f.vname ^ "@" ^ (CilType.Location.show (UpdateCil.getLoc n)) - ^ "#" ^ Option.fold ~none:"??" ~some:string_of_int i + ^ "#" ^ Option.fold ~none:"top" ~some:string_of_int i | (f, None) -> f.vname include Printable.SimpleShow ( diff --git a/tests/regression/04-mutex/01-simple_rc.t b/tests/regression/04-mutex/01-simple_rc.t index 3c38c73394..7c14d522f3 100644 --- a/tests/regression/04-mutex/01-simple_rc.t +++ b/tests/regression/04-mutex/01-simple_rc.t @@ -4,10 +4,10 @@ dead: 0 total lines: 12 [Warning][Race] Memory location myglobal@01-simple_rc.c:4:5-4:13 (race with conf. 110): - write with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40]] (conf. 110) (01-simple_rc.c:10:3-10:22) - write with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40]}}, lock:{mutex2}, thread:[main]] (conf. 110) (01-simple_rc.c:19:3-19:22) - read with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40]] (conf. 110) (01-simple_rc.c:10:3-10:22) - read with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40]}}, lock:{mutex2}, thread:[main]] (conf. 110) (01-simple_rc.c:19:3-19:22) + write with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40#top]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40#top]] (conf. 110) (01-simple_rc.c:10:3-10:22) + write with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40#top]}}, lock:{mutex2}, thread:[main]] (conf. 110) (01-simple_rc.c:19:3-19:22) + read with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40#top]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40#top]] (conf. 110) (01-simple_rc.c:10:3-10:22) + read with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40#top]}}, lock:{mutex2}, thread:[main]] (conf. 110) (01-simple_rc.c:19:3-19:22) [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 From ccd58d6f395d5414dbfc5fbd9cd15e794b3710d4 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Fri, 5 May 2023 10:19:45 +0200 Subject: [PATCH 139/518] String literals analysis: strlen --- src/analyses/base.ml | 16 ++++++---------- src/cdomains/addressDomain.ml | 9 ++++++++- src/cdomains/lval.ml | 2 +- 3 files changed, 15 insertions(+), 12 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 594a3e89b4..c114828f5e 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2104,18 +2104,14 @@ struct let dest_a = eval_lv (Analyses.ask_of_ctx ctx) gs st dst_lval in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Strlen s, _ -> - let casted_lval = mkMem ~addr:(Cilfacade.mkCast ~e:s ~newt:(TPtr (charPtrType, []))) ~off:NoOffset in - let address = eval_lv (Analyses.ask_of_ctx ctx) gs st casted_lval in + let lval = mkMem ~addr:(Cil.stripCasts s) ~off:NoOffset in + let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in begin match lv with | Some v -> - begin match AD.to_string_length address with - |x::xs -> assign ctx v (integer x) - | [] -> - let dest_adr = eval_lv (Analyses.ask_of_ctx ctx) gs st v in - let dest_typ = AD.get_type dest_adr in - set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_adr dest_typ (VD.top_value (unrollType dest_typ)) - end - |None -> ctx.local + let dest_a, dest_typ = addr_type_of_exp (Lval v) in + let value = `Int(AD.to_string_length address) in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | None -> ctx.local end | Abort, _ -> raise Deadcode | ThreadExit { ret_val = exp }, _ -> diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 78dc2e385f..bb3af5b283 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -104,7 +104,14 @@ struct (* strings *) let from_string x = singleton (Addr.from_string x) let to_string x = List.filter_map Addr.to_string (elements x) - let to_string_length x = List.filter_map Addr.to_string_length (elements x) + let to_string_length x = + let address_list = List.map Addr.to_string_length (elements x) in + match List.find_opt (fun x -> if x = None then true else false) address_list with + (* returns top if address_list contains an element that isn't a StrPtr *) + | Some _ -> Idx.top_of IUInt + (* else returns the least upper bound of all lengths *) + | None -> List.map (fun x -> match x with Some y -> Idx.of_int IUInt (Z.of_int y) | None -> failwith "unreachable") address_list + |> List.fold_left Idx.join (Idx.bot_of IUInt) (* add an & in front of real addresses *) module ShortAddr = diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index c157034c3a..34253ef77b 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -257,7 +257,7 @@ struct | StrPtr (Some x) -> Some x | _ -> None let to_string_length = function - | StrPtr (Some x) -> Some (String.length x) + | StrPtr (Some x) -> Some (String.length x) | _ -> None (* exception if the offset can't be followed completely *) From 3b021394d2be2d0ccb30d7d25845b776a82466a3 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Fri, 5 May 2023 14:29:43 +0200 Subject: [PATCH 140/518] String literals analysis: strncpy --- src/analyses/base.ml | 35 ++++++++++++++++++++-------- src/analyses/libraryDesc.ml | 3 ++- src/analyses/libraryFunctions.ml | 2 +- src/cdomains/addressDomain.ml | 40 ++++++++++++++++++++++++++------ src/cdomains/lval.ml | 9 +++++++ 5 files changed, 70 insertions(+), 19 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index c114828f5e..70cb83e538 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2084,16 +2084,10 @@ struct set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value *) (* TODO: reuse addr_type_of_exp for master *) (* assigning from master *) - let get_type lval = - let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in - AD.get_type address - in - let dst_lval = mkMem ~addr:(Cil.stripCasts dst) ~off:NoOffset in + let dest_a, dest_typ = addr_type_of_exp dst in let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in - - let dest_typ = get_type dst_lval in - let src_typ = get_type src_lval in - + let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval + |> AD.get_type in (* When src and destination type coincide, take value from the source, otherwise use top *) let value = if typeSig dest_typ = typeSig src_typ then let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in @@ -2101,7 +2095,28 @@ struct else VD.top_value (unrollType dest_typ) in - let dest_a = eval_lv (Analyses.ask_of_ctx ctx) gs st dst_lval in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | Strncpy { dest = dst; src; n }, _ -> + let dest_a, dest_typ = addr_type_of_exp dst in + let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in + let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval + |> AD.get_type in + (* evaluate amount of characters which are to be extracted of src *) + let eval_n = eval_rv (Analyses.ask_of_ctx ctx) gs st n in + let int_n = + match eval_n with + | `Int i -> (match ID.to_int i with + | Some x -> Z.to_int x + | _ -> -1) + | _ -> -1 in + (* When src and destination type coincide, take n-substring value from the source, otherwise use top *) + let value = if typeSig dest_typ = typeSig src_typ then + let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in + let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in + `Address(AD.to_n_string int_n src_a) + else + VD.top_value (unrollType dest_typ) + in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Strlen s, _ -> let lval = mkMem ~addr:(Cil.stripCasts s) ~off:NoOffset in diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index 9e08235f4b..c57350af47 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -59,7 +59,8 @@ type special = | Memset of { dest: Cil.exp; ch: Cil.exp; count: Cil.exp; } | Bzero of { dest: Cil.exp; count: Cil.exp; } | Memcpy of { dest: Cil.exp; src: Cil.exp } - | Strcpy of { dest: Cil.exp; src: Cil.exp; } (* TODO: add count for strncpy when actually used *) + | Strcpy of { dest: Cil.exp; src: Cil.exp; } + | Strncpy of { dest: Cil.exp; src: Cil.exp; n: Cil.exp; } | Strcat of { dest: Cil.exp; src: Cil.exp; } | Strlen of Cil.exp | Strstr of { haystack: Cil.exp; needle: Cil.exp; } diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 6ba4257abd..9e6fc5da2f 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -14,7 +14,7 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("memcpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Memcpy { dest; src }); ("__builtin_memcpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Memcpy { dest; src }); ("__builtin___memcpy_chk", special [__ "dest" [w]; __ "src" [r]; drop "n" []; drop "os" []] @@ fun dest src -> Memcpy { dest; src }); - ("strncpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Strcpy { dest; src; }); + ("strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strncpy { dest; src; n; }); ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; }); ("strncat", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Strcat { dest; src; }); ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; }); diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index bb3af5b283..9b87d01728 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -104,14 +104,40 @@ struct (* strings *) let from_string x = singleton (Addr.from_string x) let to_string x = List.filter_map Addr.to_string (elements x) + let to_n_string n x = + let transform n elem = + match Addr.to_n_string n elem with + | Some s -> from_string s + | None -> top () in + (* maps any StrPtr for which n is valid to the prefix of length n of its content, otherwise maps to top *) + List.map (transform n) x + (* returns the least upper bound of computed AddressDomain values *) + |> List.fold_left join (bot ()) + (* let to_n_string n x = + let n_string_list = List.map (Addr.to_n_string n) (elements x) in + match List.find_opt (fun x -> if x = None then true else false) n_string_list with + (* returns top if input address set contains an element that isn't a StrPtr or if n isn't valid *) + | Some _ -> top () + (* else returns the least upper bound of all substrings of length n *) + | None -> List.map (fun x -> match x with Some s -> from_string s | None -> failwith "unreachable") n_string_list + |> List.fold_left join (bot ()) *) let to_string_length x = - let address_list = List.map Addr.to_string_length (elements x) in - match List.find_opt (fun x -> if x = None then true else false) address_list with - (* returns top if address_list contains an element that isn't a StrPtr *) - | Some _ -> Idx.top_of IUInt - (* else returns the least upper bound of all lengths *) - | None -> List.map (fun x -> match x with Some y -> Idx.of_int IUInt (Z.of_int y) | None -> failwith "unreachable") address_list - |> List.fold_left Idx.join (Idx.bot_of IUInt) + let transform elem = + match Addr.to_string_length elem with + | Some x -> Idx.of_int IUInt (Z.of_int x) + | None -> Idx.top_of IUInt in + (* maps any StrPtr to the length of its content, otherwise maps to top *) + List.map transform x + (* returns the least upper bound of computed IntDomain values *) + |> List.fold_left Idx.join (Idx.bot_of IUInt) + (* let to_string_length x = + let length_list = List.map Addr.to_string_length (elements x) in + match List.find_opt (fun x -> if x = None then true else false) length_list with + (* returns top if input address set contains an element that isn't a StrPtr *) + | Some _ -> Idx.top_of IUInt + (* else returns the least upper bound of all lengths *) + | None -> List.map (fun x -> match x with Some y -> Idx.of_int IUInt (Z.of_int y) | None -> failwith "unreachable") length_list + |> List.fold_left Idx.join (Idx.bot_of IUInt) *) (* add an & in front of real addresses *) module ShortAddr = diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 34253ef77b..5ea30a3b43 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -256,6 +256,15 @@ struct let to_string = function | StrPtr (Some x) -> Some x | _ -> None + let to_n_string n = function + | StrPtr (Some x) -> + if n > String.length x + then Some x + else if n < 0 + then None + else + Some (String.sub x 0 n) + | _ -> None let to_string_length = function | StrPtr (Some x) -> Some (String.length x) | _ -> None From 556701504e87690fb70e2547a36bb97efa9fea14 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Fri, 5 May 2023 14:31:13 +0200 Subject: [PATCH 141/518] String literals analysis: strncpy --- src/analyses/base.ml | 8 ++++---- src/cdomains/addressDomain.ml | 16 ++++++++-------- src/cdomains/lval.ml | 4 ++-- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 70cb83e538..7b5b1aefef 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2105,10 +2105,10 @@ struct let eval_n = eval_rv (Analyses.ask_of_ctx ctx) gs st n in let int_n = match eval_n with - | `Int i -> (match ID.to_int i with - | Some x -> Z.to_int x - | _ -> -1) - | _ -> -1 in + | `Int i -> (match ID.to_int i with + | Some x -> Z.to_int x + | _ -> -1) + | _ -> -1 in (* When src and destination type coincide, take n-substring value from the source, otherwise use top *) let value = if typeSig dest_typ = typeSig src_typ then let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 9b87d01728..7e7c810819 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -107,15 +107,15 @@ struct let to_n_string n x = let transform n elem = match Addr.to_n_string n elem with - | Some s -> from_string s - | None -> top () in + | Some s -> from_string s + | None -> top () in (* maps any StrPtr for which n is valid to the prefix of length n of its content, otherwise maps to top *) List.map (transform n) x (* returns the least upper bound of computed AddressDomain values *) |> List.fold_left join (bot ()) (* let to_n_string n x = - let n_string_list = List.map (Addr.to_n_string n) (elements x) in - match List.find_opt (fun x -> if x = None then true else false) n_string_list with + let n_string_list = List.map (Addr.to_n_string n) (elements x) in + match List.find_opt (fun x -> if x = None then true else false) n_string_list with (* returns top if input address set contains an element that isn't a StrPtr or if n isn't valid *) | Some _ -> top () (* else returns the least upper bound of all substrings of length n *) @@ -124,15 +124,15 @@ struct let to_string_length x = let transform elem = match Addr.to_string_length elem with - | Some x -> Idx.of_int IUInt (Z.of_int x) - | None -> Idx.top_of IUInt in + | Some x -> Idx.of_int IUInt (Z.of_int x) + | None -> Idx.top_of IUInt in (* maps any StrPtr to the length of its content, otherwise maps to top *) List.map transform x (* returns the least upper bound of computed IntDomain values *) |> List.fold_left Idx.join (Idx.bot_of IUInt) (* let to_string_length x = - let length_list = List.map Addr.to_string_length (elements x) in - match List.find_opt (fun x -> if x = None then true else false) length_list with + let length_list = List.map Addr.to_string_length (elements x) in + match List.find_opt (fun x -> if x = None then true else false) length_list with (* returns top if input address set contains an element that isn't a StrPtr *) | Some _ -> Idx.top_of IUInt (* else returns the least upper bound of all lengths *) diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 5ea30a3b43..cb8d53a031 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -259,9 +259,9 @@ struct let to_n_string n = function | StrPtr (Some x) -> if n > String.length x - then Some x + then Some x else if n < 0 - then None + then None else Some (String.sub x 0 n) | _ -> None From b0688ee3305f60f6f70e14eef21fc01e3c4f59a2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 5 May 2023 18:01:39 +0300 Subject: [PATCH 142/518] Remove unused Goblintutil references --- src/analyses/threadId.ml | 1 - src/cdomains/addressDomain.ml | 1 - src/cdomains/basetype.ml | 1 - src/cdomains/lval.ml | 1 - src/cdomains/regionDomain.ml | 1 - src/cdomains/stackDomain.ml | 2 -- src/domains/lattice.ml | 1 - src/domains/mapDomain.ml | 1 - src/domains/queries.ml | 2 -- src/solvers/generic.ml | 2 -- src/solvers/topDown_deprecated.ml | 2 -- src/util/cilfacade.ml | 1 - 12 files changed, 16 deletions(-) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index 538494ad1e..02874bb71d 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -1,6 +1,5 @@ (** Current thread ID analysis. *) -module GU = Goblintutil module LF = LibraryFunctions open Batteries diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index c6905a5cdc..1be584c2a5 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -1,7 +1,6 @@ open GoblintCil open IntOps -module GU = Goblintutil module M = Messages module type S = diff --git a/src/cdomains/basetype.ml b/src/cdomains/basetype.ml index 19aff2db5a..e241141a75 100644 --- a/src/cdomains/basetype.ml +++ b/src/cdomains/basetype.ml @@ -1,4 +1,3 @@ -module GU = Goblintutil open GoblintCil diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 96e8db1c86..962b4ed500 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -1,7 +1,6 @@ open GoblintCil open Pretty -module GU = Goblintutil module M = Messages type ('a, 'b) offs = [ diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index 1a500ee102..0507f46a4e 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -1,7 +1,6 @@ open GoblintCil open GobConfig -module GU = Goblintutil module V = Basetype.Variables module B = Printable.UnitConf (struct let name = "•" end) module F = Lval.Fields diff --git a/src/cdomains/stackDomain.ml b/src/cdomains/stackDomain.ml index b3300bb11b..98e46b1571 100644 --- a/src/cdomains/stackDomain.ml +++ b/src/cdomains/stackDomain.ml @@ -1,5 +1,3 @@ -module GU = Goblintutil - module type S = sig include Lattice.S diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index c1521611fc..44ace6339b 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -1,7 +1,6 @@ (** The lattice signature and simple functors for building lattices. *) module Pretty = GoblintCil.Pretty -module GU = Goblintutil (* module type Rel = sig diff --git a/src/domains/mapDomain.ml b/src/domains/mapDomain.ml index 7b4902b1c2..9051074230 100644 --- a/src/domains/mapDomain.ml +++ b/src/domains/mapDomain.ml @@ -3,7 +3,6 @@ module Pretty = GoblintCil.Pretty open Pretty module ME = Messages -module GU = Goblintutil module type PS = sig diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 66db991826..85366609c9 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -2,8 +2,6 @@ open GoblintCil -module GU = Goblintutil - module VDQ = ValueDomainQueries module ID = VDQ.ID diff --git a/src/solvers/generic.ml b/src/solvers/generic.ml index 242329c117..6da99f6ea9 100644 --- a/src/solvers/generic.ml +++ b/src/solvers/generic.ml @@ -35,8 +35,6 @@ struct open S open Messages - module GU = Goblintutil - let stack_d = ref 0 let full_trace = false let start_c = 0 diff --git a/src/solvers/topDown_deprecated.ml b/src/solvers/topDown_deprecated.ml index f8276c8dc1..2e7e276128 100644 --- a/src/solvers/topDown_deprecated.ml +++ b/src/solvers/topDown_deprecated.ml @@ -3,8 +3,6 @@ open Analyses open Constraints open Messages -module GU = Goblintutil - exception SolverCannotDoGlobals diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml index d266083376..dbb7ceeb02 100644 --- a/src/util/cilfacade.ml +++ b/src/util/cilfacade.ml @@ -3,7 +3,6 @@ open GobConfig open GoblintCil module E = Errormsg -module GU = Goblintutil include Cilfacade0 From 8756057c36533195396e66480f886e535fbdcfce Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Sat, 6 May 2023 14:49:23 +0200 Subject: [PATCH 143/518] String literals analysis: strcat --- src/analyses/base.ml | 14 ++++++++++++++ src/cdomains/addressDomain.ml | 24 ++++++++++++++++++++++-- src/cdomains/lval.ml | 8 ++++---- 3 files changed, 40 insertions(+), 6 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 7b5b1aefef..7012bab253 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2118,6 +2118,20 @@ struct VD.top_value (unrollType dest_typ) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | Strcat { dest = dst; src }, _ -> + let dest_a, dest_typ = addr_type_of_exp dst in + let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in + let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval + |> AD.get_type in + (* When src and destination type coincide, concatenate src to dest, otherwise use top *) + let value = if typeSig dest_typ = typeSig src_typ then + let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in + let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in + `Address(AD.string_concat dest_a src_a) + else + VD.top_value (unrollType dest_typ) + in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Strlen s, _ -> let lval = mkMem ~addr:(Cil.stripCasts s) ~off:NoOffset in let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 7e7c810819..96d7f44ee5 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -110,7 +110,7 @@ struct | Some s -> from_string s | None -> top () in (* maps any StrPtr for which n is valid to the prefix of length n of its content, otherwise maps to top *) - List.map (transform n) x + List.map (transform n) (elements x) (* returns the least upper bound of computed AddressDomain values *) |> List.fold_left join (bot ()) (* let to_n_string n x = @@ -127,7 +127,7 @@ struct | Some x -> Idx.of_int IUInt (Z.of_int x) | None -> Idx.top_of IUInt in (* maps any StrPtr to the length of its content, otherwise maps to top *) - List.map transform x + List.map transform (elements x) (* returns the least upper bound of computed IntDomain values *) |> List.fold_left Idx.join (Idx.bot_of IUInt) (* let to_string_length x = @@ -138,6 +138,26 @@ struct (* else returns the least upper bound of all lengths *) | None -> List.map (fun x -> match x with Some y -> Idx.of_int IUInt (Z.of_int y) | None -> failwith "unreachable") length_list |> List.fold_left Idx.join (Idx.bot_of IUInt) *) + let string_concat x y = + (* map all StrPtr elements in input address sets to strings *) + let x' = List.map Addr.to_string (elements x) in + let y' = List.map Addr.to_string (elements y) in + + (* helper functions *) + let is_None x = if x = None then true else false in + let extract_string = function + | Some s -> s + | None -> failwith "unreachable" in + + match List.find_opt is_None x', List.find_opt is_None y' with + (* if all elements of both lists are Some string *) + | None, None -> + (* ... concatenate every string of x' with every string of y' *) + List.fold_left (fun acc elem -> acc @ (List.map (fun s -> from_string ((extract_string elem) ^ (extract_string s))) y')) [] x' + (* ... and join all combinations *) + |> List.fold_left join (bot ()) + (* else if any of the input address sets contains an element that isn't a StrPtr, return top *) + | _ -> top () (* add an & in front of real addresses *) module ShortAddr = diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index cb8d53a031..aaa73cd184 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -258,10 +258,10 @@ struct | _ -> None let to_n_string n = function | StrPtr (Some x) -> - if n > String.length x - then Some x - else if n < 0 - then None + if n > String.length x then + Some x + else if n < 0 then + None else Some (String.sub x 0 n) | _ -> None From c7e159cd3e00ed964ab1ba8eedcbcba6d68b2fea Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Sat, 6 May 2023 15:32:45 +0200 Subject: [PATCH 144/518] String literals analysis: strncat --- src/analyses/base.ml | 24 +++++++++++++++++++++++- src/analyses/libraryDesc.ml | 1 + src/analyses/libraryFunctions.ml | 2 +- src/cdomains/addressDomain.ml | 10 +++++++--- 4 files changed, 32 insertions(+), 5 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 7012bab253..ea288d7d6a 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2127,7 +2127,29 @@ struct let value = if typeSig dest_typ = typeSig src_typ then let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in - `Address(AD.string_concat dest_a src_a) + `Address(AD.string_concat dest_a src_a None) + else + VD.top_value (unrollType dest_typ) + in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | Strncat { dest = dst; src; n }, _ -> + let dest_a, dest_typ = addr_type_of_exp dst in + let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in + let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval + |> AD.get_type in + (* evaluate amount of characters which are to be extracted of src *) + let eval_n = eval_rv (Analyses.ask_of_ctx ctx) gs st n in + let int_n = + match eval_n with + | `Int i -> (match ID.to_int i with + | Some x -> Z.to_int x + | _ -> -1) + | _ -> -1 in + (* When src and destination type coincide, concatenate n-substring from src to dest, otherwise use top *) + let value = if typeSig dest_typ = typeSig src_typ then + let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in + let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in + `Address(AD.string_concat dest_a src_a (Some int_n)) else VD.top_value (unrollType dest_typ) in diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index c57350af47..74367ccbbc 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -62,6 +62,7 @@ type special = | Strcpy of { dest: Cil.exp; src: Cil.exp; } | Strncpy of { dest: Cil.exp; src: Cil.exp; n: Cil.exp; } | Strcat of { dest: Cil.exp; src: Cil.exp; } + | Strncat of { dest:Cil.exp; src: Cil.exp; n: Cil.exp; } | Strlen of Cil.exp | Strstr of { haystack: Cil.exp; needle: Cil.exp; } | Abort diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 9e6fc5da2f..a626529140 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -16,7 +16,7 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__builtin___memcpy_chk", special [__ "dest" [w]; __ "src" [r]; drop "n" []; drop "os" []] @@ fun dest src -> Memcpy { dest; src }); ("strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strncpy { dest; src; n; }); ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; }); - ("strncat", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Strcat { dest; src; }); + ("strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strncat { dest; src; n; }); ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; }); ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); ("strstr", special [__ "haystack" [r]; __ "needle" [r]] @@ fun haystack needle -> Strstr { haystack; needle; }); diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 96d7f44ee5..7563bdb754 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -138,10 +138,14 @@ struct (* else returns the least upper bound of all lengths *) | None -> List.map (fun x -> match x with Some y -> Idx.of_int IUInt (Z.of_int y) | None -> failwith "unreachable") length_list |> List.fold_left Idx.join (Idx.bot_of IUInt) *) - let string_concat x y = - (* map all StrPtr elements in input address sets to strings *) + let string_concat x y n = + let f = match n with + | Some num -> Addr.to_n_string num + | None -> Addr.to_string in + + (* map all StrPtr elements in input address sets to strings / n-substrings *) let x' = List.map Addr.to_string (elements x) in - let y' = List.map Addr.to_string (elements y) in + let y' = List.map f (elements y) in (* helper functions *) let is_None x = if x = None then true else false in From 40a5265aba419c46abaa30dcc536763f99d10187 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Sat, 6 May 2023 15:33:36 +0200 Subject: [PATCH 145/518] String literals analysis: strncat --- src/cdomains/addressDomain.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 7563bdb754..7c7b5fcf8d 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -140,8 +140,8 @@ struct |> List.fold_left Idx.join (Idx.bot_of IUInt) *) let string_concat x y n = let f = match n with - | Some num -> Addr.to_n_string num - | None -> Addr.to_string in + | Some num -> Addr.to_n_string num + | None -> Addr.to_string in (* map all StrPtr elements in input address sets to strings / n-substrings *) let x' = List.map Addr.to_string (elements x) in From c5eb843a5f47ff2351ab075a3bec27e6fb30569a Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Sun, 7 May 2023 16:36:43 +0200 Subject: [PATCH 146/518] String literals analysis: strstr --- src/analyses/base.ml | 29 ++++++++++++++++++----- src/cdomains/addressDomain.ml | 43 ++++++++++++++++++++++++++++++++++- 2 files changed, 65 insertions(+), 7 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index ea288d7d6a..67c24625d7 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2088,7 +2088,7 @@ struct let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval |> AD.get_type in - (* When src and destination type coincide, take value from the source, otherwise use top *) + (* when src and destination type coincide, take value from the source, otherwise use top *) let value = if typeSig dest_typ = typeSig src_typ then let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in eval_rv (Analyses.ask_of_ctx ctx) gs st (Lval src_cast_lval) @@ -2109,7 +2109,7 @@ struct | Some x -> Z.to_int x | _ -> -1) | _ -> -1 in - (* When src and destination type coincide, take n-substring value from the source, otherwise use top *) + (* when src and destination type coincide, take n-substring value from the source, otherwise use top *) let value = if typeSig dest_typ = typeSig src_typ then let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in @@ -2123,7 +2123,7 @@ struct let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval |> AD.get_type in - (* When src and destination type coincide, concatenate src to dest, otherwise use top *) + (* when src and destination type coincide, concatenate src to dest, otherwise use top *) let value = if typeSig dest_typ = typeSig src_typ then let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in @@ -2145,7 +2145,7 @@ struct | Some x -> Z.to_int x | _ -> -1) | _ -> -1 in - (* When src and destination type coincide, concatenate n-substring from src to dest, otherwise use top *) + (* when src and destination type coincide, concatenate n-substring from src to dest, otherwise use top *) let value = if typeSig dest_typ = typeSig src_typ then let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in @@ -2155,15 +2155,32 @@ struct in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Strlen s, _ -> - let lval = mkMem ~addr:(Cil.stripCasts s) ~off:NoOffset in - let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in begin match lv with | Some v -> + let lval = mkMem ~addr:(Cil.stripCasts s) ~off:NoOffset in + let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in let dest_a, dest_typ = addr_type_of_exp (Lval v) in let value = `Int(AD.to_string_length address) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | None -> ctx.local end + | Strstr { haystack; needle }, _ -> + begin match lv with + | Some v -> + let haystack_a, haystack_typ = addr_type_of_exp haystack in + let needle_a = mkMem ~addr:(Cil.stripCasts needle) ~off:NoOffset + |> eval_lv (Analyses.ask_of_ctx ctx) gs st in + let dest_a, dest_typ = addr_type_of_exp (Lval v) in + (* when haystack and dest type coincide, check if needle is a substring of haystack: + if that is the case, assign the substring of haystack starting at the first occurrence of needle to dest, + else use top *) + let value = if typeSig dest_typ = typeSig haystack_typ then + `Address(AD.substring_extraction haystack_a needle_a) + else + VD.top_value (unrollType dest_typ) in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | None -> ctx.local + end | Abort, _ -> raise Deadcode | ThreadExit { ret_val = exp }, _ -> begin match ThreadId.get_current (Analyses.ask_of_ctx ctx) with diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 7c7b5fcf8d..4a263f2965 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -103,7 +103,9 @@ struct (* strings *) let from_string x = singleton (Addr.from_string x) + let to_string x = List.filter_map Addr.to_string (elements x) + let to_n_string n x = let transform n elem = match Addr.to_n_string n elem with @@ -121,6 +123,7 @@ struct (* else returns the least upper bound of all substrings of length n *) | None -> List.map (fun x -> match x with Some s -> from_string s | None -> failwith "unreachable") n_string_list |> List.fold_left join (bot ()) *) + let to_string_length x = let transform elem = match Addr.to_string_length elem with @@ -138,12 +141,13 @@ struct (* else returns the least upper bound of all lengths *) | None -> List.map (fun x -> match x with Some y -> Idx.of_int IUInt (Z.of_int y) | None -> failwith "unreachable") length_list |> List.fold_left Idx.join (Idx.bot_of IUInt) *) + let string_concat x y n = let f = match n with | Some num -> Addr.to_n_string num | None -> Addr.to_string in - (* map all StrPtr elements in input address sets to strings / n-substrings *) + (* map all StrPtr elements in input address sets to contained strings / n-substrings *) let x' = List.map Addr.to_string (elements x) in let y' = List.map f (elements y) in @@ -163,6 +167,43 @@ struct (* else if any of the input address sets contains an element that isn't a StrPtr, return top *) | _ -> top () + let substring_extraction haystack needle = + (* map all StrPtr elements in input address sets to contained strings *) + let haystack' = List.map Addr.to_string (elements haystack) in + let needle' = List.map Addr.to_string (elements needle) in + + (* helper functions *) + let is_None = function None -> true | Some _ -> false in + let is_Some = function Some _ -> true | None -> false in + let extract_string = function + | Some s -> s + | None -> failwith "unreachable" in + let extract_lval_string = function + | Some s -> from_string s + | None -> top () in + let compute_substring s1 s2 = + let i = + try Str.search_forward (Str.regexp_string s2) s1 0 + with Not_found -> -1 in + if i < 0 then + None + else + Some (String.sub s1 i (String.length s1 - i)) in + + match List.find_opt is_None haystack', List.find_opt is_None needle' with + (* if all elements of both lists are Some string *) + | None, None -> + (* ... try to extract substrings *) + (let substrings = List.fold_left (fun acc elem -> + acc @ (List.map (fun s -> compute_substring (extract_string elem) (extract_string s)) needle')) [] haystack' in + match List.find_opt is_Some substrings with + (* ... and return bot if no string of needle' is a substring of any string of haystack' *) + | None -> bot () + (* ... or join all combinations *) + | Some _ -> List.fold_left join (bot ()) (List.map extract_lval_string substrings)) + (* else if any of the input address sets contains an element that isn't a StrPtr, return top *) + | _ -> top () + (* add an & in front of real addresses *) module ShortAddr = struct From 6f801b17eefb5f66ed43b93f3841ed757b6568ff Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 8 May 2023 15:29:09 +0300 Subject: [PATCH 147/518] Replace should_join with path representative --- src/analyses/activeSetjmp.ml | 3 +- src/analyses/apron/relationAnalysis.apron.ml | 8 ++- src/analyses/apron/relationPriv.apron.ml | 42 ++++++++------ src/analyses/expsplit.ml | 3 +- src/analyses/mCP.ml | 21 ++----- src/analyses/mCPRegistry.ml | 61 +++++++++++++++++++- src/analyses/malloc_null.ml | 3 +- src/analyses/mutexAnalysis.ml | 2 +- src/analyses/stackTrace.ml | 3 +- src/analyses/threadAnalysis.ml | 3 +- src/analyses/threadFlag.ml | 3 +- src/analyses/unassumeAnalysis.ml | 1 - src/analyses/uninit.ml | 3 +- src/framework/analyses.ml | 19 ++++-- src/framework/constraints.ml | 46 +++++++++------ src/util/wideningTokens.ml | 7 ++- src/witness/observerAnalysis.ml | 3 +- src/witness/witnessConstraints.ml | 5 +- 18 files changed, 151 insertions(+), 85 deletions(-) diff --git a/src/analyses/activeSetjmp.ml b/src/analyses/activeSetjmp.ml index f144046a44..95b23aed26 100644 --- a/src/analyses/activeSetjmp.ml +++ b/src/analyses/activeSetjmp.ml @@ -11,8 +11,7 @@ struct module D = JmpBufDomain.JmpBufSet module C = JmpBufDomain.JmpBufSet - - let should_join a b = D.equal a b + module P = IdentityP (D) let combine_env ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (au:D.t) (f_ask:Queries.ask): D.t = ctx.local (* keep local as opposed to IdentitySpec *) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 5d2a659697..df79a7b427 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -21,6 +21,12 @@ struct include Priv.V include StdV end + module P = + struct + include Priv.P + + let of_elt {priv; _} = of_elt priv + end module RV = RD.V @@ -29,8 +35,6 @@ struct (* Result map used for comparison of results for relational traces paper. *) let results = PCU.RH.create 103 - let should_join = Priv.should_join - let context fd x = if ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.relation.context" ~removeAttr:"relation.no-context" ~keepAttr:"relation.context" fd then x diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 48057e9e5d..32a91d766b 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -19,10 +19,11 @@ module type S = module D: Lattice.S module G: Lattice.S module V: Printable.S + module P: DisjointDomain.Representative with type elt := D.t (** Path-representative. *) + type relation_components_t := RelationDomain.RelComponents (RD) (D).t val name: unit -> string val startstate: unit -> D.t - val should_join: relation_components_t -> relation_components_t -> bool val read_global: Q.ask -> (V.t -> G.t) -> relation_components_t -> varinfo -> varinfo -> RD.t @@ -58,12 +59,12 @@ struct module G = Lattice.Unit module V = EmptyV module AV = RD.V + module P = UnitP type relation_components_t = RelComponents (RD) (D).t let name () = "top" let startstate () = () - let should_join _ _ = true let read_global ask getg (st: relation_components_t) g x = let rel = st.rel in @@ -146,10 +147,12 @@ struct open Protection (** Locally must-written protected globals that have been continuously protected since writing. *) - module P = - struct - include MustVars - let name () = "P" + open struct + module P = + struct + include MustVars + let name () = "P" + end end (** Locally may-written protected globals that have been continuously protected since writing. *) @@ -163,6 +166,16 @@ struct module D = Lattice.Prod (P) (W) module G = RD module V = Printable.UnitConf (struct let name = "global" end) + module PS = + struct + include Printable.Option (P) (struct let name = "None" end) + + let of_elt (p, _) = + if Param.path_sensitive then + Some p + else + None + end type relation_components_t = RelationComponents (RD) (D).t @@ -211,15 +224,6 @@ struct let startstate () = (P.empty (), W.empty ()) - let should_join (st1: relation_components_t) (st2: relation_components_t) = - if Param.path_sensitive then ( - let (p1, _) = st1.priv in - let (p2, _) = st2.priv in - P.equal p1 p2 - ) - else - true - let read_global ask getg (st: relation_components_t) g x = let rel = st.rel in let (p, w) = st.priv in @@ -408,6 +412,8 @@ struct let invariant_vars ask getg st = protected_vars ask (* TODO: is this right? *) let finalize () = () + + module P = PS end module CommonPerMutex = functor(RD: RelationDomain.RD) -> @@ -452,6 +458,7 @@ struct module D = Lattice.Unit module G = RD + module P = UnitP type relation_components_t = RelationDomain.RelComponents (RD) (D).t @@ -461,8 +468,6 @@ struct let startstate () = () - let should_join _ _ = true - let get_m_with_mutex_inits ask getg m = let get_m = getg (V.mutex m) in let get_mutex_inits = getg V.mutex_inits in @@ -857,6 +862,7 @@ struct end)(LRD) module AV = RD.V + module P = UnitP let name () = "PerMutexMeetPrivTID(" ^ (Cluster.name ()) ^ (if GobConfig.get_bool "ana.relation.priv.must-joined" then ",join" else "") ^ ")" @@ -872,8 +878,6 @@ struct type relation_components_t = RelationDomain.RelComponents (RD) (D).t - let should_join _ _ = true - let get_m_with_mutex_inits inits ask getg m = let get_m = get_relevant_writes ask m (G.mutex @@ getg (V.mutex m)) in if M.tracing then M.traceli "relationpriv" "get_m_with_mutex_inits %a\n get=%a\n" LockDomain.Addr.pretty m LRD.pretty get_m; diff --git a/src/analyses/expsplit.ml b/src/analyses/expsplit.ml index d5eac15a93..ac82a3fa79 100644 --- a/src/analyses/expsplit.ml +++ b/src/analyses/expsplit.ml @@ -17,8 +17,7 @@ struct let exitstate = startstate include Analyses.DefaultSpec - - let should_join = D.equal + module P = IdentityP (D) let emit_splits ctx d = D.iter (fun e _ -> diff --git a/src/analyses/mCP.ml b/src/analyses/mCP.ml index 476ddf2356..ec3d312ca7 100644 --- a/src/analyses/mCP.ml +++ b/src/analyses/mCP.ml @@ -11,12 +11,14 @@ module MCP2 : Analyses.Spec with module D = DomListLattice (LocalDomainListSpec) and module G = DomVariantLattice (GlobalDomainListSpec) and module C = DomListPrintable (ContextListSpec) - and module V = DomVariantSysVar (VarListSpec) = + and module V = DomVariantSysVar (VarListSpec) + and module P = DomListRepresentative (PathListSpec) = struct module D = DomListLattice (LocalDomainListSpec) module G = DomVariantLattice (GlobalDomainListSpec) module C = DomListPrintable (ContextListSpec) module V = DomVariantSysVar (VarListSpec) + module P = DomListRepresentative (PathListSpec) open List open Obj let v_of n v = (n, repr v) @@ -82,6 +84,7 @@ struct check_deps !activated; activated := topo_sort_an !activated; activated_ctx_sens := List.filter (fun (n, _) -> not (List.mem n !cont_inse)) !activated; + activated_path_sens := List.filter (fun (n, _) -> List.mem n !path_sens) !activated; match marshal with | Some marshal -> iter2 (fun (_,{spec=(module S:MCPSpec); _}) marshal -> S.init (Some (Obj.obj marshal))) !activated marshal @@ -111,22 +114,6 @@ struct Some (n, repr @@ S.context fd (obj d)) ) x - let should_join x y = - (* TODO: GobList.for_all3 *) - let rec zip3 lst1 lst2 lst3 = match lst1,lst2,lst3 with - | [],_, _ -> [] - | _,[], _ -> [] - | _,_ , []-> [] - | (x::xs),(y::ys), (z::zs) -> (x,y,z)::(zip3 xs ys zs) - in - let should_join ((_,(module S:Analyses.MCPSpec),_),(_,x),(_,y)) = S.should_join (obj x) (obj y) in - (* obtain all analyses specs that are path sensitive and their values both in x and y *) - let specs = filter (fun (x,_,_) -> mem x !path_sens) (spec_list x) in - let xs = filter (fun (x,_) -> mem x !path_sens) x in - let ys = filter (fun (x,_) -> mem x !path_sens) y in - let zipped = zip3 specs xs ys in - List.for_all should_join zipped - let exitstate v = map (fun (n,{spec=(module S:MCPSpec); _}) -> n, repr @@ S.exitstate v) !activated let startstate v = map (fun (n,{spec=(module S:MCPSpec); _}) -> n, repr @@ S.startstate v) !activated let morphstate v x = map (fun (n,(module S:MCPSpec),d) -> n, repr @@ S.morphstate v (obj d)) (spec_list x) diff --git a/src/analyses/mCPRegistry.ml b/src/analyses/mCPRegistry.ml index 48acb7d0be..b80ce6301c 100644 --- a/src/analyses/mCPRegistry.ml +++ b/src/analyses/mCPRegistry.ml @@ -10,10 +10,12 @@ type spec_modules = { name : string ; glob : (module Lattice.S) ; cont : (module Printable.S) ; var : (module SpecSysVar) - ; acc : (module MCPA) } + ; acc : (module MCPA) + ; path : (module DisjointDomain.Representative) } let activated : (int * spec_modules) list ref = ref [] let activated_ctx_sens: (int * spec_modules) list ref = ref [] +let activated_path_sens: (int * spec_modules) list ref = ref [] let registered: (int, spec_modules) Hashtbl.t = Hashtbl.create 100 let registered_name: (string, int) Hashtbl.t = Hashtbl.create 100 @@ -21,6 +23,12 @@ let register_analysis = let count = ref 0 in fun ?(dep=[]) (module S:MCPSpec) -> let n = S.name () in + let module P = + struct + include S.P + type elt = S.D.t + end + in let s = { name = n ; dep ; spec = (module S : MCPSpec) @@ -29,6 +37,7 @@ let register_analysis = ; cont = (module S.C : Printable.S) ; var = (module S.V : SpecSysVar) ; acc = (module S.A : MCPA) + ; path = (module P : DisjointDomain.Representative) } in Hashtbl.replace registered !count s; @@ -47,6 +56,12 @@ sig val domain_list : unit -> (int * (module Printable.S)) list end +module type DomainListRepresentativeSpec = +sig + val assoc_dom : int -> (module DisjointDomain.Representative) + val domain_list : unit -> (int * (module DisjointDomain.Representative)) list +end + module type DomainListSysVarSpec = sig val assoc_dom : int -> (module SpecSysVar) @@ -77,6 +92,18 @@ struct List.map (fun (x,y) -> (x,f y)) (D.domain_list ()) end +module PrintableOfRepresentativeSpec (D:DomainListRepresentativeSpec) : DomainListPrintableSpec = +struct + let assoc_dom n = + let f (module L:DisjointDomain.Representative) = (module L : Printable.S) + in + f (D.assoc_dom n) + + let domain_list () = + let f (module L:DisjointDomain.Representative) = (module L : Printable.S) in + List.map (fun (x,y) -> (x,f y)) (D.domain_list ()) +end + module PrintableOfMCPASpec (D:DomainListMCPASpec) : DomainListPrintableSpec = struct let assoc_dom n = @@ -278,6 +305,32 @@ struct ) end +module DomListRepresentative (DLSpec : DomainListRepresentativeSpec) + : DisjointDomain.Representative with type t = (int * unknown) list and type elt = (int * unknown) list += +struct + open DLSpec + open List + open Obj + + include DomListPrintable (PrintableOfRepresentativeSpec (DLSpec)) + + type elt = (int * unknown) list + + let of_elt (xs: elt): t = + let rec aux xs ss acc = + match xs, ss with + | [], [] -> acc + | _ :: _, [] -> acc + | (n, d) :: xs', (n', (module P: DisjointDomain.Representative)) :: ss' when n = n' -> + aux xs' ss' ((n, repr (P.of_elt (obj d))) :: acc) + | _ :: xs', _ :: _ -> + aux xs' ss acc + | [], _ :: _ -> invalid_arg "DomListRepresentative.of_elt" + in + List.rev (aux xs (domain_list ()) []) +end + module DomListLattice (DLSpec : DomainListLatticeSpec) : Lattice.S with type t = (int * unknown) list = @@ -393,3 +446,9 @@ struct let assoc_dom n = (find_spec n).acc let domain_list () = List.map (fun (n,p) -> n, p.acc) !activated end + +module PathListSpec : DomainListRepresentativeSpec = +struct + let assoc_dom n = (find_spec n).path + let domain_list () = List.map (fun (n,p) -> n, p.path) !activated_path_sens +end diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index 7f80a03094..ab05ffa45b 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -14,8 +14,7 @@ struct module Addr = ValueDomain.Addr module D = ValueDomain.AddrSetDomain module C = ValueDomain.AddrSetDomain - - let should_join x y = D.equal x y + module P = IdentityP (D) (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain element) answers with the string "unknown" on all non-concrete cases. *) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 681b0eae3c..90dcf5e546 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -84,7 +84,7 @@ struct let name () = "mutex" module D = Arg.D (* help type checker using explicit constraint *) - let should_join x y = D.equal x y + module P = IdentityP (D) module V = Arg.V module GProtecting = Arg.GProtecting diff --git a/src/analyses/stackTrace.ml b/src/analyses/stackTrace.ml index 105f0c266b..8af3bc5567 100644 --- a/src/analyses/stackTrace.ml +++ b/src/analyses/stackTrace.ml @@ -6,9 +6,10 @@ module LF = LibraryFunctions module Spec (D: StackDomain.S) (P: sig val name : string end)= struct + module ArgP = P include Analyses.IdentitySpec - let name () = P.name + let name () = ArgP.name module D = D module C = D diff --git a/src/analyses/threadAnalysis.ml b/src/analyses/threadAnalysis.ml index 3d7fae74fa..1b356d87ee 100644 --- a/src/analyses/threadAnalysis.ml +++ b/src/analyses/threadAnalysis.ml @@ -19,8 +19,7 @@ struct include T include StdV end - - let should_join = D.equal + module P = IdentityP (D) (* transfer functions *) diff --git a/src/analyses/threadFlag.ml b/src/analyses/threadFlag.ml index b2b0be023b..971fa9efb3 100644 --- a/src/analyses/threadFlag.ml +++ b/src/analyses/threadFlag.ml @@ -18,6 +18,7 @@ struct module Flag = ThreadFlagDomain.Simple module D = Flag module C = Flag + module P = IdentityP (D) let name () = "threadflag" @@ -29,8 +30,6 @@ struct let create_tid v = Flag.get_multi () - let should_join = D.equal - let return ctx exp fundec = match fundec.svar.vname with | "__goblint_dummy_init" -> diff --git a/src/analyses/unassumeAnalysis.ml b/src/analyses/unassumeAnalysis.ml index 1379012d82..b72921b007 100644 --- a/src/analyses/unassumeAnalysis.ml +++ b/src/analyses/unassumeAnalysis.ml @@ -23,7 +23,6 @@ struct let exitstate _ = D.empty () let context _ _ = () - let should_join _ _ = false module Locator = WitnessUtil.Locator (Node) diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 01c2bbcff6..adcaa7561c 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -16,6 +16,7 @@ struct module D = ValueDomain.AddrSetDomain module C = ValueDomain.AddrSetDomain + module P = IdentityP (D) type trans_in = D.t type trans_out = D.t @@ -23,8 +24,6 @@ struct let name () = "uninit" - let should_join x y = D.equal x y - let startstate v : D.t = D.empty () let threadenter ctx lval f args = [D.empty ()] let threadspawn ctx lval f args fctx = ctx.local diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index acac5a81eb..44472b2db1 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -358,6 +358,7 @@ sig module G : Lattice.S module C : Printable.S module V: SpecSysVar (** Global constraint variables. *) + module P: DisjointDomain.Representative with type elt := D.t (** Path-representative. *) val name : unit -> string @@ -379,7 +380,6 @@ sig val morphstate : varinfo -> D.t -> D.t val exitstate : varinfo -> D.t - val should_join : D.t -> D.t -> bool val context : fundec -> D.t -> C.t val sync : (D.t, G.t, C.t, V.t) ctx -> [`Normal | `Join | `Return] -> D.t @@ -585,12 +585,24 @@ struct let should_print _ = false end +module UnitP = +struct + include Printable.Unit + let of_elt _ = () +end + +module IdentityP (D: Lattice.S) = +struct + include D + let of_elt x = x +end (** Relatively safe default implementations of some boring Spec functions. *) module DefaultSpec = struct module G = Lattice.Unit module V = EmptyV + module P = UnitP type marshal = unit let init _ = () @@ -598,11 +610,6 @@ struct (* no inits nor finalize -- only analyses like Mutex, Base, ... need these to do postprocessing or other imperative hacks. *) - let should_join _ _ = true - (* hint for path sensitivity --- MCP no longer overrides this so if you want - your analysis to be path sensitive, do override this. To obtain a behavior - where all paths are kept apart, set this to D.equal x y *) - let vdecl ctx _ = ctx.local let asm x = diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index 36627f360a..cd4195b1e2 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -20,6 +20,11 @@ struct module G = S.G module C = S.C module V = S.V + module P = + struct + include S.P + let of_elt x = of_elt (D.unlift x) + end let name () = S.name () ^" hashconsed" @@ -27,8 +32,6 @@ struct let init = S.init let finalize = S.finalize - let should_join x y = S.should_join (D.unlift x) (D.unlift y) - let startstate v = D.lift (S.startstate v) let exitstate v = D.lift (S.exitstate v) let morphstate v d = D.lift (S.morphstate v (D.unlift d)) @@ -103,6 +106,7 @@ struct module G = S.G module C = Printable.HConsed (S.C) module V = S.V + module P = S.P let name () = S.name () ^" context hashconsed" @@ -110,8 +114,6 @@ struct let init = S.init let finalize = S.finalize - let should_join = S.should_join - let startstate = S.startstate let exitstate = S.exitstate let morphstate = S.morphstate @@ -193,6 +195,11 @@ struct module G = S.G module C = S.C module V = S.V + module P = + struct + include S.P + let of_elt (x, _) = of_elt x + end let name () = S.name ()^" level sliced" @@ -206,8 +213,6 @@ struct let finalize = S.finalize - let should_join (x,_) (y,_) = S.should_join x y - let startstate v = (S.startstate v, !start_level) let exitstate v = (S.exitstate v, !start_level) let morphstate v (d,l) = (S.morphstate v d, l) @@ -348,6 +353,11 @@ struct module G = S.G module C = S.C module V = S.V + module P = + struct + include S.P + let of_elt (x, _) = of_elt x + end let name () = S.name ()^" with widened contexts" @@ -356,8 +366,6 @@ struct let init = S.init let finalize = S.finalize - let should_join (x,_) (y,_) = S.should_join x y - let inj f x = f x, M.bot () let startstate = inj S.startstate @@ -423,6 +431,14 @@ struct module G = S.G module C = S.C module V = S.V + module P = + struct + include Printable.Option (S.P) (struct let name = "None" end) + + let of_elt = function + | `Lifted x -> Some (S.P.of_elt x) + | _ -> None + end let name () = S.name ()^" lifted" @@ -430,11 +446,6 @@ struct let init = S.init let finalize = S.finalize - let should_join x y = - match x, y with - | `Lifted a, `Lifted b -> S.should_join a b - | _ -> true - let startstate v = `Lifted (S.startstate v) let exitstate v = `Lifted (S.exitstate v) let morphstate v d = try `Lifted (S.morphstate v (D.unlift d)) with Deadcode -> d @@ -1178,13 +1189,13 @@ struct module D = struct (* TODO is it really worth it to check every time instead of just using sets and joining later? *) - module C = + module R = struct + include Spec.P type elt = Spec.D.t - let cong = Spec.should_join end module J = SetDomain.Joined (Spec.D) - include DisjointDomain.PairwiseSet (Spec.D) (J) (C) + include DisjointDomain.ProjectiveSet (Spec.D) (J) (R) let name () = "PathSensitive (" ^ name () ^ ")" let printXml f x = @@ -1197,6 +1208,7 @@ struct module G = Spec.G module C = Spec.C module V = Spec.V + module P = UnitP let name () = "PathSensitive2("^Spec.name ()^")" @@ -1204,8 +1216,6 @@ struct let init = Spec.init let finalize = Spec.finalize - let should_join x y = true - let exitstate v = D.singleton (Spec.exitstate v) let startstate v = D.singleton (Spec.startstate v) let morphstate v d = D.map (Spec.morphstate v) d diff --git a/src/util/wideningTokens.ml b/src/util/wideningTokens.ml index a563d3cc79..4c26906ed8 100644 --- a/src/util/wideningTokens.ml +++ b/src/util/wideningTokens.ml @@ -109,6 +109,11 @@ struct end module C = S.C module V = S.V + module P = + struct + include S.P + let of_elt (x, _) = of_elt x + end let name () = S.name ()^" with widening tokens" @@ -116,8 +121,6 @@ struct let init = S.init let finalize = S.finalize - let should_join (x, _) (y, _) = S.should_join x y - let startstate v = (S.startstate v, TS.bot ()) let exitstate v = (S.exitstate v, TS.bot ()) let morphstate v (d, t) = (S.morphstate v d, t) diff --git a/src/witness/observerAnalysis.ml b/src/witness/observerAnalysis.ml index 62bfd1fcc6..5ad16afcfd 100644 --- a/src/witness/observerAnalysis.ml +++ b/src/witness/observerAnalysis.ml @@ -29,8 +29,7 @@ struct end module D = Lattice.Flat (Printable.Chain (ChainParams)) (Printable.DefaultNames) module C = D - - let should_join x y = D.equal x y (* fully path-sensitive *) + module P = IdentityP (D) (* fully path-sensitive *) let step d prev_node node = match d with diff --git a/src/witness/witnessConstraints.ml b/src/witness/witnessConstraints.ml index d6f20cafae..c78f6703d4 100644 --- a/src/witness/witnessConstraints.ml +++ b/src/witness/witnessConstraints.ml @@ -45,7 +45,7 @@ struct module C = struct type elt = Spec.D.t - let cong = Spec.should_join + let cong x y = Spec.P.equal (Spec.P.of_elt x) (Spec.P.of_elt y) (* TODO: ProjectiveMap *) end module J = MapDomain.Joined (Spec.D) (R) include DisjointDomain.PairwiseMap (Spec.D) (R) (J) (C) @@ -94,6 +94,7 @@ struct module G = Spec.G module C = Spec.C module V = Spec.V + module P = UnitP let name () = "PathSensitive3("^Spec.name ()^")" @@ -101,8 +102,6 @@ struct let init = Spec.init let finalize = Spec.finalize - let should_join x y = true - let exitstate v = (Dom.singleton (Spec.exitstate v) (R.bot ()), Sync.bot ()) let startstate v = (Dom.singleton (Spec.startstate v) (R.bot ()), Sync.bot ()) let morphstate v (d, _) = (Dom.map_keys (Spec.morphstate v) d, Sync.bot ()) From aff1296da791ebe8d1c378eaac77b0ee58c68e42 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 8 May 2023 16:19:49 +0300 Subject: [PATCH 148/518] Implement DisjointDomain.ProjectiveMap --- src/domains/disjointDomain.ml | 174 +++++++++++++++++++++++++++++++++- 1 file changed, 173 insertions(+), 1 deletion(-) diff --git a/src/domains/disjointDomain.ml b/src/domains/disjointDomain.ml index db055561c4..170046214b 100644 --- a/src/domains/disjointDomain.ml +++ b/src/domains/disjointDomain.ml @@ -46,7 +46,7 @@ struct (** Invariant: no explicit bot buckets. Required for efficient [is_empty], [cardinal] and [choose]. *) - let name () = "Projective (" ^ B.name () ^ ")" + let name () = "ProjectiveSet (" ^ B.name () ^ ")" (* explicitly delegate, so we don't accidentally delegate too much *) @@ -462,6 +462,178 @@ module CombinedSet (E: Printable.S) (B: SetDomain.S with type elt = E.t) (RC: Re Generalization of above sets into maps, whose key set behaves like above sets, but each element can also be associated with a value. *) +(** {2 By projection} *) + +(** Map of keys [E.t] grouped into buckets by [R], + where each bucket is described by the map [B] with values [V.t]. + + Common choice for [B] is {!MapDomain.Joined}. + + Handles {!Lattice.BotValue} from [B]. *) +module ProjectiveMap (E: Printable.S) (V: Printable.S) (B: MapDomain.S with type key = E.t and type value = V.t) (R: Representative with type elt = E.t): MapDomain.S with type key = E.t and type value = B.value = +struct + type key = E.t + type value = B.value + + module R = + struct + include Printable.Std (* for Groupable *) + include R + end + module M = MapDomain.MapBot (R) (B) + + (** Invariant: no explicit bot buckets. + Required for efficient [is_empty], [cardinal] and [choose]. *) + + let name () = "ProjectiveMap (" ^ B.name () ^ ")" + + (* explicitly delegate, so we don't accidentally delegate too much *) + + type t = M.t + let equal = M.equal + let compare = M.compare + let hash = M.hash + let tag = M.tag + let relift = M.relift + + let is_bot = M.is_bot + let bot = M.bot + let is_top = M.is_top + let top = M.top + + let is_empty = M.is_empty + let empty = M.empty + let cardinal = M.cardinal + + let leq = M.leq + let join = M.join + let pretty_diff = M.pretty_diff + + let fold f m a = M.fold (fun _ e a -> B.fold f e a) m a + let iter f m = M.iter (fun _ e -> B.iter f e) m + let exists p m = M.exists (fun _ e -> B.exists p e) m + let for_all p m = M.for_all (fun _ e -> B.for_all p e) m + + let singleton e v = M.singleton (R.of_elt e) (B.singleton e v) + let choose m = B.choose (snd (M.choose m)) + + let mem e m = + match M.find_opt (R.of_elt e) m with + | Some b -> B.mem e b + | None -> false + let find e m = + let r = R.of_elt e in + let b = M.find r m in (* raises Not_found *) + B.find e b (* raises Not_found *) + let find_opt e m = + let r = R.of_elt e in + match M.find_opt r m with + | Some b -> + B.find_opt e b + | None -> None + let add e v m = + let r = R.of_elt e in + let b' = match M.find_opt r m with + | Some b -> B.add e v b + | None -> B.singleton e v + in + M.add r b' m + let remove e m = + let r = R.of_elt e in + match M.find_opt r m with + | Some b -> + begin match B.remove e b with + | b' when B.is_bot b' -> + M.remove r m (* remove bot bucket to preserve invariant *) + | exception Lattice.BotValue -> + M.remove r m (* remove bot bucket to preserve invariant *) + | b' -> + M.add r b' m + end + | None -> m + + let add_list evs m = List.fold_left (fun acc (e, v) -> + add e v acc + ) m evs + let add_list_set es v m = List.fold_left (fun acc e -> + add e v acc + ) m es + let add_list_fun es f m = List.fold_left (fun acc e -> + add e (f e) acc + ) m es + let bindings m = fold (fun e v acc -> (e, v) :: acc) m [] (* no intermediate per-bucket lists *) + + let map f m = M.map (fun b -> + B.map f b + ) m + let mapi f m = M.map (fun b -> + B.mapi f b + ) m + let long_map2 f m1 m2 = M.long_map2 (fun b1 b2 -> + B.long_map2 f b1 b2 + ) m1 m2 + let map2 f m1 m2 = M.map2 (fun b1 b2 -> + B.map2 f b1 b2 + ) m1 m2 + let merge f m1 m2 = failwith "ProjectiveMap.merge" (* TODO: ? *) + + let widen m1 m2 = + Lattice.assert_valid_widen ~leq ~pretty_diff m1 m2; + M.widen m1 m2 + + let meet m1 m2 = + M.merge (fun _ b1 b2 -> + match b1, b2 with + | Some b1, Some b2 -> + begin match B.meet b1 b2 with + | b' when B.is_bot b' -> + None (* remove bot bucket to preserve invariant *) + | exception Lattice.BotValue -> + None (* remove bot bucket to preserve invariant *) + | b' -> + Some b' + end + | _, _ -> None + ) m1 m2 + let narrow m1 m2 = + M.merge (fun _ b1 b2 -> + match b1, b2 with + | Some b1, Some b2 -> + begin match B.narrow b1 b2 with + | b' when B.is_bot b' -> + None (* remove bot bucket to preserve invariant *) + | exception Lattice.BotValue -> + None (* remove bot bucket to preserve invariant *) + | b' -> + Some b' + end + | _, _ -> None + ) m1 m2 + + module GroupableE = + struct + include Printable.Std (* for Groupable *) + include E + end + include MapDomain.Print (GroupableE) (V) ( + struct + type nonrec t = t + type nonrec key = key + type nonrec value = value + let bindings = bindings + let iter = iter + end + ) + + let arbitrary () = failwith "ProjectiveMap.arbitrary" + + let filter p m = failwith "ProjectiveMap.filter" + + let leq_with_fct _ _ _ = failwith "ProjectiveMap.leq_with_fct" + let join_with_fct _ _ _ = failwith "ProjectiveMap.join_with_fct" + let widen_with_fct _ _ _ = failwith "ProjectiveMap.widen_with_fct" +end + (** {2 By congruence} *) (** Map of keys [E.t] grouped into buckets by [C], From a786112e124ccd788e643dfb203811bb305647fb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 8 May 2023 16:20:59 +0300 Subject: [PATCH 149/518] Use path representatives in PathSensitive3 --- src/witness/witnessConstraints.ml | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/witness/witnessConstraints.ml b/src/witness/witnessConstraints.ml index c78f6703d4..ab2d614e48 100644 --- a/src/witness/witnessConstraints.ml +++ b/src/witness/witnessConstraints.ml @@ -40,19 +40,20 @@ struct let narrow x y = y end - module SpecDMap (R: Lattice.S) = + module SpecDMap (V: Lattice.S) = struct - module C = + module R = struct + include Spec.P type elt = Spec.D.t - let cong x y = Spec.P.equal (Spec.P.of_elt x) (Spec.P.of_elt y) (* TODO: ProjectiveMap *) end - module J = MapDomain.Joined (Spec.D) (R) - include DisjointDomain.PairwiseMap (Spec.D) (R) (J) (C) + module J = MapDomain.Joined (Spec.D) (V) + include DisjointDomain.ProjectiveMap (Spec.D) (V) (J) (R) end module Dom = struct + module V = R include SpecDMap (R) let name () = "PathSensitive (" ^ name () ^ ")" @@ -60,7 +61,7 @@ struct let printXml f x = let print_one x r = (* BatPrintf.fprintf f "\n%a" Spec.D.printXml x *) - BatPrintf.fprintf f "\n%a%a" Spec.D.printXml x R.printXml r + BatPrintf.fprintf f "\n%a%a" Spec.D.printXml x V.printXml r in iter print_one x From d23b1121c039fc6ec9500a00a736bf990d7059e9 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 9 May 2023 11:29:34 +0200 Subject: [PATCH 150/518] Add example for phases --- tests/regression/58-base-mm-tid/24-phases.c | 45 +++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 tests/regression/58-base-mm-tid/24-phases.c diff --git a/tests/regression/58-base-mm-tid/24-phases.c b/tests/regression/58-base-mm-tid/24-phases.c new file mode 100644 index 0000000000..bcb527e182 --- /dev/null +++ b/tests/regression/58-base-mm-tid/24-phases.c @@ -0,0 +1,45 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void *t_benign(void *arg) { + pthread_mutex_lock(&A); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +void *t_benign2(void *arg) { + pthread_mutex_lock(&A); + __goblint_check(g == 20); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + + g = 20; + __goblint_check(g == 20); + + + pthread_create(&id2, NULL, t_benign2, NULL); + + + pthread_mutex_lock(&A); + __goblint_check(g == 20); //UNKNOWN! + pthread_mutex_unlock(&A); + + return 0; +} From 3d6513d3355bc9515b848a49cc3ff4aac6f182ad Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Tue, 9 May 2023 13:26:48 +0200 Subject: [PATCH 151/518] String literals analysis: strcmp and strncmp --- src/analyses/base.ml | 43 +++++++++++++++++++++++++++++--- src/analyses/libraryDesc.ml | 2 ++ src/analyses/libraryFunctions.ml | 4 +-- src/cdomains/addressDomain.ml | 30 ++++++++++++++++++++-- 4 files changed, 71 insertions(+), 8 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 67c24625d7..8e64206c70 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2168,19 +2168,54 @@ struct begin match lv with | Some v -> let haystack_a, haystack_typ = addr_type_of_exp haystack in - let needle_a = mkMem ~addr:(Cil.stripCasts needle) ~off:NoOffset - |> eval_lv (Analyses.ask_of_ctx ctx) gs st in + let needle_a, needle_typ = addr_type_of_exp needle in let dest_a, dest_typ = addr_type_of_exp (Lval v) in - (* when haystack and dest type coincide, check if needle is a substring of haystack: + (* when haystack, needle and dest type coincide, check if needle is a substring of haystack: if that is the case, assign the substring of haystack starting at the first occurrence of needle to dest, else use top *) - let value = if typeSig dest_typ = typeSig haystack_typ then + let value = if typeSig dest_typ = typeSig haystack_typ && typeSig haystack_typ = typeSig needle_typ then `Address(AD.substring_extraction haystack_a needle_a) else VD.top_value (unrollType dest_typ) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | None -> ctx.local end + | Strcmp { s1; s2 }, _ -> + begin match lv with + | Some v -> + let s1_a, s1_typ = addr_type_of_exp s1 in + let s2_a, s2_typ = addr_type_of_exp s2 in + let dest_a, dest_typ = addr_type_of_exp (Lval v) in + (* when s1 and s2 type coincide, compare both strings, otherwise use top *) + let value = if typeSig s1_typ = typeSig s2_typ then + `Int(AD.string_comparison s1_a s2_a None) + else + VD.top_value (unrollType dest_typ) in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | None -> ctx.local + end + | Strncmp { s1; s2; n }, _ -> + begin match lv with + | Some v -> + let s1_a, s1_typ = addr_type_of_exp s1 in + let s2_a, s2_typ = addr_type_of_exp s2 in + let dest_a, dest_typ = addr_type_of_exp (Lval v) in + (* evaluate amount of characters which are to be extracted of src *) + let eval_n = eval_rv (Analyses.ask_of_ctx ctx) gs st n in + let int_n = + match eval_n with + | `Int i -> (match ID.to_int i with + | Some x -> Z.to_int x + | _ -> -1) + | _ -> -1 in + (* when s1 and s2 type coincide, compare both strings, otherwise use top *) + let value = if typeSig s1_typ = typeSig s2_typ then + `Int(AD.string_comparison s1_a s2_a (Some int_n)) + else + VD.top_value (unrollType dest_typ) in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | None -> ctx.local + end | Abort, _ -> raise Deadcode | ThreadExit { ret_val = exp }, _ -> begin match ThreadId.get_current (Analyses.ask_of_ctx ctx) with diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index 74367ccbbc..c8f7bb4fc3 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -65,6 +65,8 @@ type special = | Strncat of { dest:Cil.exp; src: Cil.exp; n: Cil.exp; } | Strlen of Cil.exp | Strstr of { haystack: Cil.exp; needle: Cil.exp; } + | Strcmp of { s1: Cil.exp; s2: Cil.exp; } + | Strncmp of { s1: Cil.exp; s2: Cil.exp; n: Cil.exp; } | Abort | Identity of Cil.exp (** Identity function. Some compiler optimization annotation functions map to this. *) | Setjmp of { env: Cil.exp; } diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index a626529140..812eb53ad9 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -20,6 +20,8 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; }); ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); ("strstr", special [__ "haystack" [r]; __ "needle" [r]] @@ fun haystack needle -> Strstr { haystack; needle; }); + ("strcmp", special [__ "s1" [r]; __ "s2" [r]] @@ fun s1 s2 -> Strcmp { s1; s2; }); + ("strncmp", special [__ "s1" [r]; __ "s2" [r]; __ "n" []] @@ fun s1 s2 n -> Strncmp { s1; s2; n; }); ("malloc", special [__ "size" []] @@ fun size -> Malloc size); ("realloc", special [__ "ptr" [r; f]; __ "size" []] @@ fun ptr size -> Realloc { ptr; size }); ("abort", special [] Abort); @@ -672,9 +674,7 @@ let invalidate_actions = [ "__builtin___snprintf_chk", writes [1];(*keep [1]*) "sprintf", writes [1];(*keep [1]*) "sscanf", writesAllButFirst 2 readsAll;(*drop 2*) - "strcmp", readsAll;(*safe*) "strftime", writes [1];(*keep [1]*) - "strncmp", readsAll;(*safe*) "strdup", readsAll;(*safe*) "toupper", readsAll;(*safe*) "tolower", readsAll;(*safe*) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 4a263f2965..58bc183289 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -197,13 +197,39 @@ struct (let substrings = List.fold_left (fun acc elem -> acc @ (List.map (fun s -> compute_substring (extract_string elem) (extract_string s)) needle')) [] haystack' in match List.find_opt is_Some substrings with - (* ... and return bot if no string of needle' is a substring of any string of haystack' *) - | None -> bot () + (* ... and return a null pointer if no string of needle' is a substring of any string of haystack' *) + | None -> null_ptr (* ... or join all combinations *) | Some _ -> List.fold_left join (bot ()) (List.map extract_lval_string substrings)) (* else if any of the input address sets contains an element that isn't a StrPtr, return top *) | _ -> top () + let string_comparison x y n = + let f = match n with + | Some num -> Addr.to_n_string num + | None -> Addr.to_string in + + (* map all StrPtr elements in input address sets to contained strings / n-substrings *) + let x' = List.map Addr.to_string (elements x) in + let y' = List.map f (elements y) in + + (* helper functions *) + let is_None x = if x = None then true else false in + let extract_string = function + | Some s -> s + | None -> failwith "unreachable" in + + match List.find_opt is_None x', List.find_opt is_None y' with + (* if all elements of both lists are Some string *) + | None, None -> + (* ... compare every string of x' with every string of y' *) + (* TODO: in case of only < or only >, is it really assured that the computed value is any negative / positive integer? *) + List.fold_left (fun acc elem -> acc @ (List.map (fun s -> Idx.of_int IInt (Z.of_int (String.compare (extract_string elem) (extract_string s)))) y')) [] x' + (* ... and join all computed IntDomain values *) + |> List.fold_left Idx.join (Idx.bot_of IInt) + (* else if any of the input address sets contains an element that isn't a StrPtr, return top *) + | _ -> Idx.top_of IInt + (* add an & in front of real addresses *) module ShortAddr = struct From 066ed88c3ff9de69b860ebf7c8ab5d7c021bfaa6 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 9 May 2023 14:39:49 +0200 Subject: [PATCH 152/518] `MustBeSingleThreaded` -> `MustBeSingleThreadedUptoCurrent` --- src/analyses/apron/relationPriv.apron.ml | 8 ++++---- src/analyses/base.ml | 4 ++-- src/analyses/threadAnalysis.ml | 2 +- src/analyses/threadFlag.ml | 4 ++-- src/analyses/varEq.ml | 2 +- src/domains/queries.ml | 10 +++++----- 6 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 48057e9e5d..45b843dd80 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -95,7 +95,7 @@ struct let sync (ask: Q.ask) getg sideg (st: relation_components_t) reason = match reason with | `Join -> - if (ask.f Q.MustBeSingleThreaded) then + if (ask.f Q.MustBeSingleThreadedUptoCurrent) then st else (* must be like enter_multithreaded *) @@ -342,7 +342,7 @@ struct st end | `Join -> - if (ask.f Q.MustBeSingleThreaded) then + if (ask.f Q.MustBeSingleThreadedUptoCurrent) then st else (* must be like enter_multithreaded *) @@ -548,7 +548,7 @@ struct st end | `Join -> - if (ask.f Q.MustBeSingleThreaded) then + if (ask.f Q.MustBeSingleThreadedUptoCurrent) then st else let rel = st.rel in @@ -1031,7 +1031,7 @@ struct match reason with | `Return -> st (* TODO: implement? *) | `Join -> - if (ask.f Q.MustBeSingleThreaded) then + if (ask.f Q.MustBeSingleThreadedUptoCurrent) then st else let rel = st.rel in diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 2e797e75ec..21ce7c2f31 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2463,14 +2463,14 @@ struct let asked' = Queries.Set.add anyq asked in let r: a Queries.result = match q with - | MustBeSingleThreaded when single -> true + | MustBeSingleThreadedUptoCurrent when single -> true | MayEscape _ | MayBePublic _ | MayBePublicWithout _ | MustBeProtectedBy _ | MustLockset | MustBeAtomic - | MustBeSingleThreaded + | MustBeSingleThreadedUptoCurrent | MustBeUniqueThread | CurrentThreadId | MayBeThreadReturn diff --git a/src/analyses/threadAnalysis.ml b/src/analyses/threadAnalysis.ml index 3d7fae74fa..1cad0b38a8 100644 --- a/src/analyses/threadAnalysis.ml +++ b/src/analyses/threadAnalysis.ml @@ -67,7 +67,7 @@ struct | `Lifted tid -> not (is_not_unique ctx tid) | _ -> false end - | Queries.MustBeSingleThreaded -> begin + | Queries.MustBeSingleThreadedUptoCurrent -> begin let tid = ThreadId.get_current (Analyses.ask_of_ctx ctx) in match tid with | `Lifted tid when T.is_main tid -> D.is_empty ctx.local diff --git a/src/analyses/threadFlag.ml b/src/analyses/threadFlag.ml index b2b0be023b..18c9b20a11 100644 --- a/src/analyses/threadFlag.ml +++ b/src/analyses/threadFlag.ml @@ -8,7 +8,7 @@ open Analyses let is_multi (ask: Queries.ask): bool = if !GU.global_initialization then false else - not (ask.f Queries.MustBeSingleThreaded) + not (ask.f Queries.MustBeSingleThreadedUptoCurrent) module Spec = @@ -41,7 +41,7 @@ struct let query ctx (type a) (x: a Queries.t): a Queries.result = match x with - | Queries.MustBeSingleThreaded -> not (Flag.is_multi ctx.local) + | Queries.MustBeSingleThreadedUptoCurrent -> not (Flag.is_multi ctx.local) | Queries.MustBeUniqueThread -> not (Flag.is_not_main ctx.local) (* This used to be in base but also commented out. *) (* | Queries.MayBePublic _ -> Flag.is_multi ctx.local *) diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index eb44f4d508..0ae2aceea7 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -434,7 +434,7 @@ struct let d_local = (* if we are multithreaded, we run the risk, that some mutex protected variables got unlocked, so in this case caller state goes to top TODO: !!Unsound, this analysis does not handle this case -> regtest 63 08!! *) - if Queries.LS.is_top tainted || not (ctx.ask Queries.MustBeSingleThreaded) then + if Queries.LS.is_top tainted || not (ctx.ask Queries.MustBeSingleThreadedUptoCurrent) then D.top () else let taint_exp = Queries.ES.of_list (List.map (fun lv -> Lval (Lval.CilLval.to_lval lv)) (Queries.LS.elements tainted)) in diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 66db991826..5b32e27faa 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -66,7 +66,7 @@ type _ t = | MustBeProtectedBy: mustbeprotectedby -> MustBool.t t | MustLockset: LS.t t | MustBeAtomic: MustBool.t t - | MustBeSingleThreaded: MustBool.t t + | MustBeSingleThreadedUptoCurrent: MustBool.t t | MustBeUniqueThread: MustBool.t t | CurrentThreadId: ThreadIdDomain.ThreadLifted.t t | MayBeThreadReturn: MayBool.t t @@ -130,7 +130,7 @@ struct | IsHeapVar _ -> (module MayBool) | MustBeProtectedBy _ -> (module MustBool) | MustBeAtomic -> (module MustBool) - | MustBeSingleThreaded -> (module MustBool) + | MustBeSingleThreadedUptoCurrent -> (module MustBool) | MustBeUniqueThread -> (module MustBool) | EvalInt _ -> (module ID) | EvalLength _ -> (module ID) @@ -189,7 +189,7 @@ struct | IsHeapVar _ -> MayBool.top () | MustBeProtectedBy _ -> MustBool.top () | MustBeAtomic -> MustBool.top () - | MustBeSingleThreaded -> MustBool.top () + | MustBeSingleThreadedUptoCurrent -> MustBool.top () | MustBeUniqueThread -> MustBool.top () | EvalInt _ -> ID.top () | EvalLength _ -> ID.top () @@ -241,7 +241,7 @@ struct | Any (MustBeProtectedBy _) -> 9 | Any MustLockset -> 10 | Any MustBeAtomic -> 11 - | Any MustBeSingleThreaded -> 12 + | Any MustBeSingleThreadedUptoCurrent -> 12 | Any MustBeUniqueThread -> 13 | Any CurrentThreadId -> 14 | Any MayBeThreadReturn -> 15 @@ -371,7 +371,7 @@ struct | Any (MustBeProtectedBy x) -> Pretty.dprintf "MustBeProtectedBy _" | Any MustLockset -> Pretty.dprintf "MustLockset" | Any MustBeAtomic -> Pretty.dprintf "MustBeAtomic" - | Any MustBeSingleThreaded -> Pretty.dprintf "MustBeSingleThreaded" + | Any MustBeSingleThreadedUptoCurrent -> Pretty.dprintf "MustBeSingleThreaded" | Any MustBeUniqueThread -> Pretty.dprintf "MustBeUniqueThread" | Any CurrentThreadId -> Pretty.dprintf "CurrentThreadId" | Any MayBeThreadReturn -> Pretty.dprintf "MayBeThreadReturn" From bddce0fbd82c0ba940399f00b721f64aa1100f20 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 10 May 2023 11:23:07 +0200 Subject: [PATCH 153/518] Add unsoundness example --- tests/regression/58-base-mm-tid/24-phases.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/58-base-mm-tid/24-phases.c b/tests/regression/58-base-mm-tid/24-phases.c index bcb527e182..24e3b2f2f2 100644 --- a/tests/regression/58-base-mm-tid/24-phases.c +++ b/tests/regression/58-base-mm-tid/24-phases.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins --set ana.activated[+] thread #include #include From 681e8831383ef88187ea06426a919581aa23c376 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 10 May 2023 17:04:04 +0300 Subject: [PATCH 154/518] Add invariant function to array domains --- src/cdomains/arrayDomain.ml | 25 +++++++++++++++++++++++++ src/cdomains/arrayDomain.mli | 1 + src/cdomains/valueDomain.ml | 1 + 3 files changed, 27 insertions(+) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index 982cd94058..b3b83d999c 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -61,6 +61,7 @@ sig val smart_leq: (exp -> BI.t option) -> (exp -> BI.t option) -> t -> t -> bool val update_length: idx -> t -> t val project: ?varAttr:attributes -> ?typAttr:attributes -> VDQ.t -> t -> t + val invariant: value_invariant:(offset:Cil.offset -> lval:Cil.lval -> value -> Invariant.t) -> offset:Cil.offset -> lval:Cil.lval -> t -> Invariant.t end module type LatticeWithSmartOps = @@ -100,6 +101,9 @@ struct let smart_leq _ _ = leq let update_length _ x = x let project ?(varAttr=[]) ?(typAttr=[]) _ t = t + + let invariant ~value_invariant ~offset ~lval x = + Invariant.none (* TODO *) end let factor () = @@ -188,6 +192,9 @@ struct let smart_leq _ _ = leq let update_length _ x = x let project ?(varAttr=[]) ?(typAttr=[]) _ t = t + + let invariant ~value_invariant ~offset ~lval x = + Invariant.none (* TODO *) end (** Special signature so that we can use the _with_length functions from PartitionedWithLength but still match the interface * @@ -701,6 +708,9 @@ struct let update_length _ x = x let project ?(varAttr=[]) ?(typAttr=[]) _ t = t + + let invariant ~value_invariant ~offset ~lval x = + Invariant.none (* TODO *) end (* This is the main array out of bounds check *) @@ -759,6 +769,9 @@ struct let project ?(varAttr=[]) ?(typAttr=[]) _ t = t + let invariant ~value_invariant ~offset ~lval (x, _) = + Base.invariant ~value_invariant ~offset ~lval x + let printXml f (x,y) = BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n\n" (XmlUtil.escape (Base.name ())) Base.printXml x "length" Idx.printXml y @@ -811,6 +824,9 @@ struct let project ?(varAttr=[]) ?(typAttr=[]) _ t = t + let invariant ~value_invariant ~offset ~lval (x, _) = + Base.invariant ~value_invariant ~offset ~lval x + let printXml f (x,y) = BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n\n" (XmlUtil.escape (Base.name ())) Base.printXml x "length" Idx.printXml y @@ -852,6 +868,9 @@ struct let project ?(varAttr=[]) ?(typAttr=[]) _ t = t + let invariant ~value_invariant ~offset ~lval (x, _) = + Base.invariant ~value_invariant ~offset ~lval x + let printXml f (x,y) = BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n\n" (XmlUtil.escape (Base.name ())) Base.printXml x "length" Idx.printXml y @@ -972,4 +991,10 @@ struct | UnrolledDomain, (None, Some (Some x, None)) -> to_t @@ (None, None, Some (unroll_of_trivial ask x) ) | UnrolledDomain, (None, Some (None, Some x)) -> to_t @@ (None, None, Some x) | _ -> failwith "AttributeConfiguredArrayDomain received a value where not exactly one component is set" + + let invariant ~value_invariant ~offset ~lval = + unop' + (P.invariant ~value_invariant ~offset ~lval) + (T.invariant ~value_invariant ~offset ~lval) + (U.invariant ~value_invariant ~offset ~lval) end diff --git a/src/cdomains/arrayDomain.mli b/src/cdomains/arrayDomain.mli index 8386deb541..91e526235d 100644 --- a/src/cdomains/arrayDomain.mli +++ b/src/cdomains/arrayDomain.mli @@ -57,6 +57,7 @@ sig val update_length: idx -> t -> t val project: ?varAttr:Cil.attributes -> ?typAttr:Cil.attributes -> VDQ.t -> t -> t + val invariant: value_invariant:(offset:Cil.offset -> lval:Cil.lval -> value -> Invariant.t) -> offset:Cil.offset -> lval:Cil.lval -> t -> Invariant.t end module type LatticeWithSmartOps = diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 882b66859e..6e06d8a75f 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -1317,6 +1317,7 @@ struct | `Address n -> ad_invariant ~vs ~offset ~lval n | `Struct n -> Structs.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n | `Union n -> Unions.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n + | `Array n -> CArrays.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n | `Blob n when GobConfig.get_bool "ana.base.invariant.blobs" -> blob_invariant ~vs ~offset ~lval n | _ -> Invariant.none (* TODO *) From edeb2cf0519720223a757586390b69d2ef5d2a27 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 10 May 2023 17:26:11 +0300 Subject: [PATCH 155/518] Add witness invariant to trivial array domain --- src/cdomains/arrayDomain.ml | 12 +++++++++++- src/domains/invariantCil.ml | 3 ++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index b3b83d999c..aa1827aa87 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -103,7 +103,17 @@ struct let project ?(varAttr=[]) ?(typAttr=[]) _ t = t let invariant ~value_invariant ~offset ~lval x = - Invariant.none (* TODO *) + match offset with + (* invariants for all indices *) + | NoOffset -> + let i_lval = Cil.addOffsetLval (Index (MyCFG.all_array_index_exp, NoOffset)) lval in + value_invariant ~offset ~lval:i_lval x + (* invariant for one index *) + | Index (i, offset) -> + value_invariant ~offset ~lval x + (* invariant for one field *) + | Field (f, offset) -> + Invariant.none end let factor () = diff --git a/src/domains/invariantCil.ml b/src/domains/invariantCil.ml index 2e647f6920..181b24a0bd 100644 --- a/src/domains/invariantCil.ml +++ b/src/domains/invariantCil.ml @@ -57,7 +57,8 @@ class exp_contains_tmp_visitor (acc: bool ref) = object method! vexpr (e: exp) = if e = MyCFG.unknown_exp then ( - acc := true; + (* TODO: add config option *) + (* acc := true; *) SkipChildren ) else From 0d1b161d957b1394648f57f5cda1937c122289ae Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 10 May 2023 17:37:45 +0300 Subject: [PATCH 156/518] Add witness invariant to unrolled array domain --- src/cdomains/arrayDomain.ml | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index aa1827aa87..281fb9deb4 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -203,8 +203,29 @@ struct let update_length _ x = x let project ?(varAttr=[]) ?(typAttr=[]) _ t = t - let invariant ~value_invariant ~offset ~lval x = - Invariant.none (* TODO *) + let invariant ~value_invariant ~offset ~lval ((xl, xr) as x) = + match offset with + (* invariants for all indices *) + | NoOffset -> + let i_all = + if Val.is_bot xr then + Invariant.top () + else ( + let i_lval = Cil.addOffsetLval (Index (MyCFG.all_array_index_exp, NoOffset)) lval in + value_invariant ~offset ~lval:i_lval (join_of_all_parts x) + ) + in + BatList.fold_lefti (fun acc i x -> + let i_lval = Cil.addOffsetLval (Index (Cil.integer i, NoOffset)) lval in + let i = value_invariant ~offset ~lval:i_lval x in + Invariant.(acc && i) + ) i_all xl + (* invariant for one index *) + | Index (i, offset) -> + Invariant.none (* TODO: look up *) + (* invariant for one field *) + | Field (f, offset) -> + Invariant.none end (** Special signature so that we can use the _with_length functions from PartitionedWithLength but still match the interface * From d08a86f8d14402dcbf729ff1ea46588a16d3a56e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 10 May 2023 17:48:01 +0300 Subject: [PATCH 157/518] Add witness invariant to partitioned array domain --- src/cdomains/arrayDomain.ml | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index 281fb9deb4..6dcc54569e 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -741,7 +741,17 @@ struct let project ?(varAttr=[]) ?(typAttr=[]) _ t = t let invariant ~value_invariant ~offset ~lval x = - Invariant.none (* TODO *) + match offset with + (* invariants for all indices *) + | NoOffset -> + let i_lval = Cil.addOffsetLval (Index (MyCFG.all_array_index_exp, NoOffset)) lval in + value_invariant ~offset ~lval:i_lval (join_of_all_parts x) + (* invariant for one index *) + | Index (i, offset) -> + Invariant.none (* TODO: look up *) + (* invariant for one field *) + | Field (f, offset) -> + Invariant.none end (* This is the main array out of bounds check *) From f41529fd1872cc3648c2298e6f709e4dde9572e7 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 10 May 2023 18:08:42 +0300 Subject: [PATCH 158/518] Add array unassume test --- .../56-witness/44-base-unassume-array.c | 16 +++++ .../56-witness/44-base-unassume-array.yml | 58 +++++++++++++++++++ 2 files changed, 74 insertions(+) create mode 100644 tests/regression/56-witness/44-base-unassume-array.c create mode 100644 tests/regression/56-witness/44-base-unassume-array.yml diff --git a/tests/regression/56-witness/44-base-unassume-array.c b/tests/regression/56-witness/44-base-unassume-array.c new file mode 100644 index 0000000000..c3928ae233 --- /dev/null +++ b/tests/regression/56-witness/44-base-unassume-array.c @@ -0,0 +1,16 @@ +// PARAM: --set ana.activated[+] unassume --set witness.yaml.unassume 44-base-unassume-array.yml --enable ana.int.interval +#include + +int main() { + int a[10]; + + for (int i = 0; i < 3; i++) { + a[i] = i; + } + + for (int i = 0; i < 10; i++) { + __goblint_check(a[i] >= 0); + __goblint_check(a[i] < 3); + } + return 0; +} diff --git a/tests/regression/56-witness/44-base-unassume-array.yml b/tests/regression/56-witness/44-base-unassume-array.yml new file mode 100644 index 0000000000..0a587c4ace --- /dev/null +++ b/tests/regression/56-witness/44-base-unassume-array.yml @@ -0,0 +1,58 @@ +- entry_type: loop_invariant + metadata: + format_version: "0.1" + uuid: c03a4c45-567e-4791-ac75-0675f782dc8c + creation_time: 2023-05-10T15:02:06Z + producer: + name: Goblint + version: heads/array-witness-invariant-0-gfb806119b-dirty + command_line: '''/home/simmo/dev/goblint/sv-comp/goblint/goblint'' ''44-base-unassume-array.c'' + ''--enable'' ''ana.int.interval'' ''--enable'' ''witness.yaml.enabled'' ''--set'' + ''dbg.debug'' ''true'' ''--enable'' ''dbg.timing.enabled'' ''--set'' ''goblint-dir'' + ''.goblint-56-44''' + task: + input_files: + - 44-base-unassume-array.c + input_file_hashes: + 44-base-unassume-array.c: 9d9dc013c8d8aee483852aa73d0b4ac48ee7ea0f5433dc86ee28c3fe54c49726 + data_model: LP64 + language: C + location: + file_name: 44-base-unassume-array.c + file_hash: 9d9dc013c8d8aee483852aa73d0b4ac48ee7ea0f5433dc86ee28c3fe54c49726 + line: 7 + column: 6 + function: main + loop_invariant: + string: 0 <= a[(long )"__unknown_value__"] + type: assertion + format: C +- entry_type: loop_invariant + metadata: + format_version: "0.1" + uuid: c03a4c45-567e-4791-ac75-0675f782dc8c + creation_time: 2023-05-10T15:02:06Z + producer: + name: Goblint + version: heads/array-witness-invariant-0-gfb806119b-dirty + command_line: '''/home/simmo/dev/goblint/sv-comp/goblint/goblint'' ''44-base-unassume-array.c'' + ''--enable'' ''ana.int.interval'' ''--enable'' ''witness.yaml.enabled'' ''--set'' + ''dbg.debug'' ''true'' ''--enable'' ''dbg.timing.enabled'' ''--set'' ''goblint-dir'' + ''.goblint-56-44''' + task: + input_files: + - 44-base-unassume-array.c + input_file_hashes: + 44-base-unassume-array.c: 9d9dc013c8d8aee483852aa73d0b4ac48ee7ea0f5433dc86ee28c3fe54c49726 + data_model: LP64 + language: C + location: + file_name: 44-base-unassume-array.c + file_hash: 9d9dc013c8d8aee483852aa73d0b4ac48ee7ea0f5433dc86ee28c3fe54c49726 + line: 7 + column: 6 + function: main + loop_invariant: + string: a[(long )"__unknown_value__"] < 3 + type: assertion + format: C From f6962bb5673b8899945991368b658d1ac69e5ad9 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Thu, 11 May 2023 12:39:26 +0200 Subject: [PATCH 159/518] String literals analyses: fixed wrong behavior + cleaned up code --- src/analyses/base.ml | 156 +++++++++++-------------------- src/analyses/libraryDesc.ml | 9 +- src/analyses/libraryFunctions.ml | 12 +-- src/cdomains/addressDomain.ml | 105 +++++++++------------ 4 files changed, 105 insertions(+), 177 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 8e64206c70..7a2e39b08c 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2057,6 +2057,42 @@ struct let st: store = ctx.local in let gs = ctx.global in let desc = LF.find f in + (* for string functions *) + let eval_n = function + (* if only n characters of a given string are needed, evaluate expression n to an integer option *) + | Some n -> + begin match eval_rv (Analyses.ask_of_ctx ctx) gs st n with + | `Int i -> + begin match ID.to_int i with + | Some x -> Some (Z.to_int x) + | _ -> Some (-1) + end + | _ -> Some (-1) + end + (* do nothing if all characters are needed *) + | _ -> None + in + let string_manipulation s1 s2 lv all op = + let s1_a, s1_typ = addr_type_of_exp s1 in + let s2_a, s2_typ = addr_type_of_exp s2 in + (* when whished types coincide, compute result of operation op, otherwise use top *) + match lv with + | Some s -> + let lv_a, lv_typ = addr_type_of_exp s in + if all && typeSig s1_typ = typeSig s2_typ && typeSig s2_typ = typeSig lv_typ then (* all types need to coincide *) + lv_a, lv_typ, (op s1_a s2_a) + else if not all && typeSig s1_typ = typeSig s2_typ then (* only the types of s1 and s2 need to coincide *) + lv_a, lv_typ, (op s1_a s2_a) + else + lv_a, lv_typ, (VD.top_value (unrollType lv_typ)) + | None -> + if typeSig s1_typ = typeSig s2_typ then + let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:s2 ~newt:(TPtr (s1_typ, []))) ~off:NoOffset in + let s2_cast_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in + s1_a, s1_typ, (op s1_a s2_cast_a) + else + s1_a, s1_typ, (VD.top_value (unrollType s1_typ)) + in let st = match desc.special args, f.vname with | Memset { dest; ch; count; }, _ -> (* TODO: check count *) @@ -2077,13 +2113,8 @@ struct let value = VD.zero_init_value dest_typ in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Memcpy { dest = dst; src }, _ - | Strcpy { dest = dst; src }, _ -> - (* invalidating from interactive *) - (* let dest_a, dest_typ = addr_type_of_exp dst in - let value = VD.top_value dest_typ in - set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value *) - (* TODO: reuse addr_type_of_exp for master *) - (* assigning from master *) + (* strcpy(dest, src); *) + | Strcpy { dest = dst; src; n = None }, _ -> let dest_a, dest_typ = addr_type_of_exp dst in let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval @@ -2096,63 +2127,18 @@ struct VD.top_value (unrollType dest_typ) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value - | Strncpy { dest = dst; src; n }, _ -> - let dest_a, dest_typ = addr_type_of_exp dst in - let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in - let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval - |> AD.get_type in - (* evaluate amount of characters which are to be extracted of src *) - let eval_n = eval_rv (Analyses.ask_of_ctx ctx) gs st n in - let int_n = - match eval_n with - | `Int i -> (match ID.to_int i with - | Some x -> Z.to_int x - | _ -> -1) - | _ -> -1 in - (* when src and destination type coincide, take n-substring value from the source, otherwise use top *) - let value = if typeSig dest_typ = typeSig src_typ then - let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in - let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in - `Address(AD.to_n_string int_n src_a) - else - VD.top_value (unrollType dest_typ) - in - set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value - | Strcat { dest = dst; src }, _ -> - let dest_a, dest_typ = addr_type_of_exp dst in - let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in - let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval - |> AD.get_type in - (* when src and destination type coincide, concatenate src to dest, otherwise use top *) - let value = if typeSig dest_typ = typeSig src_typ then - let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in - let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in - `Address(AD.string_concat dest_a src_a None) - else - VD.top_value (unrollType dest_typ) - in - set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value - | Strncat { dest = dst; src; n }, _ -> - let dest_a, dest_typ = addr_type_of_exp dst in - let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in - let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval - |> AD.get_type in - (* evaluate amount of characters which are to be extracted of src *) - let eval_n = eval_rv (Analyses.ask_of_ctx ctx) gs st n in - let int_n = - match eval_n with - | `Int i -> (match ID.to_int i with - | Some x -> Z.to_int x - | _ -> -1) - | _ -> -1 in - (* when src and destination type coincide, concatenate n-substring from src to dest, otherwise use top *) - let value = if typeSig dest_typ = typeSig src_typ then - let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in - let src_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in - `Address(AD.string_concat dest_a src_a (Some int_n)) - else - VD.top_value (unrollType dest_typ) - in + (* strncpy(dest, src, n); *) + | Strcpy { dest = dst; src; n }, _ -> + begin match eval_n n with + | Some num -> + (* when src and destination type coincide, take n-substring value from the source, otherwise use top *) + let dest_a, dest_typ, value = string_manipulation dst src None false (fun _ src_a -> `Address(AD.to_n_string num src_a)) in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | None -> failwith "already handled in case above" + end + | Strcat { dest = dst; src; n }, _ -> + (* when src and destination type coincide, concatenate the whole string or a n-substring from src to dest, otherwise use top *) + let dest_a, dest_typ, value = string_manipulation dst src None false (fun dest_a src_a -> `Address(AD.string_concat dest_a src_a (eval_n n))) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Strlen s, _ -> begin match lv with @@ -2167,52 +2153,18 @@ struct | Strstr { haystack; needle }, _ -> begin match lv with | Some v -> - let haystack_a, haystack_typ = addr_type_of_exp haystack in - let needle_a, needle_typ = addr_type_of_exp needle in - let dest_a, dest_typ = addr_type_of_exp (Lval v) in (* when haystack, needle and dest type coincide, check if needle is a substring of haystack: if that is the case, assign the substring of haystack starting at the first occurrence of needle to dest, else use top *) - let value = if typeSig dest_typ = typeSig haystack_typ && typeSig haystack_typ = typeSig needle_typ then - `Address(AD.substring_extraction haystack_a needle_a) - else - VD.top_value (unrollType dest_typ) in + let dest_a, dest_typ, value = string_manipulation haystack needle (Some (Lval v)) true (fun h_a n_a -> `Address(AD.substring_extraction h_a n_a)) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | None -> ctx.local end - | Strcmp { s1; s2 }, _ -> + | Strcmp { s1; s2; n }, _ -> begin match lv with | Some v -> - let s1_a, s1_typ = addr_type_of_exp s1 in - let s2_a, s2_typ = addr_type_of_exp s2 in - let dest_a, dest_typ = addr_type_of_exp (Lval v) in - (* when s1 and s2 type coincide, compare both strings, otherwise use top *) - let value = if typeSig s1_typ = typeSig s2_typ then - `Int(AD.string_comparison s1_a s2_a None) - else - VD.top_value (unrollType dest_typ) in - set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value - | None -> ctx.local - end - | Strncmp { s1; s2; n }, _ -> - begin match lv with - | Some v -> - let s1_a, s1_typ = addr_type_of_exp s1 in - let s2_a, s2_typ = addr_type_of_exp s2 in - let dest_a, dest_typ = addr_type_of_exp (Lval v) in - (* evaluate amount of characters which are to be extracted of src *) - let eval_n = eval_rv (Analyses.ask_of_ctx ctx) gs st n in - let int_n = - match eval_n with - | `Int i -> (match ID.to_int i with - | Some x -> Z.to_int x - | _ -> -1) - | _ -> -1 in - (* when s1 and s2 type coincide, compare both strings, otherwise use top *) - let value = if typeSig s1_typ = typeSig s2_typ then - `Int(AD.string_comparison s1_a s2_a (Some int_n)) - else - VD.top_value (unrollType dest_typ) in + (* when s1 and s2 type coincide, compare both both strings completely or their first n characters, otherwise use top *) + let dest_a, dest_typ, value = string_manipulation s1 s2 (Some (Lval v)) false (fun s1_a s2_a -> `Int(AD.string_comparison s1_a s2_a (eval_n n))) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | None -> ctx.local end diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index c8f7bb4fc3..9675df65de 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -59,14 +59,11 @@ type special = | Memset of { dest: Cil.exp; ch: Cil.exp; count: Cil.exp; } | Bzero of { dest: Cil.exp; count: Cil.exp; } | Memcpy of { dest: Cil.exp; src: Cil.exp } - | Strcpy of { dest: Cil.exp; src: Cil.exp; } - | Strncpy of { dest: Cil.exp; src: Cil.exp; n: Cil.exp; } - | Strcat of { dest: Cil.exp; src: Cil.exp; } - | Strncat of { dest:Cil.exp; src: Cil.exp; n: Cil.exp; } + | Strcpy of { dest: Cil.exp; src: Cil.exp; n: Cil.exp option; } + | Strcat of { dest: Cil.exp; src: Cil.exp; n: Cil.exp option; } | Strlen of Cil.exp | Strstr of { haystack: Cil.exp; needle: Cil.exp; } - | Strcmp of { s1: Cil.exp; s2: Cil.exp; } - | Strncmp of { s1: Cil.exp; s2: Cil.exp; n: Cil.exp; } + | Strcmp of { s1: Cil.exp; s2: Cil.exp; n: Cil.exp option; } | Abort | Identity of Cil.exp (** Identity function. Some compiler optimization annotation functions map to this. *) | Setjmp of { env: Cil.exp; } diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 812eb53ad9..fab17e3d7e 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -14,14 +14,14 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("memcpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Memcpy { dest; src }); ("__builtin_memcpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Memcpy { dest; src }); ("__builtin___memcpy_chk", special [__ "dest" [w]; __ "src" [r]; drop "n" []; drop "os" []] @@ fun dest src -> Memcpy { dest; src }); - ("strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strncpy { dest; src; n; }); - ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; }); - ("strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strncat { dest; src; n; }); - ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; }); + ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; n = None; }); + ("strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); + ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); + ("strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); ("strstr", special [__ "haystack" [r]; __ "needle" [r]] @@ fun haystack needle -> Strstr { haystack; needle; }); - ("strcmp", special [__ "s1" [r]; __ "s2" [r]] @@ fun s1 s2 -> Strcmp { s1; s2; }); - ("strncmp", special [__ "s1" [r]; __ "s2" [r]; __ "n" []] @@ fun s1 s2 n -> Strncmp { s1; s2; n; }); + ("strcmp", special [__ "s1" [r]; __ "s2" [r]] @@ fun s1 s2 -> Strcmp { s1; s2; n = None; }); + ("strncmp", special [__ "s1" [r]; __ "s2" [r]; __ "n" []] @@ fun s1 s2 n -> Strcmp { s1; s2; n = Some n; }); ("malloc", special [__ "size" []] @@ fun size -> Malloc size); ("realloc", special [__ "ptr" [r; f]; __ "size" []] @@ fun ptr size -> Realloc { ptr; size }); ("abort", special [] Abort); diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 58bc183289..70237816aa 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -113,16 +113,8 @@ struct | None -> top () in (* maps any StrPtr for which n is valid to the prefix of length n of its content, otherwise maps to top *) List.map (transform n) (elements x) - (* returns the least upper bound of computed AddressDomain values *) + (* and returns the least upper bound of computed AddressDomain values *) |> List.fold_left join (bot ()) - (* let to_n_string n x = - let n_string_list = List.map (Addr.to_n_string n) (elements x) in - match List.find_opt (fun x -> if x = None then true else false) n_string_list with - (* returns top if input address set contains an element that isn't a StrPtr or if n isn't valid *) - | Some _ -> top () - (* else returns the least upper bound of all substrings of length n *) - | None -> List.map (fun x -> match x with Some s -> from_string s | None -> failwith "unreachable") n_string_list - |> List.fold_left join (bot ()) *) let to_string_length x = let transform elem = @@ -131,16 +123,8 @@ struct | None -> Idx.top_of IUInt in (* maps any StrPtr to the length of its content, otherwise maps to top *) List.map transform (elements x) - (* returns the least upper bound of computed IntDomain values *) + (* and returns the least upper bound of computed IntDomain values *) |> List.fold_left Idx.join (Idx.bot_of IUInt) - (* let to_string_length x = - let length_list = List.map Addr.to_string_length (elements x) in - match List.find_opt (fun x -> if x = None then true else false) length_list with - (* returns top if input address set contains an element that isn't a StrPtr *) - | Some _ -> Idx.top_of IUInt - (* else returns the least upper bound of all lengths *) - | None -> List.map (fun x -> match x with Some y -> Idx.of_int IUInt (Z.of_int y) | None -> failwith "unreachable") length_list - |> List.fold_left Idx.join (Idx.bot_of IUInt) *) let string_concat x y n = let f = match n with @@ -151,21 +135,19 @@ struct let x' = List.map Addr.to_string (elements x) in let y' = List.map f (elements y) in - (* helper functions *) - let is_None x = if x = None then true else false in + (* helper function *) let extract_string = function | Some s -> s | None -> failwith "unreachable" in - match List.find_opt is_None x', List.find_opt is_None y' with - (* if all elements of both lists are Some string *) - | None, None -> - (* ... concatenate every string of x' with every string of y' *) - List.fold_left (fun acc elem -> acc @ (List.map (fun s -> from_string ((extract_string elem) ^ (extract_string s))) y')) [] x' - (* ... and join all combinations *) + (* if any of the input address sets contains an element that isn't a StrPtr, return top *) + if List.exists ((=) None) x' || List.exists ((=) None) y' then + top () + else + (* else concatenate every string of x' with every string of y' and return the least upper bound *) + BatList.cartesian_product x' y' + |> List.map (fun (s1, s2) -> from_string ((extract_string s1) ^ (extract_string s2))) |> List.fold_left join (bot ()) - (* else if any of the input address sets contains an element that isn't a StrPtr, return top *) - | _ -> top () let substring_extraction haystack needle = (* map all StrPtr elements in input address sets to contained strings *) @@ -173,36 +155,28 @@ struct let needle' = List.map Addr.to_string (elements needle) in (* helper functions *) - let is_None = function None -> true | Some _ -> false in - let is_Some = function Some _ -> true | None -> false in let extract_string = function | Some s -> s | None -> failwith "unreachable" in let extract_lval_string = function | Some s -> from_string s - | None -> top () in + | None -> null_ptr in let compute_substring s1 s2 = - let i = - try Str.search_forward (Str.regexp_string s2) s1 0 - with Not_found -> -1 in - if i < 0 then - None - else - Some (String.sub s1 i (String.length s1 - i)) in - - match List.find_opt is_None haystack', List.find_opt is_None needle' with - (* if all elements of both lists are Some string *) - | None, None -> - (* ... try to extract substrings *) - (let substrings = List.fold_left (fun acc elem -> - acc @ (List.map (fun s -> compute_substring (extract_string elem) (extract_string s)) needle')) [] haystack' in - match List.find_opt is_Some substrings with - (* ... and return a null pointer if no string of needle' is a substring of any string of haystack' *) - | None -> null_ptr - (* ... or join all combinations *) - | Some _ -> List.fold_left join (bot ()) (List.map extract_lval_string substrings)) - (* else if any of the input address sets contains an element that isn't a StrPtr, return top *) - | _ -> top () + try + let i = Str.search_forward (Str.regexp_string s2) s1 0 in + Some (String.sub s1 i (String.length s1 - i)) + with Not_found -> None in + + (* if any of the input address sets contains an element that isn't a StrPtr, return top *) + if List.exists ((=) None) haystack' || List.exists ((=) None) needle' then + top () + else + (* else try to find the first occurrence of all strings in needle' in all strings s of haystack', + collect s starting from that occurrence or if there is none, collect a NULL pointer, + and return the least upper bound *) + BatList.cartesian_product haystack' needle' + |> List.map (fun (s1, s2) -> extract_lval_string (compute_substring (extract_string s1) (extract_string s2))) + |> List.fold_left join (bot ()) let string_comparison x y n = let f = match n with @@ -210,25 +184,30 @@ struct | None -> Addr.to_string in (* map all StrPtr elements in input address sets to contained strings / n-substrings *) - let x' = List.map Addr.to_string (elements x) in + let x' = List.map f (elements x) in let y' = List.map f (elements y) in (* helper functions *) - let is_None x = if x = None then true else false in let extract_string = function | Some s -> s | None -> failwith "unreachable" in + let compare s1 s2 = + let res = String.compare s1 s2 in + if res = 0 then + Idx.of_int IInt (Z.of_int 0) + else if res > 0 then + Idx.starting IInt (Z.of_int 1) + else + Idx.ending IInt (Z.of_int (-1)) in - match List.find_opt is_None x', List.find_opt is_None y' with - (* if all elements of both lists are Some string *) - | None, None -> - (* ... compare every string of x' with every string of y' *) - (* TODO: in case of only < or only >, is it really assured that the computed value is any negative / positive integer? *) - List.fold_left (fun acc elem -> acc @ (List.map (fun s -> Idx.of_int IInt (Z.of_int (String.compare (extract_string elem) (extract_string s)))) y')) [] x' - (* ... and join all computed IntDomain values *) + (* if any of the input address sets contains an element that isn't a StrPtr, return top *) + if List.exists ((=) None) x' || List.exists ((=) None) y' then + Idx.top_of IInt + else + (* else compare every string of x' with every string of y' and return the least upper bound *) + BatList.cartesian_product x' y' + |> List.map (fun (s1, s2) -> compare (extract_string s1) (extract_string s2)) |> List.fold_left Idx.join (Idx.bot_of IInt) - (* else if any of the input address sets contains an element that isn't a StrPtr, return top *) - | _ -> Idx.top_of IInt (* add an & in front of real addresses *) module ShortAddr = From 66725de522755c850b690d85289b454e0e6135df Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 11 May 2023 14:25:17 +0300 Subject: [PATCH 160/518] Add witness tracing --- src/witness/argTools.ml | 3 +++ src/witness/witness.ml | 7 +++++++ src/witness/witnessConstraints.ml | 9 ++++++++- 3 files changed, 18 insertions(+), 1 deletion(-) diff --git a/src/witness/argTools.ml b/src/witness/argTools.ml index 0db636308e..d323b938b1 100644 --- a/src/witness/argTools.ml +++ b/src/witness/argTools.ml @@ -1,5 +1,7 @@ open MyCFG +module M = Messages + module type BiArg = sig include MyARG.S with module Edge = MyARG.InlineEdge @@ -120,6 +122,7 @@ struct (* Exclude accumulated prevs, which were pruned *) if NHT.mem vars prev_lvar then ( let lvar' = (fst lvar, snd lvar, i) in + if M.tracing then M.trace "witness" "%s -( %a )-> %s\n" (Node.to_string prev_lvar) MyARG.pretty_inline_edge edge (Node.to_string lvar'); NHT.modify_def [] lvar' (fun prevs -> (edge, prev_lvar) :: prevs) prev; NHT.modify_def [] prev_lvar (fun nexts -> (edge, lvar') :: nexts) next ) diff --git a/src/witness/witness.ml b/src/witness/witness.ml index 9a7ce2fe9f..8bc2acf448 100644 --- a/src/witness/witness.ml +++ b/src/witness/witness.ml @@ -3,6 +3,8 @@ open Graphml open Svcomp open GobConfig +module M = Messages + module type WitnessTaskResult = TaskResult with module Arg.Edge = MyARG.InlineEdge let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult): unit = @@ -225,6 +227,7 @@ let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult) NH.add itered_nodes node (); write_node node; let is_sink = TaskResult.is_violation node || TaskResult.is_sink node in + if M.tracing then M.tracei "witness" "iter_node %s\n" (N.to_string node); if not is_sink then begin let edge_to_nodes = Arg.next node @@ -239,7 +242,9 @@ let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult) write_edge node edge to_node | InlinedEdge _ | ThreadEntry _ -> () + if M.tracing then M.tracec "witness" "edge %a to_node %s\n" MyARG.pretty_inline_edge edge (N.to_string to_node); ) edge_to_nodes; + if M.tracing then M.traceu "witness" "iter_node %s\n" (N.to_string node); List.iter (fun (edge, to_node) -> match edge with | MyARG.CFGEdge _ @@ -249,6 +254,8 @@ let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult) | ThreadEntry _ -> () ) edge_to_nodes end + else + if M.tracing then M.traceu "witness" "iter_node %s\n" (N.to_string node); end in diff --git a/src/witness/witnessConstraints.ml b/src/witness/witnessConstraints.ml index d6f20cafae..7849718be9 100644 --- a/src/witness/witnessConstraints.ml +++ b/src/witness/witnessConstraints.ml @@ -221,10 +221,16 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = match q with | Queries.IterPrevVars f -> + if M.tracing then M.tracei "witness" "IterPrevVars\n"; Dom.iter (fun x r -> + if M.tracing then M.tracei "witness" "x = %a\n" Spec.D.pretty x; R.iter (function ((n, c, j), e) -> + if M.tracing then M.tracec "witness" "n = %a\n" Node.pretty_plain n; + if M.tracing then M.tracec "witness" "c = %a\n" Spec.C.pretty c; + if M.tracing then M.tracec "witness" "j = %a\n" Spec.D.pretty j; f (I.to_int x) (n, Obj.repr c, I.to_int j) e - ) r + ) r; + if M.tracing then M.traceu "witness" "\n" ) (fst ctx.local); (* check that sync mappings don't leak into solution (except Function) *) (* TODO: disabled because we now use and leave Sync for every tf, @@ -233,6 +239,7 @@ struct | Function _ -> () (* returns post-sync in FromSpec *) | _ -> assert (Sync.is_bot (snd ctx.local)); end; *) + if M.tracing then M.traceu "witness" "\n"; () | Queries.IterVars f -> Dom.iter (fun x r -> From 3e72ba0d1eeadb9443353bdbab25b205ee41165c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 11 May 2023 14:25:34 +0300 Subject: [PATCH 161/518] Fix duplicate InlineReturn edges in witness --- src/witness/witness.ml | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/src/witness/witness.ml b/src/witness/witness.ml index 8bc2acf448..779f647dec 100644 --- a/src/witness/witness.ml +++ b/src/witness/witness.ml @@ -232,26 +232,29 @@ let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult) let edge_to_nodes = Arg.next node (* TODO: keep control (Test) edges to dead (sink) nodes for violation witness? *) + |> List.filter_map (fun ((edge, to_node) as edge_to_node) -> + match edge with + | MyARG.CFGEdge _ -> + Some edge_to_node + | InlineEntry (_, f, args) -> + Some (InlineEntry (None, f, args), to_node) (* remove lval to avoid duplicate edges in witness *) + | InlineReturn (lval, f, _) -> + Some (InlineReturn (lval, f, []), to_node) (* remove args to avoid duplicate edges in witness *) + | InlinedEdge _ + | ThreadEntry _ -> + None + ) + (* deduplicate after removed lvals/args *) + |> BatList.unique_cmp ~cmp:[%ord: MyARG.inline_edge * N.t] in List.iter (fun (edge, to_node) -> - match edge with - | MyARG.CFGEdge _ - | InlineEntry _ - | InlineReturn _ -> - write_node to_node; - write_edge node edge to_node - | InlinedEdge _ - | ThreadEntry _ -> () if M.tracing then M.tracec "witness" "edge %a to_node %s\n" MyARG.pretty_inline_edge edge (N.to_string to_node); + write_node to_node; + write_edge node edge to_node ) edge_to_nodes; if M.tracing then M.traceu "witness" "iter_node %s\n" (N.to_string node); List.iter (fun (edge, to_node) -> - match edge with - | MyARG.CFGEdge _ - | InlineEntry _ - | InlineReturn _ -> iter_node to_node - | InlinedEdge _ - | ThreadEntry _ -> () + iter_node to_node ) edge_to_nodes end else From 997f9ae5bcb4729161019c719b068dc358ae6d86 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 11 May 2023 14:30:30 +0300 Subject: [PATCH 162/518] Fix witness tracing indentation --- src/witness/witness.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/witness/witness.ml b/src/witness/witness.ml index 779f647dec..4a44e89265 100644 --- a/src/witness/witness.ml +++ b/src/witness/witness.ml @@ -258,7 +258,7 @@ let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult) ) edge_to_nodes end else - if M.tracing then M.traceu "witness" "iter_node %s\n" (N.to_string node); + if M.tracing then M.traceu "witness" "iter_node %s\n" (N.to_string node); end in From 1d5be766e2c69c327f1b532d4b8671f09923c5d2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 11 May 2023 16:53:19 +0300 Subject: [PATCH 163/518] Add strong_all_array_index_exp --- src/cdomains/arrayDomain.ml | 6 +++--- src/framework/myCFG.ml | 3 +++ tests/regression/56-witness/44-base-unassume-array.yml | 4 ++-- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index 6dcc54569e..cffd55d42a 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -106,7 +106,7 @@ struct match offset with (* invariants for all indices *) | NoOffset -> - let i_lval = Cil.addOffsetLval (Index (MyCFG.all_array_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (MyCFG.strong_all_array_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval x (* invariant for one index *) | Index (i, offset) -> @@ -211,7 +211,7 @@ struct if Val.is_bot xr then Invariant.top () else ( - let i_lval = Cil.addOffsetLval (Index (MyCFG.all_array_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (MyCFG.strong_all_array_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) ) in @@ -744,7 +744,7 @@ struct match offset with (* invariants for all indices *) | NoOffset -> - let i_lval = Cil.addOffsetLval (Index (MyCFG.all_array_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (MyCFG.strong_all_array_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) (* invariant for one index *) | Index (i, offset) -> diff --git a/src/framework/myCFG.ml b/src/framework/myCFG.ml index 0742954fe0..3b1522916c 100644 --- a/src/framework/myCFG.ml +++ b/src/framework/myCFG.ml @@ -58,8 +58,11 @@ let unknown_exp : exp = mkString "__unknown_value__" let dummy_func = emptyFunction "__goblint_dummy_init" (* TODO get rid of this? *) let dummy_node = FunctionEntry Cil.dummyFunDec +(* TODO: actually some/exists, not all in fast_global_inits? *) let all_array_index_exp : exp = CastE(TInt(Cilfacade.ptrdiff_ikind (),[]), unknown_exp) +let strong_all_array_index_exp : exp = CastE(TInt(Cilfacade.ptrdiff_ikind (),[]), mkString "strong_all_array_index_exp") + module type FileCfg = sig diff --git a/tests/regression/56-witness/44-base-unassume-array.yml b/tests/regression/56-witness/44-base-unassume-array.yml index 0a587c4ace..c9c8db3dad 100644 --- a/tests/regression/56-witness/44-base-unassume-array.yml +++ b/tests/regression/56-witness/44-base-unassume-array.yml @@ -24,7 +24,7 @@ column: 6 function: main loop_invariant: - string: 0 <= a[(long )"__unknown_value__"] + string: 0 <= a[(long )"strong_all_array_index_exp"] type: assertion format: C - entry_type: loop_invariant @@ -53,6 +53,6 @@ column: 6 function: main loop_invariant: - string: a[(long )"__unknown_value__"] < 3 + string: a[(long )"strong_all_array_index_exp"] < 3 type: assertion format: C From 94ce23f733f55830e29763744ed9d4d6f75c6379 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 11 May 2023 17:06:03 +0300 Subject: [PATCH 164/518] Pass lval_raw to base invariant --- src/analyses/base.ml | 4 ++-- src/analyses/baseInvariant.ml | 4 ++-- src/cdomains/valueDomain.ml | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 2e797e75ec..df26f1e1f0 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1637,7 +1637,7 @@ struct let get_var = get_var let get a gs st addrs exp = get a gs st addrs exp - let set a ~ctx gs st lval lval_type value = set a ~ctx ~invariant:true gs st lval lval_type value + let set a ~ctx gs st lval lval_type ?lval_raw value = set a ~ctx ~invariant:true gs st lval lval_type ?lval_raw value let refine_entire_var = true let map_oldval oldval _ = oldval @@ -2522,7 +2522,7 @@ struct (* all updates happen in ctx with top values *) let get_var = get_var let get a gs st addrs exp = get a gs st addrs exp - let set a ~ctx gs st lval lval_type value = set a ~ctx ~invariant:false gs st lval lval_type value (* TODO: should have invariant false? doesn't work with empty cpa then, because meets *) + let set a ~ctx gs st lval lval_type ?lval_raw value = set a ~ctx ~invariant:false gs st lval lval_type ?lval_raw value (* TODO: should have invariant false? doesn't work with empty cpa then, because meets *) let refine_entire_var = false let map_oldval oldval t_lval = diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index f99fcb28bc..af06d64435 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -20,7 +20,7 @@ sig val get_var: Queries.ask -> (V.t -> G.t) -> D.t -> varinfo -> VD.t val get: Queries.ask -> (V.t -> G.t) -> D.t -> AD.t -> exp option -> VD.t - val set: Queries.ask -> ctx:(D.t, G.t, _, V.t) Analyses.ctx -> (V.t -> G.t) -> D.t -> AD.t -> typ -> VD.t -> D.t + val set: Queries.ask -> ctx:(D.t, G.t, _, V.t) Analyses.ctx -> (V.t -> G.t) -> D.t -> AD.t -> typ -> ?lval_raw:lval -> VD.t -> D.t val refine_entire_var: bool val map_oldval: VD.t -> typ -> VD.t @@ -93,7 +93,7 @@ struct else set a gs st addr t_lval new_val ~ctx (* no *_raw because this is not a real assignment *) let refine_lv ctx a gs st c x c' pretty exp = - let set' lval v st = set a gs st (eval_lv a gs st lval) (Cilfacade.typeOfLval lval) v ~ctx in + let set' lval v st = set a gs st (eval_lv a gs st lval) (Cilfacade.typeOfLval lval) ~lval_raw:lval v ~ctx in match x with | Var var, o when refine_entire_var -> (* For variables, this is done at to the level of entire variables to benefit e.g. from disjunctive struct domains *) diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 6e06d8a75f..40904ee9b6 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -873,7 +873,7 @@ struct let update_offset (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\n" pretty x Offs.pretty offs pretty value; + if M.tracing then M.traceli "update_offset" "do_update_offset %a %a (%a) %a\n" 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 r = match x, offs with From 1413f12fd4613193cb27d012d5e19e94d98d02a3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 11 May 2023 17:06:18 +0300 Subject: [PATCH 165/518] Handle strong_all_array_index_exp in trivial array domain --- src/cdomains/arrayDomain.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index cffd55d42a..a32dc18272 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -86,7 +86,12 @@ struct let pretty () x = text "Array: " ++ pretty () x let pretty_diff () (x,y) = dprintf "%s: %a not leq %a" (name ()) pretty x pretty y let get ?(checkBounds=true) (ask: VDQ.t) a i = a - let set (ask: VDQ.t) a i v = join a v + let set (ask: VDQ.t) a (ie, i) v = + match ie with + | Some ie when CilType.Exp.equal ie MyCFG.strong_all_array_index_exp -> + v + | _ -> + join a v let make ?(varAttr=[]) ?(typAttr=[]) i v = v let length _ = None From c72b96f27d90601afb3c071cbec7efde0e4accb2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 11 May 2023 17:25:16 +0300 Subject: [PATCH 166/518] Handle strong_all_array_index_exp in unroll and partitioned array domain Doesn't actually work for some reason --- src/cdomains/arrayDomain.ml | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index a32dc18272..36a2cbf4ad 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -189,6 +189,13 @@ struct if Z.geq min_i f then (xl, (Val.join xr v)) else if Z.lt max_i f then ((update_unrolled_values min_i max_i), xr) else ((update_unrolled_values min_i (Z.of_int ((factor ())-1))), (Val.join xr v)) + let set ask (xl, xr) (ie, i) v = + match ie with + | Some ie when CilType.Exp.equal ie MyCFG.strong_all_array_index_exp -> + (BatList.make (factor ()) v, v) + | _ -> + set ask (xl, xr) (ie, i) v + let make ?(varAttr=[]) ?(typAttr=[]) _ v = let xl = BatList.make (factor ()) v in (xl,Val.bot ()) @@ -468,13 +475,16 @@ struct let set_with_length length (ask:VDQ.t) x (i,_) a = if M.tracing then M.trace "update_offset" "part array set_with_length %a %s %a\n" pretty x (BatOption.map_default Basetype.CilExp.show "None" i) Val.pretty a; - if i = Some MyCFG.all_array_index_exp then + match i with + | Some ie when CilType.Exp.equal ie MyCFG.strong_all_array_index_exp -> + Joint a + | Some i when CilType.Exp.equal i MyCFG.all_array_index_exp -> (assert !Goblintutil.global_initialization; (* just joining with xm here assumes that all values will be set, which is guaranteed during inits *) (* the join is needed here! see e.g 30/04 *) let o = match x with Partitioned (_, (_, xm, _)) -> xm | Joint v -> v in let r = Val.join o a in Joint r) - else + | _ -> normalize @@ let use_last = get_string "ana.base.partition-arrays.keep-expr" = "last" in let exp_value e = From 334f23553b857c3edb73dd1f5a93b0aee106aa1a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 10:35:51 +0300 Subject: [PATCH 167/518] Move special array index expressions to ArrayDomain --- src/cdomains/arrayDomain.ml | 18 +++++++++++------- src/cdomains/arrayDomain.mli | 11 +++++++++++ src/framework/cfgTools.ml | 12 ++++++------ src/framework/myCFG.ml | 5 ----- src/util/options.schema.json | 2 +- .../56-witness/44-base-unassume-array.yml | 4 ++-- 6 files changed, 31 insertions(+), 21 deletions(-) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index 36a2cbf4ad..db71018d10 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -8,6 +8,10 @@ module A = Array module BI = IntOps.BigIntOps module VDQ = ValueDomainQueries +let any_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") +let all_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") + + type domain = TrivialDomain | PartitionedDomain | UnrolledDomain (* determines the domain based on variable, type and flag *) @@ -88,7 +92,7 @@ struct let get ?(checkBounds=true) (ask: VDQ.t) a i = a let set (ask: VDQ.t) a (ie, i) v = match ie with - | Some ie when CilType.Exp.equal ie MyCFG.strong_all_array_index_exp -> + | Some ie when CilType.Exp.equal ie all_index_exp -> v | _ -> join a v @@ -111,7 +115,7 @@ struct match offset with (* invariants for all indices *) | NoOffset -> - let i_lval = Cil.addOffsetLval (Index (MyCFG.strong_all_array_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval x (* invariant for one index *) | Index (i, offset) -> @@ -191,7 +195,7 @@ struct else ((update_unrolled_values min_i (Z.of_int ((factor ())-1))), (Val.join xr v)) let set ask (xl, xr) (ie, i) v = match ie with - | Some ie when CilType.Exp.equal ie MyCFG.strong_all_array_index_exp -> + | Some ie when CilType.Exp.equal ie all_index_exp -> (BatList.make (factor ()) v, v) | _ -> set ask (xl, xr) (ie, i) v @@ -223,7 +227,7 @@ struct if Val.is_bot xr then Invariant.top () else ( - let i_lval = Cil.addOffsetLval (Index (MyCFG.strong_all_array_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) ) in @@ -476,9 +480,9 @@ struct let set_with_length length (ask:VDQ.t) x (i,_) a = if M.tracing then M.trace "update_offset" "part array set_with_length %a %s %a\n" pretty x (BatOption.map_default Basetype.CilExp.show "None" i) Val.pretty a; match i with - | Some ie when CilType.Exp.equal ie MyCFG.strong_all_array_index_exp -> + | Some ie when CilType.Exp.equal ie all_index_exp -> Joint a - | Some i when CilType.Exp.equal i MyCFG.all_array_index_exp -> + | Some i when CilType.Exp.equal i any_index_exp -> (assert !Goblintutil.global_initialization; (* just joining with xm here assumes that all values will be set, which is guaranteed during inits *) (* the join is needed here! see e.g 30/04 *) let o = match x with Partitioned (_, (_, xm, _)) -> xm | Joint v -> v in @@ -759,7 +763,7 @@ struct match offset with (* invariants for all indices *) | NoOffset -> - let i_lval = Cil.addOffsetLval (Index (MyCFG.strong_all_array_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) (* invariant for one index *) | Index (i, offset) -> diff --git a/src/cdomains/arrayDomain.mli b/src/cdomains/arrayDomain.mli index 91e526235d..245136254c 100644 --- a/src/cdomains/arrayDomain.mli +++ b/src/cdomains/arrayDomain.mli @@ -90,3 +90,14 @@ module PartitionedWithLength (Val: LatticeWithSmartOps) (Idx:IntDomain.Z): S wit module AttributeConfiguredArrayDomain(Val: LatticeWithSmartOps) (Idx:IntDomain.Z):S with type value = Val.t and type idx = Idx.t (** Switches between PartitionedWithLength, TrivialWithLength and Unroll based on variable, type, and flag. *) + + +val any_index_exp: exp +(** Special index expression for some unknown index. + Weakly updates array in assignment. + Used for exp.fast_global_inits. *) + +val all_index_exp: exp +(** Special index expression for all indices. + Strongly updates array in assignment. + Used for Goblint-specific witness invariants. *) diff --git a/src/framework/cfgTools.ml b/src/framework/cfgTools.ml index b6ba0a8eb0..2744b9b9b7 100644 --- a/src/framework/cfgTools.ml +++ b/src/framework/cfgTools.ml @@ -682,12 +682,12 @@ let getGlobalInits (file: file) : edges = doInit (addOffsetLval offs lval) loc init is_zero; lval in - let rec all_index = function - | Index (e,o) -> Index (all_array_index_exp, all_index o) - | Field (f,o) -> Field (f, all_index o) + let rec any_index_offset = function + | Index (e,o) -> Index (ArrayDomain.any_index_exp, any_index_offset o) + | Field (f,o) -> Field (f, any_index_offset o) | NoOffset -> NoOffset in - let all_index (lh,offs) = lh, all_index offs in + let any_index (lh,offs) = lh, any_index_offset offs in match init with | SingleInit exp -> let assign lval = (loc, Assign (lval, exp)) in @@ -695,8 +695,8 @@ let getGlobalInits (file: file) : edges = Instead, we get one assign for each distinct value in the array *) if not fast_global_inits then Hashtbl.add inits (assign lval) () - else if not (Hashtbl.mem inits (assign (all_index lval))) then - Hashtbl.add inits (assign (all_index lval)) () + else if not (Hashtbl.mem inits (assign (any_index lval))) then + Hashtbl.add inits (assign (any_index lval)) () else () | CompoundInit (typ, lst) -> diff --git a/src/framework/myCFG.ml b/src/framework/myCFG.ml index 3b1522916c..1b5ffba98b 100644 --- a/src/framework/myCFG.ml +++ b/src/framework/myCFG.ml @@ -58,11 +58,6 @@ let unknown_exp : exp = mkString "__unknown_value__" let dummy_func = emptyFunction "__goblint_dummy_init" (* TODO get rid of this? *) let dummy_node = FunctionEntry Cil.dummyFunDec -(* TODO: actually some/exists, not all in fast_global_inits? *) -let all_array_index_exp : exp = CastE(TInt(Cilfacade.ptrdiff_ikind (),[]), unknown_exp) - -let strong_all_array_index_exp : exp = CastE(TInt(Cilfacade.ptrdiff_ikind (),[]), mkString "strong_all_array_index_exp") - module type FileCfg = sig diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 2ff2e8bf58..80f134dcc9 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -1679,7 +1679,7 @@ "fast_global_inits": { "title": "exp.fast_global_inits", "description": - "Only generate one 'a[MyCFG.all_array_index_exp] = x' for all assignments a[...] = x for a global array a[n].", + "Only generate one 'a[any_index] = x' for all assignments a[...] = x for a global array a[n].", "type": "boolean", "default": true }, diff --git a/tests/regression/56-witness/44-base-unassume-array.yml b/tests/regression/56-witness/44-base-unassume-array.yml index c9c8db3dad..dbf7fb8e54 100644 --- a/tests/regression/56-witness/44-base-unassume-array.yml +++ b/tests/regression/56-witness/44-base-unassume-array.yml @@ -24,7 +24,7 @@ column: 6 function: main loop_invariant: - string: 0 <= a[(long )"strong_all_array_index_exp"] + string: 0 <= a[(long )"all_index"] type: assertion format: C - entry_type: loop_invariant @@ -53,6 +53,6 @@ column: 6 function: main loop_invariant: - string: a[(long )"strong_all_array_index_exp"] < 3 + string: a[(long )"all_index"] < 3 type: assertion format: C From f3ae35074623e181a29bd90c08f9b20e8e8e95d9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 10:47:07 +0300 Subject: [PATCH 168/518] Add option witness.invariant.goblint --- src/analyses/base.ml | 2 +- src/cdomains/arrayDomain.ml | 12 +++++++++--- src/domains/invariantCil.ml | 3 +-- src/util/options.schema.json | 6 ++++++ 4 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index df26f1e1f0..922201ae7b 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -625,7 +625,7 @@ struct let toInt i = match IdxDom.to_int @@ ID.cast_to ik i with | Some x -> Const (CInt (x,ik, None)) - | _ -> Cilfacade.mkCast ~e:(Const (CStr ("unknown",No_encoding))) ~newt:intType + | _ -> Cilfacade.mkCast ~e:(Const (CStr ("unknown",No_encoding))) ~newt:intType (* TODO: fix "unknown" offsets in accessed witness invariants *) in match o with diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index db71018d10..5205d503fb 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -114,9 +114,11 @@ struct let invariant ~value_invariant ~offset ~lval x = match offset with (* invariants for all indices *) - | NoOffset -> + | NoOffset when get_bool "witness.invariant.goblint" -> let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval x + | NoOffset -> + Invariant.none (* invariant for one index *) | Index (i, offset) -> value_invariant ~offset ~lval x @@ -226,10 +228,12 @@ struct let i_all = if Val.is_bot xr then Invariant.top () - else ( + else if get_bool "witness.invariant.goblint" then ( let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) ) + else + Invariant.top () in BatList.fold_lefti (fun acc i x -> let i_lval = Cil.addOffsetLval (Index (Cil.integer i, NoOffset)) lval in @@ -762,9 +766,11 @@ struct let invariant ~value_invariant ~offset ~lval x = match offset with (* invariants for all indices *) - | NoOffset -> + | NoOffset when get_bool "witness.invariant.goblint" -> let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) + | NoOffset -> + Invariant.none (* invariant for one index *) | Index (i, offset) -> Invariant.none (* TODO: look up *) diff --git a/src/domains/invariantCil.ml b/src/domains/invariantCil.ml index 181b24a0bd..2e647f6920 100644 --- a/src/domains/invariantCil.ml +++ b/src/domains/invariantCil.ml @@ -57,8 +57,7 @@ class exp_contains_tmp_visitor (acc: bool ref) = object method! vexpr (e: exp) = if e = MyCFG.unknown_exp then ( - (* TODO: add config option *) - (* acc := true; *) + acc := true; SkipChildren ) else diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 80f134dcc9..2a4f94c5c9 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -2319,6 +2319,12 @@ "cond", "RETURN" ] + }, + "goblint": { + "title": "witness.invariant.goblint", + "description": "Emit non-standard Goblint-specific invariants. Currently array invariants with all_index offsets.", + "type": "boolean", + "default": false } }, "additionalProperties": false From 2f93630f46f21790d652a36a2a2837fffb90c6d3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 11:25:18 +0300 Subject: [PATCH 169/518] Replace unknown_exp and "unknown" indices also with any_index_exp --- src/analyses/base.ml | 5 ++--- src/analyses/malloc_null.ml | 2 +- src/analyses/mutexAnalysis.ml | 2 +- src/analyses/region.ml | 2 +- src/analyses/uninit.ml | 2 +- src/cdomains/arrayDomain.ml | 18 +++++++----------- src/cdomains/arrayDomain.mli | 11 ----------- src/cdomains/lval.ml | 13 ++++++++++++- src/framework/cfgTools.ml | 2 +- 9 files changed, 26 insertions(+), 31 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 922201ae7b..429ca49b9b 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -625,8 +625,7 @@ struct let toInt i = match IdxDom.to_int @@ ID.cast_to ik i with | Some x -> Const (CInt (x,ik, None)) - | _ -> Cilfacade.mkCast ~e:(Const (CStr ("unknown",No_encoding))) ~newt:intType (* TODO: fix "unknown" offsets in accessed witness invariants *) - + | _ -> Lval.any_index_exp in match o with | `NoOffset -> `NoOffset @@ -1059,7 +1058,7 @@ struct match ofs with | NoOffset -> `NoOffset | Field (fld, ofs) -> `Field (fld, convert_offset a gs st ofs) - | Index (CastE (TInt(IInt,[]), Const (CStr ("unknown",No_encoding))), ofs) -> (* special offset added by convertToQueryLval *) + | Index (exp, ofs) when CilType.Exp.equal exp Lval.any_index_exp -> (* special offset added by convertToQueryLval *) `Index (IdxDom.top (), convert_offset a gs st ofs) | Index (exp, ofs) -> match eval_rv a gs st exp with diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index 7f80a03094..e121bfcb3e 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -18,7 +18,7 @@ struct let should_join x y = D.equal x y (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain - element) answers with the string "unknown" on all non-concrete cases. *) + element) answers with Lval.any_index_exp on all non-concrete cases. *) let rec conv_offset x = match x with | `NoOffset -> `NoOffset diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 681b0eae3c..f8d58032ff 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -109,7 +109,7 @@ struct let i_exp = match ValueDomain.IndexDomain.to_int i with | Some i -> Const (CInt (i, Cilfacade.ptrdiff_ikind (), Some (Z.to_string i))) - | None -> MyCFG.unknown_exp + | None -> Lval.any_index_exp in `Index (i_exp, conv_offset_inv o) diff --git a/src/analyses/region.ml b/src/analyses/region.ml index 4109fa6e2c..c0e07c82d2 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -83,7 +83,7 @@ struct let rec unknown_index = function | `NoOffset -> `NoOffset | `Field (f, os) -> `Field (f, unknown_index os) - | `Index (i, os) -> `Index (MyCFG.unknown_exp, unknown_index os) (* forget specific indices *) + | `Index (i, os) -> `Index (Lval.any_index_exp, unknown_index os) (* forget specific indices *) in Option.map (Lvals.of_list % List.map (Tuple2.map2 unknown_index)) (get_region ctx e) diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 01c2bbcff6..cdb3124c87 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -31,7 +31,7 @@ struct let exitstate v : D.t = D.empty () (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain - element) answers with the string "unknown" on all non-concrete cases. *) + element) answers with Lval.any_index_exp on all non-concrete cases. *) let rec conv_offset x = match x with | `NoOffset -> `NoOffset diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index 5205d503fb..1510c85b2f 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -8,10 +8,6 @@ module A = Array module BI = IntOps.BigIntOps module VDQ = ValueDomainQueries -let any_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") -let all_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") - - type domain = TrivialDomain | PartitionedDomain | UnrolledDomain (* determines the domain based on variable, type and flag *) @@ -92,7 +88,7 @@ struct let get ?(checkBounds=true) (ask: VDQ.t) a i = a let set (ask: VDQ.t) a (ie, i) v = match ie with - | Some ie when CilType.Exp.equal ie all_index_exp -> + | Some ie when CilType.Exp.equal ie Lval.all_index_exp -> v | _ -> join a v @@ -115,7 +111,7 @@ struct match offset with (* invariants for all indices *) | NoOffset when get_bool "witness.invariant.goblint" -> - let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Lval.all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval x | NoOffset -> Invariant.none @@ -197,7 +193,7 @@ struct else ((update_unrolled_values min_i (Z.of_int ((factor ())-1))), (Val.join xr v)) let set ask (xl, xr) (ie, i) v = match ie with - | Some ie when CilType.Exp.equal ie all_index_exp -> + | Some ie when CilType.Exp.equal ie Lval.all_index_exp -> (BatList.make (factor ()) v, v) | _ -> set ask (xl, xr) (ie, i) v @@ -229,7 +225,7 @@ struct if Val.is_bot xr then Invariant.top () else if get_bool "witness.invariant.goblint" then ( - let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Lval.all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) ) else @@ -484,9 +480,9 @@ struct let set_with_length length (ask:VDQ.t) x (i,_) a = if M.tracing then M.trace "update_offset" "part array set_with_length %a %s %a\n" pretty x (BatOption.map_default Basetype.CilExp.show "None" i) Val.pretty a; match i with - | Some ie when CilType.Exp.equal ie all_index_exp -> + | Some ie when CilType.Exp.equal ie Lval.all_index_exp -> Joint a - | Some i when CilType.Exp.equal i any_index_exp -> + | Some i when CilType.Exp.equal i Lval.any_index_exp -> (assert !Goblintutil.global_initialization; (* just joining with xm here assumes that all values will be set, which is guaranteed during inits *) (* the join is needed here! see e.g 30/04 *) let o = match x with Partitioned (_, (_, xm, _)) -> xm | Joint v -> v in @@ -767,7 +763,7 @@ struct match offset with (* invariants for all indices *) | NoOffset when get_bool "witness.invariant.goblint" -> - let i_lval = Cil.addOffsetLval (Index (all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Lval.all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) | NoOffset -> Invariant.none diff --git a/src/cdomains/arrayDomain.mli b/src/cdomains/arrayDomain.mli index 245136254c..91e526235d 100644 --- a/src/cdomains/arrayDomain.mli +++ b/src/cdomains/arrayDomain.mli @@ -90,14 +90,3 @@ module PartitionedWithLength (Val: LatticeWithSmartOps) (Idx:IntDomain.Z): S wit module AttributeConfiguredArrayDomain(Val: LatticeWithSmartOps) (Idx:IntDomain.Z):S with type value = Val.t and type idx = Idx.t (** Switches between PartitionedWithLength, TrivialWithLength and Unroll based on variable, type, and flag. *) - - -val any_index_exp: exp -(** Special index expression for some unknown index. - Weakly updates array in assignment. - Used for exp.fast_global_inits. *) - -val all_index_exp: exp -(** Special index expression for all indices. - Strongly updates array in assignment. - Used for Goblint-specific witness invariants. *) diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 2219f7dbff..c6c585d751 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -4,6 +4,17 @@ open Pretty module GU = Goblintutil module M = Messages +(** Special index expression for some unknown index. + Weakly updates array in assignment. + Used for exp.fast_global_inits. *) +let any_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") + +(** Special index expression for all indices. + Strongly updates array in assignment. + Used for Goblint-specific witness invariants. *) +let all_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") + + type ('a, 'b) offs = [ | `NoOffset | `Field of 'a * ('a,'b) offs @@ -583,7 +594,7 @@ struct match o with | `NoOffset -> a | `Field (f,o) -> short_offs o (a^"."^f.fname) - | `Index (e,o) when CilType.Exp.equal e MyCFG.unknown_exp -> short_offs o (a^"[?]") + | `Index (e,o) when CilType.Exp.equal e any_index_exp -> short_offs o (a^"[?]") | `Index (e,o) -> short_offs o (a^"["^CilType.Exp.show e^"]") let rec of_ciloffs x = diff --git a/src/framework/cfgTools.ml b/src/framework/cfgTools.ml index 2744b9b9b7..ac52dae19a 100644 --- a/src/framework/cfgTools.ml +++ b/src/framework/cfgTools.ml @@ -683,7 +683,7 @@ let getGlobalInits (file: file) : edges = lval in let rec any_index_offset = function - | Index (e,o) -> Index (ArrayDomain.any_index_exp, any_index_offset o) + | Index (e,o) -> Index (Lval.any_index_exp, any_index_offset o) | Field (f,o) -> Field (f, any_index_offset o) | NoOffset -> NoOffset in From c18c0c572f94662faeb8d6b761f0319bafb72e0a Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 12 May 2023 11:17:07 +0200 Subject: [PATCH 170/518] Give argument to query --- src/analyses/accessAnalysis.ml | 2 +- src/analyses/apron/relationAnalysis.apron.ml | 12 ++++++------ src/analyses/apron/relationPriv.apron.ml | 8 ++++---- src/analyses/base.ml | 18 +++++++++--------- src/analyses/commonPriv.ml | 4 ++-- src/analyses/mutexAnalysis.ml | 2 +- src/analyses/raceAnalysis.ml | 2 +- src/analyses/threadAnalysis.ml | 6 ++++-- src/analyses/threadEscape.ml | 2 +- src/analyses/threadFlag.ml | 15 +++++++++------ src/analyses/varEq.ml | 2 +- src/domains/queries.ml | 12 +++++++----- 12 files changed, 46 insertions(+), 39 deletions(-) diff --git a/src/analyses/accessAnalysis.ml b/src/analyses/accessAnalysis.ml index 2af77d1d8d..4e74f8cec5 100644 --- a/src/analyses/accessAnalysis.ml +++ b/src/analyses/accessAnalysis.ml @@ -43,7 +43,7 @@ struct + [deref=true], [reach=true] - Access [exp] by dereferencing transitively (reachable), used for deep special accesses. *) let access_one_top ?(force=false) ?(deref=false) ctx (kind: AccessKind.t) reach exp = if M.tracing then M.traceli "access" "access_one_top %a %b %a:\n" AccessKind.pretty kind reach d_exp exp; - if force || !collect_local || !emit_single_threaded || ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) then ( + if force || !collect_local || !emit_single_threaded || ThreadFlag.is_currently_multi (Analyses.ask_of_ctx ctx) then ( if deref then do_access ctx kind reach exp; Access.distribute_access_exp (do_access ctx Read false) exp diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 5d2a659697..6790c73382 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -43,7 +43,7 @@ struct (* Functions for manipulating globals as temporary locals. *) let read_global ask getg st g x = - if ThreadFlag.is_multi ask then + if ThreadFlag.has_ever_been_multi ask then Priv.read_global ask getg st g x else ( let rel = st.rel in @@ -118,7 +118,7 @@ struct rel'' let write_global ask getg sideg st g x = - if ThreadFlag.is_multi ask then + if ThreadFlag.has_ever_been_multi ask then Priv.write_global ask getg sideg st g x else ( let rel = st.rel in @@ -536,7 +536,7 @@ struct let scope = Node.find_fundec ctx.node in let (apr, e_inv) = - if ThreadFlag.is_multi ask then ( + if ThreadFlag.has_ever_been_multi ask then ( let priv_vars = if keep_global then Priv.invariant_vars ask ctx.global ctx.local @@ -617,7 +617,7 @@ struct Otherwise thread is analyzed with no global inits, reading globals gives bot, which turns into top, which might get published... sync `Thread doesn't help us here, it's not specific to entering multithreaded mode. EnterMultithreaded events only execute after threadenter and threadspawn. *) - if not (ThreadFlag.is_multi (Analyses.ask_of_ctx ctx)) then + if not (ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ignore (Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st); let st' = Priv.threadenter (Analyses.ask_of_ctx ctx) ctx.global st in let arg_vars = @@ -638,9 +638,9 @@ struct let event ctx e octx = let st = ctx.local in match e with - | Events.Lock (addr, _) when ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) + | 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 - | Events.Unlock addr when ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) + | 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 () -> diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 45b843dd80..c2726b42df 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -95,7 +95,7 @@ struct let sync (ask: Q.ask) getg sideg (st: relation_components_t) reason = match reason with | `Join -> - if (ask.f Q.MustBeSingleThreadedUptoCurrent) then + if ask.f (Q.MustBeSingleThreaded {since_start = true}) then st else (* must be like enter_multithreaded *) @@ -342,7 +342,7 @@ struct st end | `Join -> - if (ask.f Q.MustBeSingleThreadedUptoCurrent) then + if (ask.f (Q.MustBeSingleThreaded { since_start= true })) then st else (* must be like enter_multithreaded *) @@ -548,7 +548,7 @@ struct st end | `Join -> - if (ask.f Q.MustBeSingleThreadedUptoCurrent) then + if (ask.f (Q.MustBeSingleThreaded {since_start = true})) then st else let rel = st.rel in @@ -1031,7 +1031,7 @@ struct match reason with | `Return -> st (* TODO: implement? *) | `Join -> - if (ask.f Q.MustBeSingleThreadedUptoCurrent) then + if (ask.f (Q.MustBeSingleThreaded {since_start = true})) then st else let rel = st.rel in diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 21ce7c2f31..fb12000f33 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -433,7 +433,7 @@ struct | `Thread -> true | _ -> - ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) + ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) in if M.tracing then M.tracel "sync" "sync multi=%B earlyglobs=%B\n" multi !GU.earlyglobs; if !GU.earlyglobs || multi then @@ -449,7 +449,7 @@ struct ignore (sync' reason ctx) let get_var (a: Q.ask) (gs: glob_fun) (st: store) (x: varinfo): value = - if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then + if (!GU.earlyglobs || ThreadFlag.has_ever_been_multi a) && is_global a x then Priv.read_global a (priv_getg gs) st x else begin if M.tracing then M.tracec "get" "Singlethreaded mode.\n"; @@ -1203,7 +1203,7 @@ struct in if CilLval.Set.is_top context.Invariant.lvals then ( - if !GU.earlyglobs || ThreadFlag.is_multi ask then ( + if !GU.earlyglobs || ThreadFlag.has_ever_been_multi ask then ( let cpa_invariant = CPA.fold (fun k v a -> if not (is_global ask k) then @@ -1471,7 +1471,7 @@ struct end else (* Check if we need to side-effect this one. We no longer generate * side-effects here, but the code still distinguishes these cases. *) - if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then begin + if (!GU.earlyglobs || ThreadFlag.has_ever_been_multi a) && is_global a x then begin if M.tracing then M.tracel "set" ~var:x.vname "update_one_addr: update a global var '%s' ...\n" x.vname; let priv_getg = priv_getg gs in (* Optimization to avoid evaluating integer values when setting them. @@ -1916,7 +1916,7 @@ struct Otherwise thread is analyzed with no global inits, reading globals gives bot, which turns into top, which might get published... sync `Thread doesn't help us here, it's not specific to entering multithreaded mode. EnterMultithreaded events only execute after threadenter and threadspawn. *) - if not (ThreadFlag.is_multi (Analyses.ask_of_ctx ctx)) then + if not (ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ignore (Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) (priv_sideg ctx.sideg) st); Priv.threadenter (Analyses.ask_of_ctx ctx) st ) else @@ -2463,14 +2463,14 @@ struct let asked' = Queries.Set.add anyq asked in let r: a Queries.result = match q with - | MustBeSingleThreadedUptoCurrent when single -> true + | MustBeSingleThreaded _ when single -> true | MayEscape _ | MayBePublic _ | MayBePublicWithout _ | MustBeProtectedBy _ | MustLockset | MustBeAtomic - | MustBeSingleThreadedUptoCurrent + | MustBeSingleThreaded _ | MustBeUniqueThread | CurrentThreadId | MayBeThreadReturn @@ -2576,10 +2576,10 @@ struct let event ctx e octx = let st: store = ctx.local in match e with - | Events.Lock (addr, _) when ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) + | Events.Lock (addr, _) when ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) if M.tracing then M.tracel "priv" "LOCK EVENT %a\n" LockDomain.Addr.pretty addr; Priv.lock (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) st addr - | Events.Unlock addr when ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) -> (* TODO: is this condition sound? *) + | 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, base privatization unsound"; (* TODO: something more sound *) WideningTokens.with_local_side_tokens (fun () -> diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 4f80b05b0a..2e437321b4 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -40,7 +40,7 @@ end module Protection = struct let is_unprotected ask x: bool = - let multi = ThreadFlag.is_multi ask in + let multi = ThreadFlag.has_ever_been_multi ask in (!GU.earlyglobs && not multi && not (is_excluded_from_earlyglobs x)) || ( multi && @@ -48,7 +48,7 @@ struct ) let is_unprotected_without ask ?(write=true) x m: bool = - ThreadFlag.is_multi ask && + ThreadFlag.has_ever_been_multi ask && ask.f (Q.MayBePublicWithout {global=x; write; without_mutex=m}) let is_protected_by ask m x: bool = diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 681b0eae3c..27558350c0 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -209,7 +209,7 @@ struct let event ctx e octx = match e with - | Events.Access {exp; lvals; kind; _} when ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) -> (* threadflag query in post-threadspawn ctx *) + | Events.Access {exp; lvals; kind; _} when ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) -> (* threadflag query in post-threadspawn ctx *) (* must use original (pre-assign, etc) ctx queries *) let old_access var_opt offs_opt = (* TODO: this used to use ctx instead of octx, why? *) diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index 6b94934e9d..1c7d5864d3 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -92,7 +92,7 @@ struct let event ctx e octx = match e with - | Events.Access {exp=e; lvals; kind; reach} when ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) -> (* threadflag query in post-threadspawn ctx *) + | Events.Access {exp=e; lvals; kind; reach} when ThreadFlag.is_currently_multi (Analyses.ask_of_ctx ctx) -> (* threadflag query in post-threadspawn ctx *) (* must use original (pre-assign, etc) ctx queries *) let conf = 110 in let module LS = Queries.LS in diff --git a/src/analyses/threadAnalysis.ml b/src/analyses/threadAnalysis.ml index 1cad0b38a8..97cb76a07c 100644 --- a/src/analyses/threadAnalysis.ml +++ b/src/analyses/threadAnalysis.ml @@ -67,10 +67,12 @@ struct | `Lifted tid -> not (is_not_unique ctx tid) | _ -> false end - | Queries.MustBeSingleThreadedUptoCurrent -> begin + | Queries.MustBeSingleThreaded {since_start = false} -> begin let tid = ThreadId.get_current (Analyses.ask_of_ctx ctx) in match tid with - | `Lifted tid when T.is_main tid -> D.is_empty ctx.local + | `Lifted tid when T.is_main tid -> + (* This analysis cannot tell if we are back in single-threaded mode or never left it. *) + D.is_empty ctx.local | _ -> false end | _ -> Queries.Result.top q diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 53d01fadb0..2c3d9bb2f5 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -65,7 +65,7 @@ struct let escaped = reachable ask rval in let escaped = D.filter (fun v -> not v.vglob) escaped in if M.tracing then M.tracel "escape" "assign vs: %a | %a\n" D.pretty vs D.pretty escaped; - if not (D.is_empty escaped) && ThreadFlag.is_multi ask then (* avoid emitting unnecessary event *) + if not (D.is_empty escaped) && ThreadFlag.has_ever_been_multi ask then (* avoid emitting unnecessary event *) ctx.emit (Events.Escape escaped); D.iter (fun v -> ctx.sideg v escaped; diff --git a/src/analyses/threadFlag.ml b/src/analyses/threadFlag.ml index 18c9b20a11..7e81be2f8f 100644 --- a/src/analyses/threadFlag.ml +++ b/src/analyses/threadFlag.ml @@ -6,10 +6,13 @@ module LF = LibraryFunctions open GoblintCil open Analyses -let is_multi (ask: Queries.ask): bool = +let is_currently_multi (ask: Queries.ask): bool = if !GU.global_initialization then false else - not (ask.f Queries.MustBeSingleThreadedUptoCurrent) + not (ask.f (Queries.MustBeSingleThreaded {since_start = false})) +let has_ever_been_multi (ask: Queries.ask): bool = + if !GU.global_initialization then false else + not (ask.f (Queries.MustBeSingleThreaded {since_start = true})) module Spec = struct @@ -41,7 +44,7 @@ struct let query ctx (type a) (x: a Queries.t): a Queries.result = match x with - | Queries.MustBeSingleThreadedUptoCurrent -> not (Flag.is_multi ctx.local) + | Queries.MustBeSingleThreaded _ -> not (Flag.is_multi ctx.local) (* If this analysis can tell, it is the case since the start *) | Queries.MustBeUniqueThread -> not (Flag.is_not_main ctx.local) (* This used to be in base but also commented out. *) (* | Queries.MayBePublic _ -> Flag.is_multi ctx.local *) @@ -55,15 +58,15 @@ struct let should_print m = not m end let access ctx _ = - is_multi (Analyses.ask_of_ctx ctx) + is_currently_multi (Analyses.ask_of_ctx ctx) let threadenter ctx lval f args = - if not (is_multi (Analyses.ask_of_ctx ctx)) then + if not (has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ctx.emit Events.EnterMultiThreaded; [create_tid f] let threadspawn ctx lval f args fctx = - if not (is_multi (Analyses.ask_of_ctx ctx)) then + if not (has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ctx.emit Events.EnterMultiThreaded; D.join ctx.local (Flag.get_main ()) end diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index 0ae2aceea7..b37963036f 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -434,7 +434,7 @@ struct let d_local = (* if we are multithreaded, we run the risk, that some mutex protected variables got unlocked, so in this case caller state goes to top TODO: !!Unsound, this analysis does not handle this case -> regtest 63 08!! *) - if Queries.LS.is_top tainted || not (ctx.ask Queries.MustBeSingleThreadedUptoCurrent) then + if Queries.LS.is_top tainted || not (ctx.ask (Queries.MustBeSingleThreaded {since_start = true})) then D.top () else let taint_exp = Queries.ES.of_list (List.map (fun lv -> Lval (Lval.CilLval.to_lval lv)) (Queries.LS.elements tainted)) in diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 5b32e27faa..7869399ee4 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -66,7 +66,7 @@ type _ t = | MustBeProtectedBy: mustbeprotectedby -> MustBool.t t | MustLockset: LS.t t | MustBeAtomic: MustBool.t t - | MustBeSingleThreadedUptoCurrent: MustBool.t t + | MustBeSingleThreaded: {since_start: bool} -> MustBool.t t | MustBeUniqueThread: MustBool.t t | CurrentThreadId: ThreadIdDomain.ThreadLifted.t t | MayBeThreadReturn: MayBool.t t @@ -130,7 +130,7 @@ struct | IsHeapVar _ -> (module MayBool) | MustBeProtectedBy _ -> (module MustBool) | MustBeAtomic -> (module MustBool) - | MustBeSingleThreadedUptoCurrent -> (module MustBool) + | MustBeSingleThreaded _ -> (module MustBool) | MustBeUniqueThread -> (module MustBool) | EvalInt _ -> (module ID) | EvalLength _ -> (module ID) @@ -189,7 +189,7 @@ struct | IsHeapVar _ -> MayBool.top () | MustBeProtectedBy _ -> MustBool.top () | MustBeAtomic -> MustBool.top () - | MustBeSingleThreadedUptoCurrent -> MustBool.top () + | MustBeSingleThreaded _ -> MustBool.top () | MustBeUniqueThread -> MustBool.top () | EvalInt _ -> ID.top () | EvalLength _ -> ID.top () @@ -241,7 +241,7 @@ struct | Any (MustBeProtectedBy _) -> 9 | Any MustLockset -> 10 | Any MustBeAtomic -> 11 - | Any MustBeSingleThreadedUptoCurrent -> 12 + | Any (MustBeSingleThreaded _)-> 12 | Any MustBeUniqueThread -> 13 | Any CurrentThreadId -> 14 | Any MayBeThreadReturn -> 15 @@ -316,6 +316,7 @@ struct | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 + | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 (* only argumentless queries should remain *) | _, _ -> Stdlib.compare (order a) (order b) @@ -351,6 +352,7 @@ struct | Any (InvariantGlobal vi) -> Hashtbl.hash vi | Any (MustProtectedVars m) -> hash_mustprotectedvars m | Any (MayBeModifiedSinceSetjmp e) -> JmpBufDomain.BufferEntry.hash e + | Any (MustBeSingleThreaded {since_start}) -> Hashtbl.hash since_start (* IterSysVars: *) (* - argument is a function and functions cannot be compared in any meaningful way. *) (* - doesn't matter because IterSysVars is always queried from outside of the analysis, so MCP's query caching is not done for it. *) @@ -371,7 +373,7 @@ struct | Any (MustBeProtectedBy x) -> Pretty.dprintf "MustBeProtectedBy _" | Any MustLockset -> Pretty.dprintf "MustLockset" | Any MustBeAtomic -> Pretty.dprintf "MustBeAtomic" - | Any MustBeSingleThreadedUptoCurrent -> Pretty.dprintf "MustBeSingleThreaded" + | Any (MustBeSingleThreaded {since_start}) -> Pretty.dprintf "MustBeSingleThreaded since_start=%b" since_start | Any MustBeUniqueThread -> Pretty.dprintf "MustBeUniqueThread" | Any CurrentThreadId -> Pretty.dprintf "CurrentThreadId" | Any MayBeThreadReturn -> Pretty.dprintf "MayBeThreadReturn" From 19fc66c5bf436ffce8ae7c7bdf908f12fd4c3857 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 12:34:13 +0300 Subject: [PATCH 171/518] Add regtest.sh bash completion --- scripts/bash-completion.sh | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/scripts/bash-completion.sh b/scripts/bash-completion.sh index 28a86feb6e..8dc2265cf4 100644 --- a/scripts/bash-completion.sh +++ b/scripts/bash-completion.sh @@ -13,3 +13,22 @@ _goblint () } complete -o default -F _goblint goblint + + +_regtest () +{ + IFS=$'\n' + case $COMP_CWORD in + 1) + COMPREPLY=($(ls -1 tests/regression/ | sed -n -r 's/([0-9][0-9])-.*/\1/p')) + ;; + 2) + COMPREPLY=($(ls -1 tests/regression/${COMP_WORDS[1]}-* | sed -n -r 's/([0-9][0-9])-.*/\1/p')) + ;; + *) + COMPREPLY=($($(dirname ${COMP_WORDS[0]})/goblint --complete "${COMP_WORDS[@]:3:COMP_CWORD}")) + ;; + esac +} + +complete -o default -F _regtest regtest.sh From 9c8f0d7aa42634fc8c37ac582227a76a1fbe8491 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 12:39:27 +0300 Subject: [PATCH 172/518] Add bash completion setup to README --- README.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 3c94fc155b..bcfd4e401d 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ [![locked workflow status](https://github.com/goblint/analyzer/actions/workflows/locked.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/locked.yml) [![unlocked workflow status](https://github.com/goblint/analyzer/actions/workflows/unlocked.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/unlocked.yml) [![docker workflow status](https://github.com/goblint/analyzer/actions/workflows/docker.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/docker.yml) -[![Documentation Status](https://readthedocs.org/projects/goblint/badge/?version=latest)](https://goblint.readthedocs.io/en/latest/?badge=latest) +[![Documentation Status](https://readthedocs.org/projects/goblint/badge/?version=latest)](https://goblint.readthedocs.io/en/latest/?badge=latest) [![GitHub release status](https://img.shields.io/github/v/release/goblint/analyzer)](https://github.com/goblint/analyzer/releases) [![opam package status](https://badgen.net/opam/v/goblint)](https://opam.ocaml.org/packages/goblint) [![Zenodo DOI](https://zenodo.org/badge/2066905.svg)](https://zenodo.org/badge/latestdoi/2066905) @@ -18,6 +18,7 @@ Both for using an up-to-date version of Goblint or developing it, the best way i 3. Run `make setup` to install OCaml and dependencies via opam. 4. Run `make` to build Goblint itself. 5. Run `make install` to install Goblint into the opam switch for usage via switch's `PATH`. +6. _Optional:_ See [`scripts/bash-completion.sh`](./scripts/bash-completion.sh) for setting up bash completion for Goblint arguments. ### MacOS 1. Install GCC with `brew install gcc` (first run `xcode-select --install` if you don't want to build it from source). Goblint requires GCC while macOS's default `cpp` is Clang, which will not work. From ae65c9f730bba5923279f56c2540d1d4ae70ec43 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 12:55:56 +0300 Subject: [PATCH 173/518] Add update_suite.rb bash completion --- scripts/bash-completion.sh | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/scripts/bash-completion.sh b/scripts/bash-completion.sh index 8dc2265cf4..5751cd0cc4 100644 --- a/scripts/bash-completion.sh +++ b/scripts/bash-completion.sh @@ -20,10 +20,10 @@ _regtest () IFS=$'\n' case $COMP_CWORD in 1) - COMPREPLY=($(ls -1 tests/regression/ | sed -n -r 's/([0-9][0-9])-.*/\1/p')) + COMPREPLY=($(ls -1 tests/regression/ | sed -n -r 's/([0-9][0-9])-.*/\1/p' | grep "^${COMP_WORDS[1]}")) ;; 2) - COMPREPLY=($(ls -1 tests/regression/${COMP_WORDS[1]}-* | sed -n -r 's/([0-9][0-9])-.*/\1/p')) + COMPREPLY=($(ls -1 tests/regression/${COMP_WORDS[1]}-* | sed -n -r 's/([0-9][0-9])-.*/\1/p' | grep "^${COMP_WORDS[2]}")) ;; *) COMPREPLY=($($(dirname ${COMP_WORDS[0]})/goblint --complete "${COMP_WORDS[@]:3:COMP_CWORD}")) @@ -32,3 +32,27 @@ _regtest () } complete -o default -F _regtest regtest.sh + + +_update_suite () +{ + IFS=$'\n' + case $COMP_CWORD in + 1) + COMPREPLY=($(ls -1 tests/regression/*/*.c | sed -n -r 's|.*/([0-9][0-9])-(.*)\.c|\2|p' | grep "^${COMP_WORDS[1]}")) + COMPREPLY+=("group") + ;; + 2) + if [[ ${COMP_WORDS[1]} == "group" ]] ; then + COMPREPLY=($(ls -1 tests/regression/ | sed -n -r 's/([0-9][0-9])-(.*)/\2/p' | grep "^${COMP_WORDS[2]}")) + else + COMPREPLY=() + fi + ;; + *) + COMPREPLY=() + ;; + esac +} + +complete -F _update_suite update_suite.rb From fda724b7fb3c535dd76e48e68e688370f002b0a0 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 12 May 2023 12:57:17 +0200 Subject: [PATCH 174/518] Emit access events when program has ever been multi-threaded --- src/analyses/accessAnalysis.ml | 2 +- .../58-base-mm-tid/{24-phases.c => 24-phases-sound.c} | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) rename tests/regression/58-base-mm-tid/{24-phases.c => 24-phases-sound.c} (78%) diff --git a/src/analyses/accessAnalysis.ml b/src/analyses/accessAnalysis.ml index 4e74f8cec5..999856516c 100644 --- a/src/analyses/accessAnalysis.ml +++ b/src/analyses/accessAnalysis.ml @@ -43,7 +43,7 @@ struct + [deref=true], [reach=true] - Access [exp] by dereferencing transitively (reachable), used for deep special accesses. *) let access_one_top ?(force=false) ?(deref=false) ctx (kind: AccessKind.t) reach exp = if M.tracing then M.traceli "access" "access_one_top %a %b %a:\n" AccessKind.pretty kind reach d_exp exp; - if force || !collect_local || !emit_single_threaded || ThreadFlag.is_currently_multi (Analyses.ask_of_ctx ctx) then ( + if force || !collect_local || !emit_single_threaded || ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) then ( if deref then do_access ctx kind reach exp; Access.distribute_access_exp (do_access ctx Read false) exp diff --git a/tests/regression/58-base-mm-tid/24-phases.c b/tests/regression/58-base-mm-tid/24-phases-sound.c similarity index 78% rename from tests/regression/58-base-mm-tid/24-phases.c rename to tests/regression/58-base-mm-tid/24-phases-sound.c index 24e3b2f2f2..506088c9d3 100644 --- a/tests/regression/58-base-mm-tid/24-phases.c +++ b/tests/regression/58-base-mm-tid/24-phases-sound.c @@ -1,4 +1,5 @@ // PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins --set ana.activated[+] thread +// Tests soundness when additionally thread analysis is enabled, that is able to go back to single-threaded mode after all created joins have been joined. #include #include @@ -9,7 +10,7 @@ pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; void *t_benign(void *arg) { pthread_mutex_lock(&A); g = 10; - __goblint_check(g == 10); + __goblint_check(g == 10); //TODO pthread_mutex_unlock(&A); return NULL; } @@ -18,7 +19,7 @@ void *t_benign2(void *arg) { pthread_mutex_lock(&A); __goblint_check(g == 20); g = 10; - __goblint_check(g == 10); + __goblint_check(g == 10); //TODO pthread_mutex_unlock(&A); return NULL; } From 826df10ddd3b33cb1085e3f8e58a813369f9f6ec Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 18:34:29 +0300 Subject: [PATCH 175/518] Move functions from Goblintutil to GobSys --- src/analyses/extractPthread.ml | 2 +- src/framework/analyses.ml | 4 +-- src/framework/cfgTools.ml | 4 +-- src/framework/control.ml | 4 +-- src/goblint.ml | 2 +- src/maingoblint.ml | 12 ++++----- src/solvers/generic.ml | 2 +- src/util/gobSys.ml | 48 ++++++++++++++++++++++++++++++++++ src/util/goblintDir.ml | 2 +- src/util/goblintutil.ml | 43 ------------------------------ src/util/options.schema.json | 4 +-- src/util/sarif.ml | 2 +- src/witness/yamlWitness.ml | 2 +- 13 files changed, 68 insertions(+), 63 deletions(-) diff --git a/src/analyses/extractPthread.ml b/src/analyses/extractPthread.ml index 97ac379488..19171d0df6 100644 --- a/src/analyses/extractPthread.ml +++ b/src/analyses/extractPthread.ml @@ -574,7 +574,7 @@ module Codegen = struct module Writer = struct let write desc ext content = - let dir = Goblintutil.create_dir (Fpath.v "pml-result") in + let dir = GobSys.mkdir_or_exists_absolute (Fpath.v "pml-result") in let path = Fpath.to_string @@ Fpath.append dir (Fpath.v ("pthread." ^ ext)) in output_file ~filename:path ~text:content ; print_endline @@ "saved " ^ desc ^ " as " ^ path diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index acac5a81eb..fb0d6f58d4 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -251,7 +251,7 @@ struct Messages.xml_file_name := fn; BatPrintf.printf "Writing xml to temp. file: %s\n%!" fn; BatPrintf.fprintf f ""; - BatPrintf.fprintf f "%s" Goblintutil.command_line; + BatPrintf.fprintf f "%s" GobSys.command_line; BatPrintf.fprintf f ""; let timing_ppf = BatFormat.formatter_of_out_channel f in Timing.Default.print timing_ppf; @@ -290,7 +290,7 @@ struct let p_file f x = fprintf f "{\n \"name\": \"%s\",\n \"path\": \"%s\",\n \"functions\": %a\n}" (Filename.basename x) x (p_list p_fun) (SH.find_all file2funs x) in let write_file f fn = printf "Writing json to temp. file: %s\n%!" fn; - fprintf f "{\n \"parameters\": \"%s\",\n " Goblintutil.command_line; + fprintf f "{\n \"parameters\": \"%s\",\n " GobSys.command_line; fprintf f "\"files\": %a,\n " (p_enum p_file) (SH.keys file2funs); fprintf f "\"results\": [\n %a\n]\n" printJson (Lazy.force table); (*gtfxml f gtable;*) diff --git a/src/framework/cfgTools.ml b/src/framework/cfgTools.ml index 686be23483..edc01dc814 100644 --- a/src/framework/cfgTools.ml +++ b/src/framework/cfgTools.ml @@ -659,10 +659,10 @@ let dead_code_cfg (module FileCfg: MyCFG.FileCfg) live = match glob with | GFun (fd,loc) -> (* ignore (Printf.printf "fun: %s\n" fd.svar.vname); *) - let base_dir = Goblintutil.create_dir (Fpath.v "cfgs") in + let base_dir = GobSys.mkdir_or_exists_absolute (Fpath.v "cfgs") in let c_file_name = Str.global_substitute (Str.regexp Filename.dir_sep) (fun _ -> "%2F") loc.file in let dot_file_name = fd.svar.vname^".dot" in - let file_dir = Goblintutil.create_dir Fpath.(base_dir / c_file_name) in + let file_dir = GobSys.mkdir_or_exists_absolute Fpath.(base_dir / c_file_name) in let fname = Fpath.(file_dir / dot_file_name) in let out = open_out (Fpath.to_string fname) in let ppf = Format.formatter_of_out_channel out in diff --git a/src/framework/control.ml b/src/framework/control.ml index 699cfb4147..c23a0097e8 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -527,7 +527,7 @@ struct GobConfig.write_file config; let module Meta = struct type t = { command : string; version: string; timestamp : float; localtime : string } [@@deriving to_yojson] - let json = to_yojson { command = GU.command_line; version = Version.goblint; timestamp = Unix.time (); localtime = GobUnix.localtime () } + let json = to_yojson { command = GobSys.command_line; version = Version.goblint; timestamp = Unix.time (); localtime = GobUnix.localtime () } end in (* Yojson.Safe.to_file meta Meta.json; *) @@ -540,7 +540,7 @@ struct Serialize.marshal (file, Cabs2cil.environment) cil; Serialize.marshal !Messages.Table.messages_list warnings; ); - Goblintutil.(self_signal (signal_of_string (get_string "dbg.solver-signal"))); (* write solver_stats after solving (otherwise no rows if faster than dbg.solver-stats-interval). TODO better way to write solver_stats without terminal output? *) + GobSys.(self_signal (signal_of_string (get_string "dbg.solver-signal"))); (* write solver_stats after solving (otherwise no rows if faster than dbg.solver-stats-interval). TODO better way to write solver_stats without terminal output? *) ); lh, gh ) diff --git a/src/goblint.ml b/src/goblint.ml index 46d4fa45d3..0d91df9e80 100644 --- a/src/goblint.ml +++ b/src/goblint.ml @@ -37,7 +37,7 @@ let main () = if get_bool "dbg.verbose" then ( print_endline (GobUnix.localtime ()); - print_endline Goblintutil.command_line; + print_endline GobSys.command_line; ); let file = lazy (Fun.protect ~finally:GoblintDir.finalize preprocess_parse_merge) in if get_bool "server.enabled" then ( diff --git a/src/maingoblint.ml b/src/maingoblint.ml index 910bf9c9e2..cfaa74d547 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -61,7 +61,7 @@ let rec option_spec_list: Arg_complete.speclist Lazy.t = lazy ( if (get_string "outfile" = "") then set_string "outfile" "result"; if get_string "exp.g2html_path" = "" then - set_string "exp.g2html_path" (Fpath.to_string exe_dir); + set_string "exp.g2html_path" (Fpath.to_string GobSys.exe_dir); set_bool "exp.cfgdot" true; set_bool "g2html" true; set_string "result" "fast_xml" @@ -188,7 +188,7 @@ let handle_flags () = let handle_options () = check_arguments (); AfterConfig.run (); - Sys.set_signal (Goblintutil.signal_of_string (get_string "dbg.solver-signal")) Signal_ignore; (* Ignore solver-signal before solving (e.g. MyCFG), otherwise exceptions self-signal the default, which crashes instead of printing backtrace. *) + Sys.set_signal (GobSys.signal_of_string (get_string "dbg.solver-signal")) Signal_ignore; (* Ignore solver-signal before solving (e.g. MyCFG), otherwise exceptions self-signal the default, which crashes instead of printing backtrace. *) Cilfacade.init_options (); handle_flags () @@ -259,7 +259,7 @@ let preprocess_files () = (* the base include directory *) (* TODO: any better way? dune executable promotion doesn't add _build sites *) let source_lib_dirs = - let source_lib = Fpath.(exe_dir / "lib") in + let source_lib = Fpath.(GobSys.exe_dir / "lib") in if Sys.file_exists (Fpath.to_string source_lib) && Sys.is_directory (Fpath.to_string source_lib) then ( Sys.readdir Fpath.(to_string source_lib) |> Array.to_list @@ -322,7 +322,7 @@ let preprocess_files () = else [] end @ [ - Fpath.(exe_dir / "linux-headers"); + Fpath.(GobSys.exe_dir / "linux-headers"); (* linux-headers not installed with goblint package *) ] in @@ -546,7 +546,7 @@ let do_analyze change_info merged_AST = in Messages.error ~category:Analyzer "About to crash%t!" pretty_mark; (* trigger Generic.SolverStats...print_stats *) - Goblintutil.(self_signal (signal_of_string (get_string "dbg.solver-signal"))); + GobSys.(self_signal (signal_of_string (get_string "dbg.solver-signal"))); do_stats (); print_newline (); Printexc.raise_with_backtrace e backtrace (* re-raise with captured inner backtrace *) @@ -668,4 +668,4 @@ let () = (* signal for printing backtrace; other signals in Generic.SolverStats let open Sys in (* whether interactive interrupt (ctrl-C) terminates the program or raises the Break exception which we use below to print a backtrace. https://ocaml.org/api/Sys.html#VALcatch_break *) catch_break true; - set_signal (Goblintutil.signal_of_string (get_string "dbg.backtrace-signal")) (Signal_handle (fun _ -> Printexc.get_callstack 999 |> Printexc.print_raw_backtrace Stdlib.stderr; print_endline "\n...\n")) (* e.g. `pkill -SIGUSR2 goblint`, or `kill`, `htop` *) + set_signal (GobSys.signal_of_string (get_string "dbg.backtrace-signal")) (Signal_handle (fun _ -> Printexc.get_callstack 999 |> Printexc.print_raw_backtrace Stdlib.stderr; print_endline "\n...\n")) (* e.g. `pkill -SIGUSR2 goblint`, or `kill`, `htop` *) diff --git a/src/solvers/generic.ml b/src/solvers/generic.ml index 6da99f6ea9..006c14c4a1 100644 --- a/src/solvers/generic.ml +++ b/src/solvers/generic.ml @@ -133,7 +133,7 @@ struct let write_header = write_csv ["runtime"; "vars"; "evals"; "contexts"; "max_heap"] (* TODO @ !solver_stats_headers *) in Option.may write_header stats_csv; (* call print_stats on dbg.solver-signal *) - Sys.set_signal (Goblintutil.signal_of_string (get_string "dbg.solver-signal")) (Signal_handle print_stats); + Sys.set_signal (GobSys.signal_of_string (get_string "dbg.solver-signal")) (Signal_handle print_stats); (* call print_stats every dbg.solver-stats-interval *) Sys.set_signal Sys.sigvtalrm (Signal_handle print_stats); (* https://ocaml.org/api/Unix.html#TYPEinterval_timer ITIMER_VIRTUAL is user time; sends sigvtalarm; ITIMER_PROF/sigprof is already used in Timeout.Unix.timeout *) diff --git a/src/util/gobSys.ml b/src/util/gobSys.ml index 28244340c7..a2c69419c4 100644 --- a/src/util/gobSys.ml +++ b/src/util/gobSys.ml @@ -13,12 +13,38 @@ let mkdir_or_exists dirname = with Unix.Unix_error (Unix.EEXIST, _, _) -> assert (Sys.is_directory dirname_str) (* may exist, but as a file *) +(** Creates a directory and returns the absolute path **) +let mkdir_or_exists_absolute name = + let dirName = GobFpath.cwd_append name in + mkdir_or_exists dirName; + dirName + let rmdir_if_empty dirname = try Unix.rmdir (Fpath.to_string dirname) with Unix.Unix_error (Unix.ENOTEMPTY, _, _) -> () +(** Remove directory and its content, as "rm -rf" would do. *) +let rmdir_recursive path = + let rec f path = + let path_str = Fpath.to_string path in + if Sys.is_directory path_str then begin + let files = Array.map (Fpath.add_seg path) (Sys.readdir path_str) in + Array.iter f files; + Unix.rmdir path_str + end else + Sys.remove path_str + in + f path + + +let exe_dir = Fpath.(parent (v Sys.executable_name)) + +let command_line = match Array.to_list Sys.argv with + | command :: arguments -> Filename.quote_command command arguments + | [] -> assert false + (* Sys.time gives runtime in seconds as float *) let split_time () = (* gives CPU time in h,m,s,ms *) @@ -30,3 +56,25 @@ let split_time () = (* gives CPU time in h,m,s,ms *) let string_of_time () = (* CPU time as hh:mm:ss.ms *) let h,m,s,ms = split_time () in Printf.sprintf "%02d:%02d:%02d.%03d" h m s ms + + +(* https://ocaml.org/api/Sys.html#2_SignalnumbersforthestandardPOSIXsignals *) +(* https://ocaml.github.io/ocamlunix/signals.html *) +let signal_of_string = + let open Sys in + function + | "sigint" -> sigint (* Ctrl+C Interactive interrupt *) + | "sigtstp" -> sigtstp (* Ctrl+Z Interactive stop *) + | "sigquit" -> sigquit (* Ctrl+\ Interactive termination *) + | "sigalrm" -> sigalrm (* Timeout *) + | "sigkill" -> sigkill (* Termination (cannot be ignored) *) + | "sigsegv" -> sigsegv (* Invalid memory reference, https://github.com/goblint/analyzer/issues/206 *) + | "sigterm" -> sigterm (* Termination *) + | "sigusr1" -> sigusr1 (* Application-defined signal 1 *) + | "sigusr2" -> sigusr2 (* Application-defined signal 2 *) + | "sigstop" -> sigstop (* Stop *) + | "sigprof" -> sigprof (* Profiling interrupt *) + | "sigxcpu" -> sigxcpu (* Timeout in cpu time *) + | s -> invalid_arg ("Unhandled signal " ^ s) + +let self_signal signal = Unix.kill (Unix.getpid ()) signal diff --git a/src/util/goblintDir.ml b/src/util/goblintDir.ml index 0b8bf04e7a..f5d616e058 100644 --- a/src/util/goblintDir.ml +++ b/src/util/goblintDir.ml @@ -11,5 +11,5 @@ let init () = let finalize () = if not (get_bool "pre.keep") then - ignore (Goblintutil.rm_rf (preprocessed ())); + ignore (GobSys.rmdir_recursive (preprocessed ())); GobSys.rmdir_if_empty (root ()) diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index 2c49395915..3aba3dbaf6 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -56,26 +56,6 @@ let verified : bool option ref = ref None let escape = XmlUtil.escape (* TODO: inline everywhere *) -(** Creates a directory and returns the absolute path **) -let create_dir name = - let dirName = GobFpath.cwd_append name in - GobSys.mkdir_or_exists dirName; - dirName - -(** Remove directory and its content, as "rm -rf" would do. *) -let rm_rf path = - let rec f path = - let path_str = Fpath.to_string path in - if Sys.is_directory path_str then begin - let files = Array.map (Fpath.add_seg path) (Sys.readdir path_str) in - Array.iter f files; - Unix.rmdir path_str - end else - Sys.remove path_str - in - f path - - exception Timeout let timeout = Timeout.timeout @@ -119,29 +99,6 @@ let print_gc_quick_stat chn = gc.Gc.compactions; gc -let exe_dir = Fpath.(parent (v Sys.executable_name)) -let command_line = match Array.to_list Sys.argv with - | command :: arguments -> Filename.quote_command command arguments - | [] -> assert false - -(* https://ocaml.org/api/Sys.html#2_SignalnumbersforthestandardPOSIXsignals *) -(* https://ocaml.github.io/ocamlunix/signals.html *) -let signal_of_string = let open Sys in function - | "sigint" -> sigint (* Ctrl+C Interactive interrupt *) - | "sigtstp" -> sigtstp (* Ctrl+Z Interactive stop *) - | "sigquit" -> sigquit (* Ctrl+\ Interactive termination *) - | "sigalrm" -> sigalrm (* Timeout *) - | "sigkill" -> sigkill (* Termination (cannot be ignored) *) - | "sigsegv" -> sigsegv (* Invalid memory reference, https://github.com/goblint/analyzer/issues/206 *) - | "sigterm" -> sigterm (* Termination *) - | "sigusr1" -> sigusr1 (* Application-defined signal 1 *) - | "sigusr2" -> sigusr2 (* Application-defined signal 2 *) - | "sigstop" -> sigstop (* Stop *) - | "sigprof" -> sigprof (* Profiling interrupt *) - | "sigxcpu" -> sigxcpu (* Timeout in cpu time *) - | s -> failwith ("Unhandled signal " ^ s) - -let self_signal signal = Unix.kill (Unix.getpid ()) signal let rec for_all_in_range (a, b) f = let module BI = IntOps.BigIntOps in diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 2ff2e8bf58..0cf542af28 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -1810,14 +1810,14 @@ "solver-signal": { "title": "dbg.solver-signal", "description": - "Signal to print statistics while solving. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in goblintutil.ml).", + "Signal to print statistics while solving. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", "type": "string", "default": "sigusr1" }, "backtrace-signal": { "title": "dbg.backtrace-signal", "description": - "Signal to print a raw backtrace on stderr. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in goblintutil.ml).", + "Signal to print a raw backtrace on stderr. Possible values: sigint (Ctrl+C), sigtstp (Ctrl+Z), sigquit (Ctrl+\\), sigusr1, sigusr2, sigalrm, sigprof etc. (see signal_of_string in gobSys.ml).", "type": "string", "default": "sigusr2" }, diff --git a/src/util/sarif.ml b/src/util/sarif.ml index 7877dd343f..216060c9e9 100644 --- a/src/util/sarif.ml +++ b/src/util/sarif.ml @@ -135,7 +135,7 @@ let to_yojson messages = schema = "https://schemastore.azurewebsites.net/schemas/json/sarif-2.1.0-rtm.5.json"; runs = [{ invocations = [{ - commandLine = Goblintutil.command_line; + commandLine = GobSys.command_line; executionSuccessful = true; }]; artifacts = artifacts_of_messages messages; diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index ddea3d652b..8c2bae6352 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -16,7 +16,7 @@ struct let producer: Producer.t = { name = "Goblint"; version = Version.goblint; - command_line = Some Goblintutil.command_line; + command_line = Some GobSys.command_line; } let metadata ?task (): Metadata.t = From 56a88b16749c52f648e63f307fc05afa6e3de629 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 18:37:53 +0300 Subject: [PATCH 176/518] Move timeout functions out of Goblintutil --- src/framework/control.ml | 6 +++--- src/goblint.ml | 2 +- src/util/goblintutil.ml | 19 ------------------- src/util/timeout.ml | 5 ++++- src/witness/timeUtil.ml | 15 +++++++++++++++ 5 files changed, 23 insertions(+), 24 deletions(-) diff --git a/src/framework/control.ml b/src/framework/control.ml index c23a0097e8..f531f0aa1a 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -656,10 +656,10 @@ struct (* Can't call Generic.SolverStats...print_stats :( print_stats is triggered by dbg.solver-signal, so we send that signal to ourself in maingoblint before re-raising Timeout. The alternative would be to catch the below Timeout, print_stats and re-raise in each solver (or include it in some functor above them). *) - raise GU.Timeout + raise Timeout.Timeout in - let timeout = get_string "dbg.timeout" |> Goblintutil.seconds_of_duration_string in - let lh, gh = Goblintutil.timeout solve_and_postprocess () (float_of_int timeout) timeout_reached in + let timeout = get_string "dbg.timeout" |> TimeUtil.seconds_of_duration_string in + let lh, gh = Timeout.wrap solve_and_postprocess () (float_of_int timeout) timeout_reached in let module SpecSysSol: SpecSysSol with module SpecSys = SpecSys = struct module SpecSys = SpecSys diff --git a/src/goblint.ml b/src/goblint.ml index 0d91df9e80..f8d840fe08 100644 --- a/src/goblint.ml +++ b/src/goblint.ml @@ -78,7 +78,7 @@ let main () = eprintf "%s\n" (MessageUtil.colorize ~fd:Unix.stderr ("{RED}Analysis was aborted by SIGINT (Ctrl-C)!")); Goblint_timing.teardown_tef (); exit 131 (* same exit code as without `Sys.catch_break true`, otherwise 0 *) - | Timeout -> + | Timeout.Timeout -> do_stats (); eprintf "%s\n" (MessageUtil.colorize ~fd:Unix.stderr ("{RED}Analysis was aborted because it reached the set timeout of " ^ get_string "dbg.timeout" ^ " or was signalled SIGPROF!")); Goblint_timing.teardown_tef (); diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index 3aba3dbaf6..8c73d8934d 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -56,25 +56,6 @@ let verified : bool option ref = ref None let escape = XmlUtil.escape (* TODO: inline everywhere *) -exception Timeout - -let timeout = Timeout.timeout - -let seconds_of_duration_string = - let unit = function - | "" | "s" -> 1 - | "m" -> 60 - | "h" -> 60 * 60 - | s -> failwith ("Unkown duration unit " ^ s ^ ". Supported units are h, m, s.") - in - let int_rest f s = Scanf.sscanf s "%u%s" f in - let split s = BatString.(head s 1, tail s 1) in - let rec f i s = - let u, r = split s in (* unit, rest *) - i * (unit u) + if r = "" then 0 else int_rest f r - in - int_rest f - let vars = ref 0 let evals = ref 0 let narrow_reuses = ref 0 diff --git a/src/util/timeout.ml b/src/util/timeout.ml index 908fbb9b8e..c60bbb32bb 100644 --- a/src/util/timeout.ml +++ b/src/util/timeout.ml @@ -13,6 +13,9 @@ module Js = struct (* TODO: Implement this *) end -let timeout = match Sys.backend_type with +let wrap = match Sys.backend_type with | Other "js_of_ocaml" -> Js.timeout | _ -> Unix.timeout + + +exception Timeout diff --git a/src/witness/timeUtil.ml b/src/witness/timeUtil.ml index d3d779dc92..291e2e8fc2 100644 --- a/src/witness/timeUtil.ml +++ b/src/witness/timeUtil.ml @@ -5,3 +5,18 @@ let iso8601_of_tm {tm_year; tm_mon; tm_mday; tm_hour; tm_min; tm_sec; _} = Printf.sprintf "%04u-%02u-%02uT%02u:%02u:%02uZ" (1900 + tm_year) (tm_mon + 1) tm_mday tm_hour tm_min tm_sec let iso8601_now () = iso8601_of_tm (gmtime (time ())) + +let seconds_of_duration_string = + let unit = function + | "" | "s" -> 1 + | "m" -> 60 + | "h" -> 60 * 60 + | s -> invalid_arg ("Unkown duration unit " ^ s ^ ". Supported units are h, m, s.") + in + let int_rest f s = Scanf.sscanf s "%u%s" f in + let split s = BatString.(head s 1, tail s 1) in + let rec f i s = + let u, r = split s in (* unit, rest *) + i * (unit u) + if r = "" then 0 else int_rest f r + in + int_rest f From 50ad6bd049d796593c57df4a10f90eb6ddc2feba Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 18:41:10 +0300 Subject: [PATCH 177/518] Move Goblintutil.print_gc_quick_stat to GobGc --- src/solvers/generic.ml | 2 +- src/util/gobGc.ml | 19 +++++++++++++++++++ src/util/goblintutil.ml | 20 -------------------- 3 files changed, 20 insertions(+), 21 deletions(-) create mode 100644 src/util/gobGc.ml diff --git a/src/solvers/generic.ml b/src/solvers/generic.ml index 006c14c4a1..2b811a426d 100644 --- a/src/solvers/generic.ml +++ b/src/solvers/generic.ml @@ -122,7 +122,7 @@ struct print_newline (); (* Timing.print (M.get_out "timing" Legacy.stdout) "Timings:\n"; *) (* Gc.print_stat stdout; (* too verbose, slow and words instead of MB *) *) - let gc = Goblintutil.print_gc_quick_stat Legacy.stdout in + let gc = GobGc.print_quick_stat Legacy.stdout in print_newline (); Option.may (write_csv [GobSys.string_of_time (); string_of_int !Goblintutil.vars; string_of_int !Goblintutil.evals; string_of_int !ncontexts; string_of_int gc.Gc.top_heap_words]) stats_csv; (* print_string "Do you want to continue? [Y/n]"; *) diff --git a/src/util/gobGc.ml b/src/util/gobGc.ml new file mode 100644 index 0000000000..3755658d42 --- /dev/null +++ b/src/util/gobGc.ml @@ -0,0 +1,19 @@ +(* print GC statistics; taken from Cil.Stats.print which also includes timing; there's also Gc.print_stat, but it's in words instead of MB and more info than we want (also slower than quick_stat since it goes through the heap) *) +let print_quick_stat chn = + let gc = Gc.quick_stat () in + let printM (w: float) : string = + let coeff = float_of_int (Sys.word_size / 8) in + Printf.sprintf "%.2fMB" (w *. coeff /. 1000000.0) + in + Printf.fprintf chn + "Memory statistics: total=%s, max=%s, minor=%s, major=%s, promoted=%s\n minor collections=%d major collections=%d compactions=%d\n" + (printM (gc.Gc.minor_words +. gc.Gc.major_words + -. gc.Gc.promoted_words)) + (printM (float_of_int gc.Gc.top_heap_words)) + (printM gc.Gc.minor_words) + (printM gc.Gc.major_words) + (printM gc.Gc.promoted_words) + gc.Gc.minor_collections + gc.Gc.major_collections + gc.Gc.compactions; + gc diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index 8c73d8934d..0c871cc3b0 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -60,26 +60,6 @@ let vars = ref 0 let evals = ref 0 let narrow_reuses = ref 0 -(* print GC statistics; taken from Cil.Stats.print which also includes timing; there's also Gc.print_stat, but it's in words instead of MB and more info than we want (also slower than quick_stat since it goes through the heap) *) -let print_gc_quick_stat chn = - let gc = Gc.quick_stat () in - let printM (w: float) : string = - let coeff = float_of_int (Sys.word_size / 8) in - Printf.sprintf "%.2fMB" (w *. coeff /. 1000000.0) - in - Printf.fprintf chn - "Memory statistics: total=%s, max=%s, minor=%s, major=%s, promoted=%s\n minor collections=%d major collections=%d compactions=%d\n" - (printM (gc.Gc.minor_words +. gc.Gc.major_words - -. gc.Gc.promoted_words)) - (printM (float_of_int gc.Gc.top_heap_words)) - (printM gc.Gc.minor_words) - (printM gc.Gc.major_words) - (printM gc.Gc.promoted_words) - gc.Gc.minor_collections - gc.Gc.major_collections - gc.Gc.compactions; - gc - let rec for_all_in_range (a, b) f = let module BI = IntOps.BigIntOps in From 67cf689095c7de033d9e8f889ac16fe02a27dee2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 18:44:48 +0300 Subject: [PATCH 178/518] Remove Goblintutil.escape --- src/cdomains/apron/relationDomain.apron.ml | 2 +- src/framework/analyses.ml | 2 +- src/util/goblintutil.ml | 2 -- src/witness/graphml.ml | 2 +- 4 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/cdomains/apron/relationDomain.apron.ml b/src/cdomains/apron/relationDomain.apron.ml index ca386b99bf..c13b44b075 100644 --- a/src/cdomains/apron/relationDomain.apron.ml +++ b/src/cdomains/apron/relationDomain.apron.ml @@ -178,7 +178,7 @@ struct ++ text ")" let printXml f r = - BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n\n" (Goblintutil.escape (RD.name ())) RD.printXml r.rel (Goblintutil.escape (PrivD.name ())) PrivD.printXml r.priv + BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n\n" (XmlUtil.escape (RD.name ())) RD.printXml r.rel (XmlUtil.escape (PrivD.name ())) PrivD.printXml r.priv let name () = RD.name () ^ " * " ^ PrivD.name () diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index fb0d6f58d4..8efe28c035 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -212,7 +212,7 @@ struct match loc with | Some loc -> let l = Messages.Location.to_cil loc in - BatPrintf.fprintf f "\n%s" l.file l.line l.column (GU.escape m) + BatPrintf.fprintf f "\n%s" l.file l.line l.column (XmlUtil.escape m) | None -> () (* TODO: not outputting warning without location *) in diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index 0c871cc3b0..c2e54482cf 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -53,8 +53,6 @@ let postsolving = ref false (* None if verification is disabled, Some true if verification succeeded, Some false if verification failed *) let verified : bool option ref = ref None -let escape = XmlUtil.escape (* TODO: inline everywhere *) - let vars = ref 0 let evals = ref 0 diff --git a/src/witness/graphml.ml b/src/witness/graphml.ml index f23daf57fd..1282a6e3c3 100644 --- a/src/witness/graphml.ml +++ b/src/witness/graphml.ml @@ -19,7 +19,7 @@ struct type t = unit BatIO.output type node = string - open Goblintutil + let escape = XmlUtil.escape let start out = let f = BatIO.output_channel out in From 95d78d9a913f0916f9bca4a28691c1d8ef1b33cb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 19:07:47 +0300 Subject: [PATCH 179/518] Move Goblintutil.for_all_in_range to GobZ --- src/cdomains/intDomain.ml | 6 +++--- src/util/gobZ.ml | 6 ++++++ src/util/goblintutil.ml | 6 ------ 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/cdomains/intDomain.ml b/src/cdomains/intDomain.ml index ebe9dc4038..a299f7239a 100644 --- a/src/cdomains/intDomain.ml +++ b/src/cdomains/intDomain.ml @@ -1878,7 +1878,7 @@ struct else (* The cardinality did fit, so we check for all elements that are represented by range r, whether they are in (xs union ys) *) let min_a = min_of_range r in let max_a = max_of_range r in - GU.for_all_in_range (min_a, max_a) (fun el -> BISet.mem el xs || BISet.mem el ys) + GobZ.for_all_range (fun el -> BISet.mem el xs || BISet.mem el ys) (min_a, max_a) let leq (Exc (xs, r)) (Exc (ys, s)) = let min_a, max_a = min_of_range r, max_of_range r in @@ -1892,13 +1892,13 @@ struct let min_b, max_b = min_of_range s, max_of_range s in let leq1 = (* check whether the elements in [r_l; s_l-1] are all in xs, i.e. excluded *) if I.compare min_a min_b < 0 then - GU.for_all_in_range (min_a, BI.sub min_b BI.one) (fun x -> BISet.mem x xs) + GobZ.for_all_range (fun x -> BISet.mem x xs) (min_a, BI.sub min_b BI.one) else true in let leq2 () = (* check whether the elements in [s_u+1; r_u] are all in xs, i.e. excluded *) if I.compare max_b max_a < 0 then - GU.for_all_in_range (BI.add max_b BI.one, max_a) (fun x -> BISet.mem x xs) + GobZ.for_all_range (fun x -> BISet.mem x xs) (BI.add max_b BI.one, max_a) else true in diff --git a/src/util/gobZ.ml b/src/util/gobZ.ml index da17dba77c..598b8448dc 100644 --- a/src/util/gobZ.ml +++ b/src/util/gobZ.ml @@ -2,3 +2,9 @@ type t = Z.t let to_yojson z = `Intlit (Z.to_string z) + +let rec for_all_range f (a, b) = + if Z.compare a b > 0 then + true + else + f a && for_all_range f (Z.succ a, b) diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index c2e54482cf..633c6f7ca3 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -59,12 +59,6 @@ let evals = ref 0 let narrow_reuses = ref 0 -let rec for_all_in_range (a, b) f = - let module BI = IntOps.BigIntOps in - if BI.compare a b > 0 - then true - else f a && (for_all_in_range (BI.add a (BI.one), b) f) - let dummy_obj = Obj.repr () let jobs () = From 5cbce96311dcfc4c6fffd35f11bc503f6de278e6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 19:11:43 +0300 Subject: [PATCH 180/518] Extract GobRef.wrap --- src/transform/deadCode.ml | 2 +- src/transform/transform.ml | 2 +- src/util/gobRef.ml | 5 +++++ src/util/goblintutil.ml | 6 ------ 4 files changed, 7 insertions(+), 8 deletions(-) create mode 100644 src/util/gobRef.ml diff --git a/src/transform/deadCode.ml b/src/transform/deadCode.ml index 1491142fc3..cc6c1d928d 100644 --- a/src/transform/deadCode.ml +++ b/src/transform/deadCode.ml @@ -172,7 +172,7 @@ module RemoveDeadCode : Transform.S = struct the main function(s). Dead functions and globals are removed, since there is no chain of syntactic references to them from the main function(s). *) let open GoblintCil.RmUnused in - Goblintutil.with_ref keepUnused false @@ fun () -> + GobRef.wrap keepUnused false @@ fun () -> removeUnused ~isRoot:(function | GFun (fd, _) -> List.mem fd.svar.vname (get_string_list "mainfun") diff --git a/src/transform/transform.ml b/src/transform/transform.ml index e6089e533b..c508da703d 100644 --- a/src/transform/transform.ml +++ b/src/transform/transform.ml @@ -36,7 +36,7 @@ let run_transformations ?(file_output = true) file names ask = if file_output && List.exists (fun (_, (module T : S)) -> T.requires_file_output) active_transformations then let filename = GobConfig.get_string "trans.output" in let oc = Stdlib.open_out filename in - Goblintutil.with_ref GoblintCil.lineDirectiveStyle None @@ fun () -> + GobRef.wrap GoblintCil.lineDirectiveStyle None @@ fun () -> dumpFile defaultCilPrinter oc filename file; Stdlib.close_out oc diff --git a/src/util/gobRef.ml b/src/util/gobRef.ml new file mode 100644 index 0000000000..912f975467 --- /dev/null +++ b/src/util/gobRef.ml @@ -0,0 +1,5 @@ +(** call [f], with [r] temporarily set to [x] *) +let wrap r x = + let x0 = !r in + r := x; + Fun.protect ~finally:(fun () -> r := x0) diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index 633c6f7ca3..d709ce2d8b 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -65,9 +65,3 @@ let jobs () = match get_int "jobs" with | 0 -> Cpu.numcores () | n -> n - -(** call [f], with [r] temporarily set to [x] *) -let with_ref r x = - let x0 = !r in - r := x; - Fun.protect ~finally:(fun () -> r := x0) From ccc76cd3164e9d47ce0331036280a5e314ae4672 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 19:16:46 +0300 Subject: [PATCH 181/518] Extract AnalysisState --- src/analyses/accessAnalysis.ml | 4 ++-- src/analyses/apron/relationAnalysis.apron.ml | 4 ++-- src/analyses/base.ml | 2 +- src/analyses/basePriv.ml | 4 ++-- src/analyses/commonPriv.ml | 2 +- src/analyses/deadlock.ml | 2 +- src/analyses/extractPthread.ml | 2 +- src/analyses/mutexAnalysis.ml | 2 +- src/analyses/raceAnalysis.ml | 4 ++-- src/analyses/threadFlag.ml | 2 +- src/analyses/threadReturn.ml | 2 +- src/analyses/unassumeAnalysis.ml | 2 +- src/cdomains/arrayDomain.ml | 2 +- src/cdomains/intDomain.ml | 4 ++-- src/cdomains/valueDomain.ml | 4 ++-- src/framework/analysisState.ml | 16 ++++++++++++++++ src/framework/constraints.ml | 4 ++-- src/framework/control.ml | 14 +++++++------- src/goblint.ml | 2 +- src/maingoblint.ml | 2 +- src/solvers/postSolver.ml | 16 ++++++++-------- src/util/goblintutil.ml | 16 ---------------- src/util/messages.ml | 6 +++--- src/util/server.ml | 2 +- src/witness/witness.ml | 4 ++-- 25 files changed, 62 insertions(+), 62 deletions(-) create mode 100644 src/framework/analysisState.ml diff --git a/src/analyses/accessAnalysis.ml b/src/analyses/accessAnalysis.ml index 2af77d1d8d..6dcc31dd86 100644 --- a/src/analyses/accessAnalysis.ml +++ b/src/analyses/accessAnalysis.ml @@ -65,7 +65,7 @@ struct let assign ctx lval rval : D.t = (* ignore global inits *) - if !GU.global_initialization then ctx.local else begin + if !AnalysisState.global_initialization then ctx.local else begin access_one_top ~deref:true ctx Write false (AddrOf lval); access_one_top ctx Read false rval; ctx.local @@ -135,7 +135,7 @@ struct let event ctx e octx = match e with - | Events.Access {lvals; kind; _} when !collect_local && !Goblintutil.postsolving -> + | Events.Access {lvals; kind; _} when !collect_local && !AnalysisState.postsolving -> begin match lvals with | ls when Queries.LS.is_top ls -> let access: AccessDomain.Event.t = {var_opt = None; offs_opt = None; kind} in diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 5d2a659697..44b7eb4fd8 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -224,7 +224,7 @@ struct let assign ctx (lv:lval) e = let st = ctx.local in - if !GU.global_initialization && e = MyCFG.unknown_exp then + if !AnalysisState.global_initialization && e = MyCFG.unknown_exp then st (* ignore extern inits because there's no body before assign, so env is empty... *) else ( let simplified_e = replace_deref_exps ctx.ask e in @@ -683,7 +683,7 @@ struct let sync ctx reason = (* After the solver is finished, store the results (for later comparison) *) - if !GU.postsolving then begin + if !AnalysisState.postsolving then begin let keep_local = GobConfig.get_bool "ana.relation.invariant.local" in let keep_global = GobConfig.get_bool "ana.relation.invariant.global" in diff --git a/src/analyses/base.ml b/src/analyses/base.ml index a171b88355..19250d1d6a 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1716,7 +1716,7 @@ struct in (match rval_val, lval_val with | `Address adrs, lval - when (not !GU.global_initialization) && get_bool "kernel" && not_local lval && not (AD.is_top adrs) -> + when (not !AnalysisState.global_initialization) && get_bool "kernel" && not_local lval && not (AD.is_top adrs) -> let find_fps e xs = match Addr.to_var_must e with | Some x -> x :: xs | None -> xs diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 0e97966cb8..bab6653e2c 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -898,7 +898,7 @@ struct let global_init_thread = RichVarinfo.single ~name:"global_init" let current_thread (ask: Q.ask): Thread.t = - if !GU.global_initialization then + if !AnalysisState.global_initialization then ThreadIdDomain.Thread.threadinit (global_init_thread ()) ~multiple:false else ThreadId.get_current_unlift ask @@ -1632,7 +1632,7 @@ struct let read_global ask getg st x = let v = Priv.read_global ask getg st x in - if !GU.postsolving && !is_dumping then + if !AnalysisState.postsolving && !is_dumping then LVH.modify_def (VD.bot ()) (!Tracing.current_loc, x) (VD.join v) lvh; v diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 4f80b05b0a..03634b150c 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -130,7 +130,7 @@ struct let current_lockset (ask: Q.ask): Lockset.t = (* TODO: remove this global_init workaround *) - if !GU.global_initialization then + if !AnalysisState.global_initialization then Lockset.empty () else let ls = ask.f Queries.MustLockset in diff --git a/src/analyses/deadlock.ml b/src/analyses/deadlock.ml index 56a0ddaf4d..09d16eed03 100644 --- a/src/analyses/deadlock.ml +++ b/src/analyses/deadlock.ml @@ -24,7 +24,7 @@ struct module G = MapDomain.MapBot (Lock) (MayLockEventPairs) let side_lock_event_pair ctx ((before_node, _, _) as before) ((after_node, _, _) as after) = - if !GU.should_warn then + if !AnalysisState.should_warn then ctx.sideg before_node (G.singleton after_node (MayLockEventPairs.singleton (before, after))) let part_access ctx: MCPAccess.A.t = diff --git a/src/analyses/extractPthread.ml b/src/analyses/extractPthread.ml index 19171d0df6..57cf616a7b 100644 --- a/src/analyses/extractPthread.ml +++ b/src/analyses/extractPthread.ml @@ -1036,7 +1036,7 @@ module Spec : Analyses.MCPSpec = struct let body ctx (f : fundec) : D.t = (* enter is not called for spawned threads -> initialize them here *) - let context_hash = Int64.of_int (if not !Goblintutil.global_initialization then ControlSpecC.hash (ctx.control_context ()) else 37) in + let context_hash = Int64.of_int (if not !AnalysisState.global_initialization then ControlSpecC.hash (ctx.control_context ()) else 37) in { ctx.local with ctx = Ctx.of_int context_hash } diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 681b0eae3c..fc19d39541 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -226,7 +226,7 @@ struct let el = (locks, if write then locks else Mutexes.top ()) in ctx.sideg (V.protecting v) (G.create_protecting el); - if !GU.postsolving then ( + if !AnalysisState.postsolving then ( let held_locks = (if write then snd else fst) (G.protecting (ctx.global (V.protecting v))) in let vs_empty = VarSet.empty () in Mutexes.iter (fun addr -> diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index d92a459739..d1b357b674 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -54,7 +54,7 @@ struct let side_vars ctx lv_opt ty = match lv_opt with | Some (v, _) -> - if !GU.should_warn then + if !AnalysisState.should_warn then ctx.sideg (V.vars v) (G.create_vars (V0Set.singleton (lv_opt, ty))) | None -> () @@ -66,7 +66,7 @@ struct else ty in - if !GU.should_warn then + if !AnalysisState.should_warn then ctx.sideg (V.access (lv_opt, ty)) (G.create_access (Access.AS.singleton (conf, w, loc, e, a))); side_vars ctx lv_opt ty diff --git a/src/analyses/threadFlag.ml b/src/analyses/threadFlag.ml index b2b0be023b..2975d6b6cb 100644 --- a/src/analyses/threadFlag.ml +++ b/src/analyses/threadFlag.ml @@ -7,7 +7,7 @@ open GoblintCil open Analyses let is_multi (ask: Queries.ask): bool = - if !GU.global_initialization then false else + if !AnalysisState.global_initialization then false else not (ask.f Queries.MustBeSingleThreaded) diff --git a/src/analyses/threadReturn.ml b/src/analyses/threadReturn.ml index 4fd7303388..0b4cc7c673 100644 --- a/src/analyses/threadReturn.ml +++ b/src/analyses/threadReturn.ml @@ -18,7 +18,7 @@ struct (* transfer functions *) let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = - if !Goblintutil.global_initialization then + if !AnalysisState.global_initialization then (* We are inside enter_with inside a startfun, and thus the current function retruning is the main function *) [ctx.local, true] else diff --git a/src/analyses/unassumeAnalysis.ml b/src/analyses/unassumeAnalysis.ml index 1379012d82..72cc1b78ce 100644 --- a/src/analyses/unassumeAnalysis.ml +++ b/src/analyses/unassumeAnalysis.ml @@ -231,7 +231,7 @@ struct | x :: xs -> let e = List.fold_left (fun a {exp = b; _} -> Cil.(BinOp (LAnd, a, b, intType))) x.exp xs in M.info ~category:Witness "unassume invariant: %a" CilType.Exp.pretty e; - if not !Goblintutil.postsolving then ( + if not !AnalysisState.postsolving then ( if not (GobConfig.get_bool "ana.unassume.precheck" && Queries.ID.to_bool (ctx.ask (EvalInt e)) = Some false) then ( let uuids = x.uuid :: List.map (fun {uuid; _} -> uuid) xs in ctx.emit (Unassume {exp = e; uuids}); diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index 982cd94058..6837bbf303 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -426,7 +426,7 @@ struct let set_with_length length (ask:VDQ.t) x (i,_) a = if M.tracing then M.trace "update_offset" "part array set_with_length %a %s %a\n" pretty x (BatOption.map_default Basetype.CilExp.show "None" i) Val.pretty a; if i = Some MyCFG.all_array_index_exp then - (assert !Goblintutil.global_initialization; (* just joining with xm here assumes that all values will be set, which is guaranteed during inits *) + (assert !AnalysisState.global_initialization; (* just joining with xm here assumes that all values will be set, which is guaranteed during inits *) (* the join is needed here! see e.g 30/04 *) let o = match x with Partitioned (_, (_, xm, _)) -> xm | Joint v -> v in let r = Val.join o a in diff --git a/src/cdomains/intDomain.ml b/src/cdomains/intDomain.ml index a299f7239a..98dd0acc03 100644 --- a/src/cdomains/intDomain.ml +++ b/src/cdomains/intDomain.ml @@ -78,8 +78,8 @@ type overflow_info = { overflow: bool; underflow: bool;} let set_overflow_flag ~cast ~underflow ~overflow ik = let signed = Cil.isSigned ik in - if !GU.postsolving && signed && not cast then - Goblintutil.svcomp_may_overflow := true; + if !AnalysisState.postsolving && signed && not cast then + AnalysisState.svcomp_may_overflow := true; let sign = if signed then "Signed" else "Unsigned" in match underflow, overflow with | true, true -> diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 87cb389229..11eddd49b2 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -936,7 +936,7 @@ struct begin match value with | `Thread t -> value (* if actually assigning thread, use value *) | _ -> - if !GU.global_initialization then + if !AnalysisState.global_initialization then `Thread (ConcDomain.ThreadSet.empty ()) (* if assigning global init (int on linux, ptr to struct on mac), use empty set instead *) else `Top @@ -947,7 +947,7 @@ struct | `JmpBuf t -> value (* if actually assigning jmpbuf, use value *) | `Blob(`Bot, _, _) -> `Bot (* TODO: Stopgap for malloced jmp_bufs, there is something fundamentally flawed somewhere *) | _ -> - if !GU.global_initialization then + if !AnalysisState.global_initialization then `JmpBuf (JmpBufs.Bufs.empty (), false) (* if assigning global init, use empty set instead *) else `Top diff --git a/src/framework/analysisState.ml b/src/framework/analysisState.ml new file mode 100644 index 0000000000..b57d2bc341 --- /dev/null +++ b/src/framework/analysisState.ml @@ -0,0 +1,16 @@ +(** If this is true we output messages and collect accesses. + This is set to true in control.ml before we verify the result (or already before solving if warn = 'early') *) +let should_warn = ref false + +(** Whether signed overflow or underflow happened *) +let svcomp_may_overflow = ref false + +(** A hack to see if we are currently doing global inits *) +let global_initialization = ref false + + +(** Whether currently in postsolver evaluations (e.g. verify, warn) *) +let postsolving = ref false + +(* None if verification is disabled, Some true if verification succeeded, Some false if verification failed *) +let verified : bool option ref = ref None diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index b80ce45217..575b15ddb6 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -548,7 +548,7 @@ struct | _, _ -> S.sync ctx `Normal let side_context sideg f c = - if !GU.postsolving then + if !AnalysisState.postsolving then sideg (GVar.contexts f) (G.create_contexts (G.CSet.singleton c)) let common_ctx var edge prev_node pval (getl:lv -> ld) sidel getg sideg : (D.t, S.G.t, S.C.t, S.V.t) ctx * D.t list ref * (lval option * varinfo * exp list * D.t) list ref = @@ -1412,7 +1412,7 @@ struct let branch ctx = S.branch (conv ctx) let branch ctx exp tv = - if !GU.postsolving then ( + if !AnalysisState.postsolving then ( try let r = branch ctx exp tv in (* branch is live *) diff --git a/src/framework/control.ml b/src/framework/control.ml index f531f0aa1a..ce3326275d 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -215,7 +215,7 @@ struct end in - Goblintutil.should_warn := false; (* reset for server mode *) + AnalysisState.should_warn := false; (* reset for server mode *) (* exctract global xml from result *) let make_global_fast_xml f g = @@ -332,7 +332,7 @@ struct if get_bool "ana.sv-comp.enabled" then Witness.init (module FileCfg); (* TODO: move this out of analyze_loop *) - GU.global_initialization := true; + AnalysisState.global_initialization := true; GU.earlyglobs := get_bool "exp.earlyglobs"; let marshal: Spec.marshal option = if get_string "load_run" <> "" then @@ -344,10 +344,10 @@ struct in (* Some happen in init, so enable this temporarily (if required by option). *) - Goblintutil.should_warn := PostSolverArg.should_warn; + AnalysisState.should_warn := PostSolverArg.should_warn; Spec.init marshal; Access.init file; - Goblintutil.should_warn := false; + AnalysisState.should_warn := false; let test_domain (module D: Lattice.S): unit = let module DP = DomainProperties.All (D) in @@ -430,7 +430,7 @@ struct if startvars = [] then failwith "BUG: Empty set of start variables; may happen if enter_func of any analysis returns an empty list."; - GU.global_initialization := false; + AnalysisState.global_initialization := false; let startvars' = if get_bool "exp.forward" then @@ -507,7 +507,7 @@ struct in if get_bool "dbg.verbose" then print_endline ("Solving the constraint system with " ^ get_string "solver" ^ ". Solver statistics are shown every " ^ string_of_int (get_int "dbg.solver-stats-interval") ^ "s or by signal " ^ get_string "dbg.solver-signal" ^ "."); - Goblintutil.should_warn := get_string "warn_at" = "early" || gobview; + AnalysisState.should_warn := get_string "warn_at" = "early" || gobview; let (lh, gh), solver_data = Timing.wrap "solving" (Slvr.solve entrystates entrystates_global startvars') solver_data in if GobConfig.get_bool "incremental.save" then Serialize.Cache.(update_data SolverData solver_data); @@ -563,7 +563,7 @@ struct ); (* Most warnings happen before during postsolver, but some happen later (e.g. in finalize), so enable this for the rest (if required by option). *) - Goblintutil.should_warn := PostSolverArg.should_warn; + AnalysisState.should_warn := PostSolverArg.should_warn; let insrt k _ s = match k with | (MyCFG.Function fn,_) -> if not (get_bool "exp.forward") then Set.Int.add fn.svar.vid s else s diff --git a/src/goblint.ml b/src/goblint.ml index f8d840fe08..cb631d3eb2 100644 --- a/src/goblint.ml +++ b/src/goblint.ml @@ -65,7 +65,7 @@ let main () = do_gobview file; do_stats (); Goblint_timing.teardown_tef (); - if !verified = Some false then exit 3 (* verifier failed! *) + if !AnalysisState.verified = Some false then exit 3 (* verifier failed! *) ) with | Exit -> diff --git a/src/maingoblint.ml b/src/maingoblint.ml index cfaa74d547..dd9246651b 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -539,7 +539,7 @@ let do_analyze change_info merged_AST = try Control.analyze change_info ast funs with e -> let backtrace = Printexc.get_raw_backtrace () in (* capture backtrace immediately, otherwise the following loses it (internal exception usage without raise_notrace?) *) - Goblintutil.should_warn := true; (* such that the `about to crash` message gets printed *) + AnalysisState.should_warn := true; (* such that the `about to crash` message gets printed *) let pretty_mark () = match Goblint_backtrace.find_marks e with | m :: _ -> Pretty.dprintf " at mark %s" (Goblint_backtrace.mark_to_string m) | [] -> Pretty.nil diff --git a/src/solvers/postSolver.ml b/src/solvers/postSolver.ml index 021f5a0b62..c56133b6c3 100644 --- a/src/solvers/postSolver.ml +++ b/src/solvers/postSolver.ml @@ -76,14 +76,14 @@ module Verify: F = include Unit (S) (VH) let init () = - Goblintutil.verified := Some true + AnalysisState.verified := Some true let complain_constraint x ~lhs ~rhs = - Goblintutil.verified := Some false; + AnalysisState.verified := Some false; ignore (Pretty.printf "Fixpoint not reached at %a\n @[Solver computed:\n%a\nRight-Hand-Side:\n%a\nDifference: %a\n@]" S.Var.pretty_trace x S.Dom.pretty lhs S.Dom.pretty rhs S.Dom.pretty_diff (rhs, lhs)) let complain_side x y ~lhs ~rhs = - Goblintutil.verified := Some false; + AnalysisState.verified := Some false; ignore (Pretty.printf "Fixpoint not reached at %a\nOrigin: %a\n @[Solver computed:\n%a\nSide-effect:\n%a\nDifference: %a\n@]" S.Var.pretty_trace y S.Var.pretty_trace x S.Dom.pretty lhs S.Dom.pretty rhs S.Dom.pretty_diff (rhs, lhs)) let one_side ~vh ~x ~y ~d = @@ -108,11 +108,11 @@ module Warn: F = let old_should_warn = ref None let init () = - old_should_warn := Some !Goblintutil.should_warn; - Goblintutil.should_warn := true + old_should_warn := Some !AnalysisState.should_warn; + AnalysisState.should_warn := true let finalize ~vh ~reachable = - Goblintutil.should_warn := Option.get !old_should_warn + AnalysisState.should_warn := Option.get !old_should_warn end (** Postsolver for save_run option. *) @@ -189,7 +189,7 @@ struct in let module S = EqConstrSysFromStartEqConstrSys (StartS) in - Goblintutil.postsolving := true; + AnalysisState.postsolving := true; PS.init (); let reachable = PS.init_reachable ~vh in @@ -217,7 +217,7 @@ struct (Timing.wrap "postsolver_iter" (List.iter one_var)) vs; PS.finalize ~vh ~reachable; - Goblintutil.postsolving := false + AnalysisState.postsolving := false let post xs vs vh = Timing.wrap "postsolver" (post xs vs) vh diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index d709ce2d8b..46753c1166 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -7,13 +7,6 @@ open GobConfig (** Outputs information about what the goblin is doing *) (* let verbose = ref false *) -(** If this is true we output messages and collect accesses. - This is set to true in control.ml before we verify the result (or already before solving if warn = 'early') *) -let should_warn = ref false - -(** Whether signed overflow or underflow happened *) -let svcomp_may_overflow = ref false - (** The file where everything is output *) let out = ref stdout @@ -41,18 +34,9 @@ let is_blessed (t:typ): varinfo option = | _ -> (None : varinfo option) -(** A hack to see if we are currently doing global inits *) -let global_initialization = ref false - (** Another hack to see if earlyglobs is enabled *) let earlyglobs = ref false -(** Whether currently in postsolver evaluations (e.g. verify, warn) *) -let postsolving = ref false - -(* None if verification is disabled, Some true if verification succeeded, Some false if verification failed *) -let verified : bool option ref = ref None - let vars = ref 0 let evals = ref 0 diff --git a/src/util/messages.ml b/src/util/messages.ml index 0d05d97236..a497377466 100644 --- a/src/util/messages.ml +++ b/src/util/messages.ml @@ -248,7 +248,7 @@ let msg_context () = None (* avoid identical messages from multiple contexts without any mention of context *) let msg severity ?loc ?(tags=[]) ?(category=Category.Unknown) fmt = - if !GU.should_warn && Severity.should_warn severity && (Category.should_warn category || Tags.should_warn tags) then ( + if !AnalysisState.should_warn && Severity.should_warn severity && (Category.should_warn category || Tags.should_warn tags) then ( let finish doc = let text = Pretty.sprint ~width:max_int doc in let loc = match loc with @@ -263,7 +263,7 @@ let msg severity ?loc ?(tags=[]) ?(category=Category.Unknown) fmt = Tracing.mygprintf () fmt let msg_noloc severity ?(tags=[]) ?(category=Category.Unknown) fmt = - if !GU.should_warn && Severity.should_warn severity && (Category.should_warn category || Tags.should_warn tags) then ( + if !AnalysisState.should_warn && Severity.should_warn severity && (Category.should_warn category || Tags.should_warn tags) then ( let finish doc = let text = Pretty.sprint ~width:max_int doc in add {tags = Category category :: tags; severity; multipiece = Single {loc = None; text; context = msg_context ()}} @@ -274,7 +274,7 @@ let msg_noloc severity ?(tags=[]) ?(category=Category.Unknown) fmt = Tracing.mygprintf () fmt let msg_group severity ?(tags=[]) ?(category=Category.Unknown) fmt = - if !GU.should_warn && Severity.should_warn severity && (Category.should_warn category || Tags.should_warn tags) then ( + if !AnalysisState.should_warn && Severity.should_warn severity && (Category.should_warn category || Tags.should_warn tags) then ( let finish doc msgs = let group_text = Pretty.sprint ~width:max_int doc in let piece_of_msg (doc, loc) = diff --git a/src/util/server.ml b/src/util/server.ml index ba58fbd032..ace218ad06 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -302,7 +302,7 @@ let () = let process { reset } serve = try analyze serve ~reset; - {status = if !Goblintutil.verified = Some false then VerifyError else Success} + {status = if !AnalysisState.verified = Some false then VerifyError else Success} with | Sys.Break -> {status = Aborted} diff --git a/src/witness/witness.ml b/src/witness/witness.ml index c7fd174fb5..6d47c0ed1f 100644 --- a/src/witness/witness.ml +++ b/src/witness/witness.ml @@ -437,7 +437,7 @@ struct let next _ = [] end in - if not !Goblintutil.svcomp_may_overflow then + if not !AnalysisState.svcomp_may_overflow then let module TaskResult = struct module Arg = Arg @@ -475,7 +475,7 @@ struct ) let write entrystates = - match !Goblintutil.verified with + match !AnalysisState.verified with | Some false -> print_svcomp_result "ERROR (verify)" | _ -> if get_string "witness.yaml.validate" <> "" then ( From 53272230001a39eea2a8ee702e409ced13340ace Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 19:28:55 +0300 Subject: [PATCH 182/518] Extract SolverStats --- src/maingoblint.ml | 6 ++---- src/solvers/generic.ml | 8 ++++---- src/solvers/sLR.ml | 6 +++--- src/solvers/solverStats.ml | 12 ++++++++++++ src/solvers/td3.ml | 4 ++-- src/solvers/topDown_space_cache_term.ml | 2 +- src/util/goblintutil.ml | 5 ----- 7 files changed, 24 insertions(+), 19 deletions(-) create mode 100644 src/solvers/solverStats.ml diff --git a/src/maingoblint.ml b/src/maingoblint.ml index dd9246651b..b0a7d35654 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -494,7 +494,7 @@ let preprocess_parse_merge () = let do_stats () = if get_bool "dbg.timing.enabled" then ( print_newline (); - ignore (Pretty.printf "vars = %d evals = %d narrow_reuses = %d\n" !Goblintutil.vars !Goblintutil.evals !Goblintutil.narrow_reuses); + SolverStats.print (); print_newline (); print_string "Timings:\n"; Timing.Default.print (Stdlib.Format.formatter_of_out_channel @@ Messages.get_out "timing" Legacy.stderr); @@ -502,9 +502,7 @@ let do_stats () = ) let reset_stats () = - Goblintutil.vars := 0; - Goblintutil.evals := 0; - Goblintutil.narrow_reuses := 0; + SolverStats.reset (); Timing.Default.reset (); Timing.Program.reset () diff --git a/src/solvers/generic.ml b/src/solvers/generic.ml index 2b811a426d..b1ec796264 100644 --- a/src/solvers/generic.ml +++ b/src/solvers/generic.ml @@ -62,7 +62,7 @@ struct let stop_event () = () let new_var_event x = - incr Goblintutil.vars; + incr SolverStats.vars; if tracing then trace "sol" "New %a\n" Var.pretty_trace x let get_var_event x = @@ -70,7 +70,7 @@ struct let eval_rhs_event x = if full_trace then trace "sol" "(Re-)evaluating %a\n" Var.pretty_trace x; - incr Goblintutil.evals; + incr SolverStats.evals; if (get_bool "dbg.solver-progress") then (incr stack_d; print_int !stack_d; flush stdout) let update_var_event x o n = @@ -114,7 +114,7 @@ struct print_newline (); (* print_endline "# Generic solver stats"; *) Printf.printf "runtime: %s\n" (GobSys.string_of_time ()); - Printf.printf "vars: %d, evals: %d\n" !Goblintutil.vars !Goblintutil.evals; + Printf.printf "vars: %d, evals: %d\n" !SolverStats.vars !SolverStats.evals; Option.may (fun v -> ignore @@ Pretty.printf "max updates: %d for var %a\n" !max_c Var.pretty_trace v) !max_var; print_newline (); (* print_endline "# Solver specific stats"; *) @@ -124,7 +124,7 @@ struct (* Gc.print_stat stdout; (* too verbose, slow and words instead of MB *) *) let gc = GobGc.print_quick_stat Legacy.stdout in print_newline (); - Option.may (write_csv [GobSys.string_of_time (); string_of_int !Goblintutil.vars; string_of_int !Goblintutil.evals; string_of_int !ncontexts; string_of_int gc.Gc.top_heap_words]) stats_csv; + Option.may (write_csv [GobSys.string_of_time (); string_of_int !SolverStats.vars; string_of_int !SolverStats.evals; string_of_int !ncontexts; string_of_int gc.Gc.top_heap_words]) stats_csv; (* print_string "Do you want to continue? [Y/n]"; *) flush stdout (* if read_line () = "n" then raise Break *) diff --git a/src/solvers/sLR.ml b/src/solvers/sLR.ml index 7d5c4f5090..5a2371abbb 100644 --- a/src/solvers/sLR.ml +++ b/src/solvers/sLR.ml @@ -204,7 +204,7 @@ module Make0 = try HM.find keys x with Not_found -> - incr Goblintutil.vars; + incr SolverStats.vars; decr last_key; HM.add keys x !last_key; !last_key @@ -212,7 +212,7 @@ module Make0 = let get_index c = try (HM.find keys c, true) with Not_found -> - incr Goblintutil.vars; + incr SolverStats.vars; decr last_key; HM.add keys c !last_key; (!last_key, false) @@ -391,7 +391,7 @@ module Make0 = and solve x = if not (P.has_item stable x) then begin - incr Goblintutil.evals; + incr SolverStats.evals; let _ = P.insert stable x in let old = X.get_value x in diff --git a/src/solvers/solverStats.ml b/src/solvers/solverStats.ml new file mode 100644 index 0000000000..4f8cc3b22b --- /dev/null +++ b/src/solvers/solverStats.ml @@ -0,0 +1,12 @@ + +let vars = ref 0 +let evals = ref 0 +let narrow_reuses = ref 0 + +let print () = + ignore (GoblintCil.Pretty.printf "vars = %d evals = %d narrow_reuses = %d\n" !vars !evals !narrow_reuses) + +let reset () = + vars := 0; + evals := 0; + narrow_reuses := 0 diff --git a/src/solvers/td3.ml b/src/solvers/td3.ml index ea5bbfb7ed..36f43693af 100644 --- a/src/solvers/td3.ml +++ b/src/solvers/td3.ml @@ -300,7 +300,7 @@ module Base = | Some d when narrow_reuse -> (* Do not reset deps for reuse of eq *) if tracing then trace "sol2" "eq reused %a\n" S.Var.pretty_trace x; - incr Goblintutil.narrow_reuses; + incr SolverStats.narrow_reuses; d | _ -> (* The RHS is re-evaluated, all deps are re-trigerred *) @@ -837,7 +837,7 @@ module Base = HM.filteri_inplace (fun x _ -> HM.mem visited x) rho in Timing.wrap "restore" restore (); - if GobConfig.get_bool "dbg.verbose" then ignore @@ Pretty.printf "Solved %d vars. Total of %d vars after restore.\n" !Goblintutil.vars (HM.length rho); + if GobConfig.get_bool "dbg.verbose" then ignore @@ Pretty.printf "Solved %d vars. Total of %d vars after restore.\n" !SolverStats.vars (HM.length rho); let avg xs = if List.is_empty !cache_sizes then 0.0 else float_of_int (BatList.sum xs) /. float_of_int (List.length xs) in if tracing && cache then trace "cache" "#caches: %d, max: %d, avg: %.2f\n" (List.length !cache_sizes) (List.max !cache_sizes) (avg !cache_sizes); ); diff --git a/src/solvers/topDown_space_cache_term.ml b/src/solvers/topDown_space_cache_term.ml index 42ba33b4fb..0074401989 100644 --- a/src/solvers/topDown_space_cache_term.ml +++ b/src/solvers/topDown_space_cache_term.ml @@ -182,7 +182,7 @@ module WP = List.iter get vs in Timing.wrap "restore" restore (); - if (GobConfig.get_bool "dbg.verbose") then ignore @@ Pretty.printf "Solved %d vars. Total of %d vars after restore.\n" !Goblintutil.vars (HM.length rho); + if (GobConfig.get_bool "dbg.verbose") then ignore @@ Pretty.printf "Solved %d vars. Total of %d vars after restore.\n" !SolverStats.vars (HM.length rho); ); let avg xs = float_of_int (BatList.sum xs) /. float_of_int (List.length xs) in if tracing then trace "cache" "#caches: %d, max: %d, avg: %.2f\n" (List.length !cache_sizes) (List.max !cache_sizes) (avg !cache_sizes); diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index 46753c1166..f7d1f4e435 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -38,11 +38,6 @@ let is_blessed (t:typ): varinfo option = let earlyglobs = ref false -let vars = ref 0 -let evals = ref 0 -let narrow_reuses = ref 0 - - let dummy_obj = Obj.repr () let jobs () = From 2fe8d2f3d2b7c0b455bda95f2764d7e72580140a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 19:41:53 +0300 Subject: [PATCH 183/518] Move earlyglobs and jobs to GobConfig --- src/analyses/base.ml | 14 +++++++------- src/analyses/basePriv.ml | 18 +++++++++--------- src/analyses/commonPriv.ml | 2 +- src/framework/control.ml | 2 +- src/maingoblint.ml | 2 +- src/util/gobConfig.ml | 9 +++++++++ src/util/goblintutil.ml | 9 --------- 7 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 19250d1d6a..6cd78cef14 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -435,8 +435,8 @@ struct | _ -> ThreadFlag.is_multi (Analyses.ask_of_ctx ctx) in - if M.tracing then M.tracel "sync" "sync multi=%B earlyglobs=%B\n" multi !GU.earlyglobs; - if !GU.earlyglobs || multi then + if M.tracing then M.tracel "sync" "sync multi=%B earlyglobs=%B\n" multi !earlyglobs; + if !earlyglobs || multi then WideningTokens.with_local_side_tokens (fun () -> Priv.sync (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) (priv_sideg ctx.sideg) ctx.local reason ) @@ -449,7 +449,7 @@ struct ignore (sync' reason ctx) let get_var (a: Q.ask) (gs: glob_fun) (st: store) (x: varinfo): value = - if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then + if (!earlyglobs || ThreadFlag.is_multi a) && is_global a x then Priv.read_global a (priv_getg gs) st x else begin if M.tracing then M.tracec "get" "Singlethreaded mode.\n"; @@ -613,7 +613,7 @@ struct st |> (* Here earlyglobs only drops syntactic globals from the context and does not consider e.g. escaped globals. *) (* This is equivalent to having escaped globals excluded from earlyglobs for contexts *) - f (not !GU.earlyglobs) (CPA.filter (fun k v -> (not k.vglob) || is_excluded_from_earlyglobs k)) + f (not !earlyglobs) (CPA.filter (fun k v -> (not k.vglob) || is_excluded_from_earlyglobs k)) %> f (ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.base.context.non-ptr" ~removeAttr:"base.no-non-ptr" ~keepAttr:"base.non-ptr" fd) drop_non_ptrs %> f (ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.base.context.int" ~removeAttr:"base.no-int" ~keepAttr:"base.int" fd) drop_ints %> f (ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.base.context.interval" ~removeAttr:"base.no-interval" ~keepAttr:"base.interval" fd) drop_interval @@ -1203,7 +1203,7 @@ struct in if CilLval.Set.is_top context.Invariant.lvals then ( - if !GU.earlyglobs || ThreadFlag.is_multi ask then ( + if !earlyglobs || ThreadFlag.is_multi ask then ( let cpa_invariant = CPA.fold (fun k v a -> if not (is_global ask k) then @@ -1471,7 +1471,7 @@ struct end else (* Check if we need to side-effect this one. We no longer generate * side-effects here, but the code still distinguishes these cases. *) - if (!GU.earlyglobs || ThreadFlag.is_multi a) && is_global a x then begin + if (!earlyglobs || ThreadFlag.is_multi a) && is_global a x then begin if M.tracing then M.tracel "set" ~var:x.vname "update_one_addr: update a global var '%s' ...\n" x.vname; let priv_getg = priv_getg gs in (* Optimization to avoid evaluating integer values when setting them. @@ -1922,7 +1922,7 @@ struct ) else (* use is_global to account for values that became globals because they were saved into global variables *) let globals = CPA.filter (fun k v -> is_global (Analyses.ask_of_ctx ctx) k) st.cpa in - (* let new_cpa = if !GU.earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *) + (* let new_cpa = if !earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *) let new_cpa = globals in {st with cpa = new_cpa} in diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index bab6653e2c..14bcce793c 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -56,7 +56,7 @@ end let old_threadenter (type d) ask (st: d BaseDomain.basecomponents_t) = (* Copy-paste from Base make_entry *) let globals = CPA.filter (fun k v -> is_global ask k) st.cpa in - (* let new_cpa = if !GU.earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *) + (* let new_cpa = if !earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *) let new_cpa = globals in {st with cpa = new_cpa} @@ -581,7 +581,7 @@ struct let threadenter ask (st: BaseComponents (D).t): BaseComponents (D).t = (* Copy-paste from Base make_entry *) let globals = CPA.filter (fun k v -> is_global ask k) st.cpa in - (* let new_cpa = if !GU.earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *) + (* let new_cpa = if !earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *) let new_cpa = globals in let _,lmust,l = st.priv in {st with cpa = new_cpa; priv = (W.bot (),lmust,l)} @@ -666,7 +666,7 @@ struct let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = if not invariant then ( sideg (V.unprotected x) v; - if !GU.earlyglobs then (* earlyglobs workaround for 13/60 *) + if !earlyglobs then (* earlyglobs workaround for 13/60 *) sideg (V.protected x) v (* Unlock after invariant will still side effect refined value (if protected) from CPA, because cannot distinguish from non-invariant write since W is implicit. *) ); @@ -918,7 +918,7 @@ struct let s = current_lockset ask in let t = current_thread ask in let cpa' = CPA.add x v st.cpa in - if not invariant && not (!GU.earlyglobs && is_excluded_from_earlyglobs x) then + if not invariant && not (!earlyglobs && is_excluded_from_earlyglobs x) then sideg (V.global x) (G.create_weak (GWeak.singleton s (ThreadMap.singleton t v))); (* Unlock after invariant will not side effect refined value from weak, because it's not side effected there. *) {st with cpa = cpa'} @@ -976,7 +976,7 @@ struct let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = let s = current_lockset ask in let cpa' = CPA.add x v st.cpa in - if not invariant && not (!GU.earlyglobs && is_excluded_from_earlyglobs x) then + if not invariant && not (!earlyglobs && is_excluded_from_earlyglobs x) then sideg (V.global x) (G.create_weak (GWeak.singleton s v)); (* Unlock after invariant will not side effect refined value from weak, because it's not side effected there. *) {st with cpa = cpa'} @@ -1047,7 +1047,7 @@ struct let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = let s = current_lockset ask in let cpa' = CPA.add x v st.cpa in - if not invariant && not (!GU.earlyglobs && is_excluded_from_earlyglobs x) then + if not invariant && not (!earlyglobs && is_excluded_from_earlyglobs x) then sideg (V.global x) (G.create_weak (GWeak.singleton s v)); let w' = if not invariant then W.add x st.priv @@ -1193,7 +1193,7 @@ struct ) l vv in let cpa' = CPA.add x v st.cpa in - if not invariant && not (!GU.earlyglobs && is_excluded_from_earlyglobs x) then ( + if not invariant && not (!earlyglobs && is_excluded_from_earlyglobs x) then ( let v = distr_init getg x v in sideg (V.global x) (G.create_weak (GWeak.singleton s v)) (* Unlock after invariant will still side effect refined value from CPA, because cannot distinguish from non-invariant write. *) @@ -1354,7 +1354,7 @@ struct let p' = P.add x (MinLocksets.singleton s) p in let p' = P.map (fun s' -> MinLocksets.add s s') p' in let cpa' = CPA.add x v st.cpa in - if not invariant && not (!GU.earlyglobs && is_excluded_from_earlyglobs x) then ( + if not invariant && not (!earlyglobs && is_excluded_from_earlyglobs x) then ( let v = distr_init getg x v in sideg (V.global x) (G.create_weak (GWeak.singleton s (GWeakW.singleton s v))) ); @@ -1520,7 +1520,7 @@ struct ) l vv in let cpa' = CPA.add x v st.cpa in - if not invariant && not (!GU.earlyglobs && is_excluded_from_earlyglobs x) then ( + if not invariant && not (!earlyglobs && is_excluded_from_earlyglobs x) then ( let v = distr_init getg x v in sideg (V.global x) (G.create_weak (GWeak.singleton s (GWeakW.singleton s v))) ); diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 03634b150c..5cd221d022 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -41,7 +41,7 @@ module Protection = struct let is_unprotected ask x: bool = let multi = ThreadFlag.is_multi ask in - (!GU.earlyglobs && not multi && not (is_excluded_from_earlyglobs x)) || + (!GobConfig.earlyglobs && not multi && not (is_excluded_from_earlyglobs x)) || ( multi && ask.f (Q.MayBePublic {global=x; write=true}) diff --git a/src/framework/control.ml b/src/framework/control.ml index ce3326275d..2b01654289 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -333,7 +333,7 @@ struct Witness.init (module FileCfg); (* TODO: move this out of analyze_loop *) AnalysisState.global_initialization := true; - GU.earlyglobs := get_bool "exp.earlyglobs"; + GobConfig.earlyglobs := get_bool "exp.earlyglobs"; let marshal: Spec.marshal option = if get_string "load_run" <> "" then Some (Serialize.unmarshal Fpath.(v (get_string "load_run") / "spec_marshal")) diff --git a/src/maingoblint.ml b/src/maingoblint.ml index b0a7d35654..71bb0f16f9 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -410,7 +410,7 @@ let preprocess_files () = | process_status -> raise (FrontendError (Format.sprintf "preprocessor %s: %s" (GobUnix.string_of_process_status process_status) task.command)) in - Timing.wrap "preprocess" (ProcessPool.run ~jobs:(Goblintutil.jobs ()) ~terminated) preprocess_tasks + Timing.wrap "preprocess" (ProcessPool.run ~jobs:(GobConfig.jobs ()) ~terminated) preprocess_tasks ); preprocessed diff --git a/src/util/gobConfig.ml b/src/util/gobConfig.ml index a596468eec..3cab128b29 100644 --- a/src/util/gobConfig.ml +++ b/src/util/gobConfig.ml @@ -407,3 +407,12 @@ end include Impl let () = set_conf Options.defaults + + +(** Another hack to see if earlyglobs is enabled *) +let earlyglobs = ref false + +let jobs () = + match get_int "jobs" with + | 0 -> Cpu.numcores () + | n -> n diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index f7d1f4e435..c895f95bd0 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -34,13 +34,4 @@ let is_blessed (t:typ): varinfo option = | _ -> (None : varinfo option) -(** Another hack to see if earlyglobs is enabled *) -let earlyglobs = ref false - - let dummy_obj = Obj.repr () - -let jobs () = - match get_int "jobs" with - | 0 -> Cpu.numcores () - | n -> n From 00ff886f878e8f33a4e1353f1b102c8534111647 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 19:44:39 +0300 Subject: [PATCH 184/518] Extract UniqueType --- src/analyses/base.ml | 8 ++++---- src/analyses/region.ml | 2 +- src/cdomains/regionDomain.ml | 6 +++--- src/util/goblintutil.ml | 15 --------------- src/util/uniqueType.ml | 16 ++++++++++++++++ 5 files changed, 24 insertions(+), 23 deletions(-) create mode 100644 src/util/uniqueType.ml diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 6cd78cef14..2791aeeeb8 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -765,7 +765,7 @@ struct if M.tracing then M.traceli "evalint" "base eval_rv_base %a\n" d_exp exp; let rec do_offs def = function (* for types that only have one value *) | Field (fd, offs) -> begin - match Goblintutil.is_blessed (TComp (fd.fcomp, [])) with + match UniqueType.find (TComp (fd.fcomp, [])) with | Some v -> do_offs (`Address (AD.singleton (Addr.from_var_offset (v,convert_offset a gs st (Field (fd, offs)))))) offs | None -> do_offs def offs end @@ -1073,7 +1073,7 @@ struct let eval_rv = eval_rv_back_up in let rec do_offs def = function | Field (fd, offs) -> begin - match Goblintutil.is_blessed (TComp (fd.fcomp, [])) with + match UniqueType.find (TComp (fd.fcomp, [])) with | Some v -> do_offs (AD.singleton (Addr.from_var_offset (v,convert_offset a gs st (Field (fd, offs))))) offs | None -> do_offs def offs end @@ -1081,8 +1081,8 @@ struct | NoOffset -> def in match lval with - | Var x, NoOffset when (not x.vglob) && Goblintutil.is_blessed x.vtype<> None -> - begin match Goblintutil.is_blessed x.vtype with + | Var x, NoOffset when (not x.vglob) && UniqueType.find x.vtype<> None -> + begin match UniqueType.find x.vtype with | Some v -> AD.singleton (Addr.from_var v) | _ -> AD.singleton (Addr.from_var_offset (x, convert_offset a gs st NoOffset)) end diff --git a/src/analyses/region.ml b/src/analyses/region.ml index 4109fa6e2c..b15ac9f56d 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -175,7 +175,7 @@ struct let t, _, _, _ = splitFunctionTypeVI f in match unrollType t with | TPtr (t,_) -> - begin match Goblintutil.is_blessed t, lval with + begin match UniqueType.find t, lval with | Some rv, Some lv -> assign ctx lv (AddrOf (Var rv, NoOffset)) | _ -> ctx.local end diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index 0507f46a4e..51581c4ea0 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -143,7 +143,7 @@ struct let offsornot offs = if (get_bool "exp.region-offsets") then F.listify offs else [] in let rec do_offs deref def = function | Field (fd, offs) -> begin - match Goblintutil.is_blessed (TComp (fd.fcomp, [])) with + match UniqueType.find (TComp (fd.fcomp, [])) with | Some v -> do_offs deref (Some (deref, (v, offsornot (Field (fd, offs))), [])) offs | None -> do_offs deref def offs end @@ -166,8 +166,8 @@ struct | _ -> None and eval_lval deref lval = match lval with - | (Var x, NoOffset) when Goblintutil.is_blessed x.vtype <> None -> - begin match Goblintutil.is_blessed x.vtype with + | (Var x, NoOffset) when UniqueType.find x.vtype <> None -> + begin match UniqueType.find x.vtype with | Some v -> Some (deref, (v,[]), []) | _ when x.vglob -> Some (deref, (x, []), []) | _ -> None diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index c895f95bd0..409587a620 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -18,20 +18,5 @@ let create_var (var: varinfo) = let hash = if hash < start_id then hash + start_id else hash in { var with vid = hash } -(* Type invariant variables. *) -let type_inv_tbl = Hashtbl.create 13 -let type_inv (c:compinfo) : varinfo = - try Hashtbl.find type_inv_tbl c.ckey - with Not_found -> - let i = create_var (makeGlobalVar ("{struct "^c.cname^"}") (TComp (c,[]))) in - Hashtbl.add type_inv_tbl c.ckey i; - i - -let is_blessed (t:typ): varinfo option = - let me_gusta x = List.mem x (get_string_list "exp.unique") in - match unrollType t with - | TComp (ci,_) when me_gusta ci.cname -> Some (type_inv ci) - | _ -> (None : varinfo option) - let dummy_obj = Obj.repr () diff --git a/src/util/uniqueType.ml b/src/util/uniqueType.ml new file mode 100644 index 0000000000..5c3a9e4584 --- /dev/null +++ b/src/util/uniqueType.ml @@ -0,0 +1,16 @@ +open GoblintCil + +(* Type invariant variables. *) +let type_inv_tbl = Hashtbl.create 13 +let type_inv (c:compinfo) : varinfo = + try Hashtbl.find type_inv_tbl c.ckey + with Not_found -> + let i = Goblintutil.create_var (makeGlobalVar ("{struct "^c.cname^"}") (TComp (c,[]))) in + Hashtbl.add type_inv_tbl c.ckey i; + i + +let find (t:typ): varinfo option = + let me_gusta x = List.mem x (GobConfig.get_string_list "exp.unique") in + match unrollType t with + | TComp (ci,_) when me_gusta ci.cname -> Some (type_inv ci) + | _ -> (None : varinfo option) From a37268702954d632c501f30d5bf68a5d6c3a74c0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 19:46:46 +0300 Subject: [PATCH 185/518] Move out to Messages --- src/framework/analyses.ml | 2 +- src/framework/control.ml | 2 +- src/maingoblint.ml | 6 +++--- src/util/goblintutil.ml | 6 ------ src/util/messages.ml | 2 ++ 5 files changed, 7 insertions(+), 11 deletions(-) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 8efe28c035..5bcc31a66b 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -225,7 +225,7 @@ struct List.iter (one_w f) !Messages.Table.messages_list let output table gtable gtfxml (file: file) = - let out = Messages.get_out result_name !GU.out in + let out = Messages.get_out result_name !Messages.out in match get_string "result" with | "pretty" -> ignore (fprintf out "%a\n" pretty (Lazy.force table)) | "fast_xml" -> diff --git a/src/framework/control.ml b/src/framework/control.ml index 2b01654289..78486a21fe 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -321,7 +321,7 @@ struct in let print_globals glob = - let out = M.get_out (Spec.name ()) !GU.out in + let out = M.get_out (Spec.name ()) !M.out in let print_one v st = ignore (Pretty.fprintf out "%a -> %a\n" EQSys.GVar.pretty_trace v EQSys.G.pretty st) in diff --git a/src/maingoblint.ml b/src/maingoblint.ml index 71bb0f16f9..782a7a281a 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -510,9 +510,9 @@ let reset_stats () = let do_analyze change_info merged_AST = (* direct the output to file if requested *) if not (get_bool "g2html" || get_string "outfile" = "") then ( - if !Goblintutil.out <> Legacy.stdout then - Legacy.close_out !Goblintutil.out; - Goblintutil.out := Legacy.open_out (get_string "outfile")); + if !Messages.out <> Legacy.stdout then + Legacy.close_out !Messages.out; + Messages.out := Legacy.open_out (get_string "outfile")); let module L = Printable.Liszt (CilType.Fundec) in if get_bool "justcil" then diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml index 409587a620..cf7a545b9e 100644 --- a/src/util/goblintutil.ml +++ b/src/util/goblintutil.ml @@ -4,12 +4,6 @@ open GoblintCil open GobConfig -(** Outputs information about what the goblin is doing *) -(* let verbose = ref false *) - -(** The file where everything is output *) -let out = ref stdout - (** Command for assigning an id to a varinfo. All varinfos directly created by Goblint should be modified by this method *) let create_var (var: varinfo) = (* TODO Hack: this offset should preempt conflicts with ids generated by CIL *) diff --git a/src/util/messages.ml b/src/util/messages.ml index a497377466..f17ee598db 100644 --- a/src/util/messages.ml +++ b/src/util/messages.ml @@ -172,6 +172,8 @@ let () = AfterConfig.register (fun () -> let xml_file_name = ref "" +(** The file where everything is output *) +let out = ref stdout let get_out name alternative = match get_string "dbg.dump" with | "" -> alternative From 54920d4fb5f9650ffdb81cbdac5fb67850bc2147 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 19:52:44 +0300 Subject: [PATCH 186/518] Move create_var to Cilfacade --- src/analyses/apron/relationAnalysis.apron.ml | 6 +++--- src/analyses/base.ml | 5 ++--- src/analyses/extractPthread.ml | 2 +- src/analyses/fileUse.ml | 4 ++-- src/analyses/libraryFunctions.ml | 8 ++++---- src/analyses/malloc_null.ml | 2 +- src/analyses/spec.ml | 4 ++-- src/analyses/termination.ml | 4 ++-- src/analyses/threadFlag.ml | 1 - src/cdomains/intDomain.ml | 1 - src/cdomains/lvalMapDomain.ml | 6 +++--- src/cdomains/symbLocksDomain.ml | 2 +- src/cdomains/valueDomain.ml | 1 - src/framework/analyses.ml | 1 - src/framework/cfgTools.ml | 2 +- src/goblint.ml | 1 - src/maingoblint.ml | 1 - src/util/cilfacade.ml | 9 +++++++++ src/util/goblintutil.ml | 16 ---------------- src/util/messages.ml | 1 - src/util/richVarinfo.ml | 2 +- src/util/uniqueType.ml | 2 +- src/witness/z3/violationZ3.z3.ml | 4 ++-- 23 files changed, 35 insertions(+), 50 deletions(-) delete mode 100644 src/util/goblintutil.ml diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 44b7eb4fd8..3c54a8ca7f 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -66,7 +66,7 @@ struct if VH.mem v_ins v then VH.find v_ins v else - let v_in = Goblintutil.create_var @@ makeVarinfo false (v.vname ^ "#in") v.vtype in (* temporary local g#in for global g *) + let v_in = Cilfacade.create_var @@ makeVarinfo false (v.vname ^ "#in") v.vtype in (* temporary local g#in for global g *) VH.replace v_ins v v_in; v_in in @@ -87,7 +87,7 @@ struct let read_globals_to_locals_inv (ask: Queries.ask) getg st vs = let v_ins_inv = VH.create (List.length vs) in List.iter (fun v -> - let v_in = Goblintutil.create_var @@ makeVarinfo false (v.vname ^ "#in") v.vtype in (* temporary local g#in for global g *) + let v_in = Cilfacade.create_var @@ makeVarinfo false (v.vname ^ "#in") v.vtype in (* temporary local g#in for global g *) VH.replace v_ins_inv v_in v; ) vs; let rel = RD.add_vars st.rel (List.map RV.local (VH.keys v_ins_inv |> List.of_enum)) in (* add temporary g#in-s *) @@ -139,7 +139,7 @@ struct {st with rel = f st v} ) else ( - let v_out = Goblintutil.create_var @@ makeVarinfo false (v.vname ^ "#out") v.vtype in (* temporary local g#out for global g *) + let v_out = Cilfacade.create_var @@ makeVarinfo false (v.vname ^ "#out") v.vtype in (* temporary local g#out for global g *) v_out.vattr <- v.vattr; (*copy the attributes because the tracking may depend on them. Otherwise an assertion fails *) let st = {st with rel = RD.add_vars st.rel [RV.local v_out]} in (* add temporary g#out *) let st' = {st with rel = f st v_out} in (* g#out = e; *) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 2791aeeeb8..088158d63b 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -10,7 +10,6 @@ module A = Analyses module H = Hashtbl module Q = Queries -module GU = Goblintutil module ID = ValueDomain.ID module FD = ValueDomain.FD module IdxDom = ValueDomain.IndexDomain @@ -165,8 +164,8 @@ struct | Some marshal -> array_map := marshal | None -> () end; - return_varstore := Goblintutil.create_var @@ makeVarinfo false "RETURN" voidType; - longjmp_return := Goblintutil.create_var @@ makeVarinfo false "LONGJMP_RETURN" intType; + return_varstore := Cilfacade.create_var @@ makeVarinfo false "RETURN" voidType; + longjmp_return := Cilfacade.create_var @@ makeVarinfo false "LONGJMP_RETURN" intType; Priv.init () let finalize () = diff --git a/src/analyses/extractPthread.ml b/src/analyses/extractPthread.ml index 57cf616a7b..c920fe4808 100644 --- a/src/analyses/extractPthread.ml +++ b/src/analyses/extractPthread.ml @@ -876,7 +876,7 @@ module Spec : Analyses.MCPSpec = struct module G = Tasks let tasks_var = - Goblintutil.create_var (makeGlobalVar "__GOBLINT_PTHREAD_TASKS" voidPtrType) + Cilfacade.create_var (makeGlobalVar "__GOBLINT_PTHREAD_TASKS" voidPtrType) module ExprEval = struct diff --git a/src/analyses/fileUse.ml b/src/analyses/fileUse.ml index 9e3a2a2540..5fc799c5f9 100644 --- a/src/analyses/fileUse.ml +++ b/src/analyses/fileUse.ml @@ -13,8 +13,8 @@ struct module C = FileDomain.Dom (* special variables *) - let return_var = Goblintutil.create_var @@ Cil.makeVarinfo false "@return" Cil.voidType, `NoOffset - let unclosed_var = Goblintutil.create_var @@ Cil.makeVarinfo false "@unclosed" Cil.voidType, `NoOffset + let return_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@return" Cil.voidType, `NoOffset + let unclosed_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@unclosed" Cil.voidType, `NoOffset (* keys that were already warned about; needed for multiple returns (i.e. can't be kept in D) *) let warned_unclosed = ref Set.empty diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 814de845b2..e9747f4d7b 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -255,8 +255,8 @@ let linux_userspace_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("ptrace", unknown (drop "request" [] :: VarArgs (drop' [r_deep; w_deep]))); (* man page has 4 arguments, but header has varargs and real-world programs may call with <4 *) ] -let big_kernel_lock = AddrOf (Cil.var (Goblintutil.create_var (makeGlobalVar "[big kernel lock]" intType))) -let console_sem = AddrOf (Cil.var (Goblintutil.create_var (makeGlobalVar "[console semaphore]" intType))) +let big_kernel_lock = AddrOf (Cil.var (Cilfacade.create_var (makeGlobalVar "[big kernel lock]" intType))) +let console_sem = AddrOf (Cil.var (Cilfacade.create_var (makeGlobalVar "[console semaphore]" intType))) (** Linux kernel functions. *) let linux_kernel_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ @@ -391,8 +391,8 @@ let math_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__fpclassifyl", unknown [drop "x" []]); ] -let verifier_atomic_var = Goblintutil.create_var (makeGlobalVar "[__VERIFIER_atomic]" intType) -let verifier_atomic = AddrOf (Cil.var (Goblintutil.create_var verifier_atomic_var)) +let verifier_atomic_var = Cilfacade.create_var (makeGlobalVar "[__VERIFIER_atomic]" intType) +let verifier_atomic = AddrOf (Cil.var (Cilfacade.create_var verifier_atomic_var)) (** SV-COMP functions. Just the ones that require special handling and cannot be stubbed. *) diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index 7f80a03094..288fd3dfbe 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -237,7 +237,7 @@ struct let exitstate v = D.empty () let init marshal = - return_addr_ := Addr.from_var (Goblintutil.create_var @@ makeVarinfo false "RETURN" voidType) + return_addr_ := Addr.from_var (Cilfacade.create_var @@ makeVarinfo false "RETURN" voidType) end let _ = diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml index 7ceebbea67..010d20ee7b 100644 --- a/src/analyses/spec.ml +++ b/src/analyses/spec.ml @@ -15,8 +15,8 @@ struct module C = SpecDomain.Dom (* special variables *) - let return_var = Goblintutil.create_var @@ Cil.makeVarinfo false "@return" Cil.voidType, `NoOffset - let global_var = Goblintutil.create_var @@ Cil.makeVarinfo false "@global" Cil.voidType, `NoOffset + let return_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@return" Cil.voidType, `NoOffset + let global_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@global" Cil.voidType, `NoOffset (* spec data *) let nodes = ref [] diff --git a/src/analyses/termination.ml b/src/analyses/termination.ml index d448844596..51826773e5 100644 --- a/src/analyses/termination.ml +++ b/src/analyses/termination.ml @@ -23,7 +23,7 @@ class loopCounterVisitor (fd : fundec) = object(self) (* insert loop counter variable *) let name = "term"^show_location_id loc in let typ = intType in (* TODO the type should be the same as the one of the original loop counter *) - let v = Goblintutil.create_var (makeLocalVar fd name ~init:(SingleInit zero) typ) in + let v = Cilfacade.create_var (makeLocalVar fd name ~init:(SingleInit zero) typ) in (* make an init stmt since the init above is apparently ignored *) let init_stmt = mkStmtOneInstr @@ Set (var v, zero, loc, eloc) in (* increment it every iteration *) @@ -91,7 +91,7 @@ let makeVar fd loc name = try List.find (fun v -> v.vname = id) fd.slocals with Not_found -> let typ = intType in (* TODO the type should be the same as the one of the original loop counter *) - Goblintutil.create_var (makeLocalVar fd id ~init:(SingleInit zero) typ) + Cilfacade.create_var (makeLocalVar fd id ~init:(SingleInit zero) typ) let f_assume = Lval (var (emptyFunction "__goblint_assume").svar) let f_check = Lval (var (emptyFunction "__goblint_check").svar) class loopInstrVisitor (fd : fundec) = object(self) diff --git a/src/analyses/threadFlag.ml b/src/analyses/threadFlag.ml index 2975d6b6cb..fb4467f61e 100644 --- a/src/analyses/threadFlag.ml +++ b/src/analyses/threadFlag.ml @@ -1,6 +1,5 @@ (** Multi-threadedness analysis. *) -module GU = Goblintutil module LF = LibraryFunctions open GoblintCil diff --git a/src/cdomains/intDomain.ml b/src/cdomains/intDomain.ml index 98dd0acc03..4f80dae758 100644 --- a/src/cdomains/intDomain.ml +++ b/src/cdomains/intDomain.ml @@ -3,7 +3,6 @@ open GoblintCil open Pretty open PrecisionUtil -module GU = Goblintutil module M = Messages module BI = IntOps.BigIntOps diff --git a/src/cdomains/lvalMapDomain.ml b/src/cdomains/lvalMapDomain.ml index 0ade98e2cb..4506f543f3 100644 --- a/src/cdomains/lvalMapDomain.ml +++ b/src/cdomains/lvalMapDomain.ml @@ -96,7 +96,7 @@ struct let split (x,y) = try Must'.elements x |> Set.of_list, May.elements y |> Set.of_list with SetDomain.Unsupported _ -> Set.empty, Set.empty (* special variable used for indirection *) - let alias_var = Goblintutil.create_var @@ Cil.makeVarinfo false "@alias" Cil.voidType, `NoOffset + let alias_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@alias" Cil.voidType, `NoOffset (* alias structure: x[0].key=alias_var, y[0].key=linked_var *) let is_alias (x,y) = neg Must'.is_empty x && (Must'.choose x).key=alias_var let get_alias (x,y) = (May.choose y).key @@ -217,7 +217,7 @@ struct let add_all m1 m2 = add_list (bindings m2) m1 (* callstack for locations *) - let callstack_var = Goblintutil.create_var @@ Cil.makeVarinfo false "@callstack" Cil.voidType, `NoOffset + let callstack_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@callstack" Cil.voidType, `NoOffset let callstack m = get_record callstack_var m |> Option.map_default V.loc [] let string_of_callstack m = " [call stack: "^String.concat ", " (List.map (CilType.Location.show % Node.location) (callstack m))^"]" let edit_callstack f m = edit_record callstack_var (V.edit_loc f) m @@ -276,7 +276,7 @@ struct | Var v1, o1 -> v1, Lval.CilLval.of_ciloffs o1 | Mem Lval(Var v1, o1), o2 -> v1, Lval.CilLval.of_ciloffs (addOffset o1 o2) (* | Mem exp, o1 -> failwith "not implemented yet" (* TODO use query_lv *) *) - | _ -> Goblintutil.create_var @@ Cil.makeVarinfo false ("?"^sprint d_exp (Lval lval)) Cil.voidType, `NoOffset (* TODO *) + | _ -> Cilfacade.create_var @@ Cil.makeVarinfo false ("?"^sprint d_exp (Lval lval)) Cil.voidType, `NoOffset (* TODO *) let keys_from_lval lval (ask: Queries.ask) = (* use MayPointTo query to get all possible pointees of &lval *) (* print_query_lv ctx.ask (AddrOf lval); *) diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index 696d1655a4..20c5a5a86d 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -112,7 +112,7 @@ struct | Index (i,o) -> isConstant i && conc o | Field (_,o) -> conc o - let star = Lval (Cil.var (Goblintutil.create_var (makeGlobalVar "*" intType))) + let star = Lval (Cil.var (Cilfacade.create_var (makeGlobalVar "*" intType))) let rec one_unknown_array_index exp = let rec separate_fields_index o = diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 11eddd49b2..22b1cce254 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -5,7 +5,6 @@ open PrecisionUtil include PreValueDomain module Offs = Lval.OffsetLat (IndexDomain) module M = Messages -module GU = Goblintutil module BI = IntOps.BigIntOps module VDQ = ValueDomainQueries module LS = VDQ.LS diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 5bcc31a66b..ad0e16f53c 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -5,7 +5,6 @@ open GoblintCil open Pretty open GobConfig -module GU = Goblintutil module M = Messages (** Analysis starts from lists of functions: start functions, exit functions, and diff --git a/src/framework/cfgTools.ml b/src/framework/cfgTools.ml index edc01dc814..ac5f96f63e 100644 --- a/src/framework/cfgTools.ml +++ b/src/framework/cfgTools.ml @@ -122,7 +122,7 @@ let rec pretty_edges () = function let get_pseudo_return_id fd = let start_id = 10_000_000_000 in (* TODO get max_sid? *) - let sid = Hashtbl.hash fd.svar.vid in (* Need pure sid instead of Cil.new_sid for incremental, similar to vid in Goblintutil.create_var. We only add one return stmt per loop, so the hash from the functions vid should be unique. *) + let sid = Hashtbl.hash fd.svar.vid in (* Need pure sid instead of Cil.new_sid for incremental, similar to vid in Cilfacade.create_var. We only add one return stmt per loop, so the hash from the functions vid should be unique. *) if sid < start_id then sid + start_id else sid let node_scc_global = NH.create 113 diff --git a/src/goblint.ml b/src/goblint.ml index cb631d3eb2..2f38d2fc49 100644 --- a/src/goblint.ml +++ b/src/goblint.ml @@ -1,6 +1,5 @@ open Goblint_lib open GobConfig -open Goblintutil open Maingoblint open Printf diff --git a/src/maingoblint.ml b/src/maingoblint.ml index 782a7a281a..e5f2468a4b 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -3,7 +3,6 @@ open Batteries open GobConfig open Printf -open Goblintutil open GoblintCil let writeconffile = ref None diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml index dbb7ceeb02..2a7958badb 100644 --- a/src/util/cilfacade.ml +++ b/src/util/cilfacade.ml @@ -6,6 +6,15 @@ module E = Errormsg include Cilfacade0 +(** Command for assigning an id to a varinfo. All varinfos directly created by Goblint should be modified by this method *) +let create_var (var: varinfo) = + (* TODO Hack: this offset should preempt conflicts with ids generated by CIL *) + let start_id = 10_000_000_000 in + let hash = Hashtbl.hash { var with vid = 0 } in + let hash = if hash < start_id then hash + start_id else hash in + { var with vid = hash } + + (** Is character type (N1570 6.2.5.15)? *) let isCharType t = match Cil.unrollType t with diff --git a/src/util/goblintutil.ml b/src/util/goblintutil.ml deleted file mode 100644 index cf7a545b9e..0000000000 --- a/src/util/goblintutil.ml +++ /dev/null @@ -1,16 +0,0 @@ -(** Globally accessible flags and utility functions. *) - -open GoblintCil -open GobConfig - - -(** Command for assigning an id to a varinfo. All varinfos directly created by Goblint should be modified by this method *) -let create_var (var: varinfo) = - (* TODO Hack: this offset should preempt conflicts with ids generated by CIL *) - let start_id = 10_000_000_000 in - let hash = Hashtbl.hash { var with vid = 0 } in - let hash = if hash < start_id then hash + start_id else hash in - { var with vid = hash } - - -let dummy_obj = Obj.repr () diff --git a/src/util/messages.ml b/src/util/messages.ml index f17ee598db..5139fe503c 100644 --- a/src/util/messages.ml +++ b/src/util/messages.ml @@ -1,7 +1,6 @@ module Pretty = GoblintCil.Pretty open GobConfig -module GU = Goblintutil module Category = MessageCategory diff --git a/src/util/richVarinfo.ml b/src/util/richVarinfo.ml index 2ef76bf8d0..d1918c40a6 100644 --- a/src/util/richVarinfo.ml +++ b/src/util/richVarinfo.ml @@ -1,6 +1,6 @@ open GoblintCil -let create_var name = Goblintutil.create_var @@ makeGlobalVar name voidType +let create_var name = Cilfacade.create_var @@ makeGlobalVar name voidType let single ~name = let vi = lazy (create_var name) in diff --git a/src/util/uniqueType.ml b/src/util/uniqueType.ml index 5c3a9e4584..b8733992e0 100644 --- a/src/util/uniqueType.ml +++ b/src/util/uniqueType.ml @@ -5,7 +5,7 @@ let type_inv_tbl = Hashtbl.create 13 let type_inv (c:compinfo) : varinfo = try Hashtbl.find type_inv_tbl c.ckey with Not_found -> - let i = Goblintutil.create_var (makeGlobalVar ("{struct "^c.cname^"}") (TComp (c,[]))) in + let i = Cilfacade.create_var (makeGlobalVar ("{struct "^c.cname^"}") (TComp (c,[]))) in Hashtbl.add type_inv_tbl c.ckey i; i diff --git a/src/witness/z3/violationZ3.z3.ml b/src/witness/z3/violationZ3.z3.ml index b0085b6044..eb3dc4b06f 100644 --- a/src/witness/z3/violationZ3.z3.ml +++ b/src/witness/z3/violationZ3.z3.ml @@ -78,8 +78,8 @@ struct | e -> failwith @@ Pretty.sprint ~width:max_int @@ Pretty.dprintf "exp_to_expr: %a" Cil.d_exp e - let get_arg_vname i = Goblintutil.create_var (Cil.makeVarinfo false ("_arg" ^ string_of_int i) Cil.intType) (* TODO: correct type in general *) - let return_vname = Goblintutil.create_var (Cil.makeVarinfo false "_return" Cil.intType) (* TODO: correct type in general *) + let get_arg_vname i = Cilfacade.create_var (Cil.makeVarinfo false ("_arg" ^ string_of_int i) Cil.intType) (* TODO: correct type in general *) + let return_vname = Cilfacade.create_var (Cil.makeVarinfo false "_return" Cil.intType) (* TODO: correct type in general *) let wp_assert env (from_node, (edge: MyARG.inline_edge), _) = match edge with | MyARG.CFGEdge (MyCFG.Assign ((Var v, NoOffset), e)) -> From c784c3cc485ceab9c025d83951ab95369be8b8bc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 12 May 2023 22:11:07 +0300 Subject: [PATCH 187/518] Fix Maingoblint indentation --- src/maingoblint.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/maingoblint.ml b/src/maingoblint.ml index e5f2468a4b..b67bd64f5c 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -511,7 +511,7 @@ let do_analyze change_info merged_AST = if not (get_bool "g2html" || get_string "outfile" = "") then ( if !Messages.out <> Legacy.stdout then Legacy.close_out !Messages.out; - Messages.out := Legacy.open_out (get_string "outfile")); + Messages.out := Legacy.open_out (get_string "outfile")); let module L = Printable.Liszt (CilType.Fundec) in if get_bool "justcil" then From e94b0cce9a15ebbd5a20f063dcf08ba8a17289da Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Mon, 15 May 2023 15:10:16 +0200 Subject: [PATCH 188/518] Fixed analysis for functions that write to string literals + first draft for tests --- src/analyses/base.ml | 82 ++++++++++--------- src/cdomains/addressDomain.ml | 14 +++- .../71-strings/01-string_literals.c | 70 ++++++++++++++++ .../regression/71-strings/02-string_basics.c | 61 ++++++++++++++ 4 files changed, 186 insertions(+), 41 deletions(-) create mode 100644 tests/regression/71-strings/01-string_literals.c create mode 100644 tests/regression/71-strings/02-string_basics.c diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 891aefa28f..a2fdf6ebd1 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2059,6 +2059,19 @@ struct let st: store = ctx.local in let gs = ctx.global in let desc = LF.find f in + let memory_copying dst src = + let dest_a, dest_typ = addr_type_of_exp dst in + let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in + let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval + |> AD.get_type in + (* when src and destination type coincide, take value from the source, otherwise use top *) + let value = if typeSig dest_typ = typeSig src_typ then + let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in + eval_rv (Analyses.ask_of_ctx ctx) gs st (Lval src_cast_lval) + else + VD.top_value (unrollType dest_typ) + in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value in (* for string functions *) let eval_n = function (* if only n characters of a given string are needed, evaluate expression n to an integer option *) @@ -2077,23 +2090,21 @@ struct let string_manipulation s1 s2 lv all op = let s1_a, s1_typ = addr_type_of_exp s1 in let s2_a, s2_typ = addr_type_of_exp s2 in - (* when whished types coincide, compute result of operation op, otherwise use top *) - match lv with - | Some s -> - let lv_a, lv_typ = addr_type_of_exp s in + match lv, op with + | Some lv_val, Some f -> + (* when whished types coincide, compute result of operation op, otherwise use top *) + let lv_a = eval_lv (Analyses.ask_of_ctx ctx) gs st lv_val in + let lv_typ = Cilfacade.typeOfLval lv_val in if all && typeSig s1_typ = typeSig s2_typ && typeSig s2_typ = typeSig lv_typ then (* all types need to coincide *) - lv_a, lv_typ, (op s1_a s2_a) + lv_a, lv_typ, (f s1_a s2_a) else if not all && typeSig s1_typ = typeSig s2_typ then (* only the types of s1 and s2 need to coincide *) - lv_a, lv_typ, (op s1_a s2_a) + lv_a, lv_typ, (f s1_a s2_a) else lv_a, lv_typ, (VD.top_value (unrollType lv_typ)) - | None -> - if typeSig s1_typ = typeSig s2_typ then - let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:s2 ~newt:(TPtr (s1_typ, []))) ~off:NoOffset in - let s2_cast_a = eval_lv (Analyses.ask_of_ctx ctx) gs st src_cast_lval in - s1_a, s1_typ, (op s1_a s2_cast_a) - else - s1_a, s1_typ, (VD.top_value (unrollType s1_typ)) + | _ -> + (* check if s1 is potentially a string literal as writing to it would be undefined behavior; then return top *) + let _ = AD.string_writing_defined s1_a in + s1_a, s1_typ, VD.top_value (unrollType s1_typ) in let st = match desc.special args, f.vname with | Memset { dest; ch; count; }, _ -> @@ -2114,61 +2125,56 @@ struct let dest_a, dest_typ = addr_type_of_exp dest in let value = VD.zero_init_value dest_typ in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value - | Memcpy { dest = dst; src }, _ + | Memcpy { dest = dst; src }, _ -> + memory_copying dst src (* strcpy(dest, src); *) | Strcpy { dest = dst; src; n = None }, _ -> let dest_a, dest_typ = addr_type_of_exp dst in - let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in - let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval - |> AD.get_type in - (* when src and destination type coincide, take value from the source, otherwise use top *) - let value = if typeSig dest_typ = typeSig src_typ then - let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in - eval_rv (Analyses.ask_of_ctx ctx) gs st (Lval src_cast_lval) - else - VD.top_value (unrollType dest_typ) - in - set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + (* when dest surely isn't a string literal, try copying src to dest *) + if AD.string_writing_defined dest_a then + memory_copying dst src + else + (* else return top (after a warning was issued) *) + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (VD.top_value (unrollType dest_typ)) (* strncpy(dest, src, n); *) | Strcpy { dest = dst; src; n }, _ -> begin match eval_n n with | Some num -> - (* when src and destination type coincide, take n-substring value from the source, otherwise use top *) - let dest_a, dest_typ, value = string_manipulation dst src None false (fun _ src_a -> `Address(AD.to_n_string num src_a)) in + let dest_a, dest_typ, value = string_manipulation dst src None false None in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | None -> failwith "already handled in case above" end | Strcat { dest = dst; src; n }, _ -> - (* when src and destination type coincide, concatenate the whole string or a n-substring from src to dest, otherwise use top *) - let dest_a, dest_typ, value = string_manipulation dst src None false (fun dest_a src_a -> `Address(AD.string_concat dest_a src_a (eval_n n))) in + let dest_a, dest_typ, value = string_manipulation dst src None false None in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Strlen s, _ -> begin match lv with - | Some v -> + | Some lv_val -> + let dest_a = eval_lv (Analyses.ask_of_ctx ctx) gs st lv_val in + let dest_typ = Cilfacade.typeOfLval lv_val in let lval = mkMem ~addr:(Cil.stripCasts s) ~off:NoOffset in let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in - let dest_a, dest_typ = addr_type_of_exp (Lval v) in let value = `Int(AD.to_string_length address) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value - | None -> ctx.local + | None -> st end | Strstr { haystack; needle }, _ -> begin match lv with - | Some v -> + | Some _ -> (* when haystack, needle and dest type coincide, check if needle is a substring of haystack: if that is the case, assign the substring of haystack starting at the first occurrence of needle to dest, else use top *) - let dest_a, dest_typ, value = string_manipulation haystack needle (Some (Lval v)) true (fun h_a n_a -> `Address(AD.substring_extraction h_a n_a)) in + let dest_a, dest_typ, value = string_manipulation haystack needle lv true (Some (fun h_a n_a -> `Address(AD.substring_extraction h_a n_a))) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value - | None -> ctx.local + | None -> st end | Strcmp { s1; s2; n }, _ -> begin match lv with - | Some v -> + | Some _ -> (* when s1 and s2 type coincide, compare both both strings completely or their first n characters, otherwise use top *) - let dest_a, dest_typ, value = string_manipulation s1 s2 (Some (Lval v)) false (fun s1_a s2_a -> `Int(AD.string_comparison s1_a s2_a (eval_n n))) in + let dest_a, dest_typ, value = string_manipulation s1 s2 lv false (Some (fun s1_a s2_a -> `Int(AD.string_comparison s1_a s2_a (eval_n n)))) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value - | None -> ctx.local + | None -> st end | Abort, _ -> raise Deadcode | ThreadExit { ret_val = exp }, _ -> diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 70237816aa..eca1037cb9 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -110,7 +110,7 @@ struct let transform n elem = match Addr.to_n_string n elem with | Some s -> from_string s - | None -> top () in + | None -> top_ptr in (* maps any StrPtr for which n is valid to the prefix of length n of its content, otherwise maps to top *) List.map (transform n) (elements x) (* and returns the least upper bound of computed AddressDomain values *) @@ -142,7 +142,7 @@ struct (* if any of the input address sets contains an element that isn't a StrPtr, return top *) if List.exists ((=) None) x' || List.exists ((=) None) y' then - top () + top_ptr else (* else concatenate every string of x' with every string of y' and return the least upper bound *) BatList.cartesian_product x' y' @@ -169,7 +169,7 @@ struct (* if any of the input address sets contains an element that isn't a StrPtr, return top *) if List.exists ((=) None) haystack' || List.exists ((=) None) needle' then - top () + top_ptr else (* else try to find the first occurrence of all strings in needle' in all strings s of haystack', collect s starting from that occurrence or if there is none, collect a NULL pointer, @@ -209,6 +209,14 @@ struct |> List.map (fun (s1, s2) -> compare (extract_string s1) (extract_string s2)) |> List.fold_left Idx.join (Idx.bot_of IInt) + 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 (fun x -> match x with Some _ -> true | None -> false) (List.map Addr.to_string (elements 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 + true + (* add an & in front of real addresses *) module ShortAddr = struct diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c new file mode 100644 index 0000000000..8904d8d23d --- /dev/null +++ b/tests/regression/71-strings/01-string_literals.c @@ -0,0 +1,70 @@ +// PARAM: --disable ana.base.limit-string-addresses + +#include +#include + +char* hello_world() { + return "Hello world!"; +} + +void id(char* s) { + s = s; +} + +int main() { + char* s1 = "abcde"; + char* s2 = "abcdfg"; + char* s3 = hello_world(); + + int i = strlen(s1); + __goblint_check(i == 5); + + i = strlen(s2); + __goblint_check(i == 6); + + i = strlen(s3); + __goblint_check(i == 12); + + id(s3); + i = strlen(s3); + __goblint_check(i == 12); + + i = strcmp(s1, s2); + __goblint_check(i != 0); + __goblint_check(i < 0); + + i = strcmp(s2, "abcdfg"); + __goblint_check(i == 0); + + char* cmp = strstr(s1, "bcd"); + i = strcmp(cmp, "bcde"); + __goblint_check(i == 0); + + cmp = strstr(s1, "bcdf"); + __goblint_check(cmp == NULL); + + if (rand() == 42) + s3 = "hello"; + else + s3 = "world"; + + cmp = strstr(s3, "l"); + __goblint_check(cmp != NULL); // should Goblint know this? + + i = strncmp(s1, s2, 4); + __goblint_check(i == 0); + + i = strncmp(s1, s2, 5); + __goblint_check(i != 0); + + strcpy(s1, "hi"); // WARN + strncpy(s1, "hi", 1); // WARN + strcat(s1, "hi"); // WARN + strncat(s1, "hi", 1); // WARN + + char s4[] = "hello"; + strcpy(s4, s2); // NOWARN + strncpy(s4, s2, 2); // NOWARN + + return 0; +} \ No newline at end of file diff --git a/tests/regression/71-strings/02-string_basics.c b/tests/regression/71-strings/02-string_basics.c new file mode 100644 index 0000000000..e73a17cc79 --- /dev/null +++ b/tests/regression/71-strings/02-string_basics.c @@ -0,0 +1,61 @@ +#include +#include + +void concat_1(char* s, int i) { + if (i <= 0) + return; + else + strncat(s, "10", 1); + concat_1(s, i - 1); +} + +int main() { + char* s1 = malloc(40); + if (!s1) + return 1; + strcpy(s1, "hello"); + + char s2[] = " world!"; + char s3[10] = "abcd"; + char s4[20] = "abcdf"; + + int i = strlen(s1); + __goblint_check(i == 5); // UNKNOWN + + i = strlen(s2); + __goblint_check(i == 7); // UNKNOWN + + i = strlen(s3); + __goblint_check(i == 4); // UNKNOWN + + strcat(s1, s2); + i = strcmp(s1, "hello world!"); + __goblint_check(i == 0); // UNKNOWN + + strcpy(s1, "hi "); + strncpy(s1, s3, 3); + i = strlen(s1); + __goblint_check(i == 7); // UNKNOWN + + char* cmp = strstr(s1, " "); + i = strcmp(cmp, s3); + __goblint_check(i == 0); // UNKNOWN + + i = strncmp(s4, s3, 4); + __goblint_check(i == 0); // UNKNOWN + + i = strncmp(s4, s3, 5); + __goblint_check(i > 0); // UNKNOWN + + strncpy(s1, "", 20); + concat_1(s1, 30); + i = strlen(s1); + __goblint_check(i == 30); // UNKNOWN + + cmp = strstr(s1, "0"); + __goblint_check(cmp == NULL); // UNKNOWN + + free(s1); + + return 0; +} \ No newline at end of file From 6a115c003180be479dd329f88acfdb1d09ae69d0 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Mon, 15 May 2023 16:34:54 +0200 Subject: [PATCH 189/518] Adapted tests for string literals analysis --- .../71-strings/01-string_literals.c | 21 +++++++++++------ .../regression/71-strings/02-string_basics.c | 23 +++++++++++-------- 2 files changed, 27 insertions(+), 17 deletions(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index 8904d8d23d..d2cf30ef7b 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -1,7 +1,8 @@ -// PARAM: --disable ana.base.limit-string-addresses +// PARAM: --disable ana.base.limit-string-addresses --enable ana.int.interval #include #include +#include char* hello_world() { return "Hello world!"; @@ -25,12 +26,11 @@ int main() { i = strlen(s3); __goblint_check(i == 12); - id(s3); - i = strlen(s3); - __goblint_check(i == 12); + id(s2); + i = strlen(s2); + __goblint_check(i == 6); i = strcmp(s1, s2); - __goblint_check(i != 0); __goblint_check(i < 0); i = strcmp(s2, "abcdfg"); @@ -49,7 +49,10 @@ int main() { s3 = "world"; cmp = strstr(s3, "l"); - __goblint_check(cmp != NULL); // should Goblint know this? + __goblint_check(cmp != NULL); + + cmp = strstr(s3, "he"); + __goblint_check(cmp != NULL); // UNKNOWN i = strncmp(s1, s2, 4); __goblint_check(i == 0); @@ -64,7 +67,11 @@ int main() { char s4[] = "hello"; strcpy(s4, s2); // NOWARN - strncpy(s4, s2, 2); // NOWARN + strncpy(s4, s3, 2); // NOWARN + + char s5[13] = "hello"; + strcat(s5, " world"); // NOWARN + strncat(s5, "! some further text", 1); // NOWARN return 0; } \ No newline at end of file diff --git a/tests/regression/71-strings/02-string_basics.c b/tests/regression/71-strings/02-string_basics.c index e73a17cc79..db196c64b4 100644 --- a/tests/regression/71-strings/02-string_basics.c +++ b/tests/regression/71-strings/02-string_basics.c @@ -1,5 +1,8 @@ +// PARAM: --disable ana.base.limit-string-addresses --enable ana.int.interval + #include #include +#include void concat_1(char* s, int i) { if (i <= 0) @@ -11,19 +14,16 @@ void concat_1(char* s, int i) { int main() { char* s1 = malloc(40); - if (!s1) - return 1; - strcpy(s1, "hello"); - - char s2[] = " world!"; + strcpy(s1, "hello "); + char s2[] = "world!"; char s3[10] = "abcd"; char s4[20] = "abcdf"; int i = strlen(s1); - __goblint_check(i == 5); // UNKNOWN + __goblint_check(i == 6); // UNKNOWN i = strlen(s2); - __goblint_check(i == 7); // UNKNOWN + __goblint_check(i == 6); // UNKNOWN i = strlen(s3); __goblint_check(i == 4); // UNKNOWN @@ -35,10 +35,13 @@ int main() { strcpy(s1, "hi "); strncpy(s1, s3, 3); i = strlen(s1); - __goblint_check(i == 7); // UNKNOWN + __goblint_check(i == 3); // UNKNOWN + + strcat(s1, "ababcd"); + char* cmp = strstr(s1, "bab"); + __goblint_check(cmp != NULL); // UNKNOWN - char* cmp = strstr(s1, " "); - i = strcmp(cmp, s3); + i = strcmp(cmp, "babcd"); // WARN: no check if cmp != NULL (even if it obviously is != NULL) __goblint_check(i == 0); // UNKNOWN i = strncmp(s4, s3, 4); From f73f5dee35896fadf1ad388f837836ebbecf8d1c Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Mon, 15 May 2023 17:15:48 +0200 Subject: [PATCH 190/518] Reintroduced code that shouldn't have been deleted --- src/analyses/libraryFunctions.ml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 239fd5253c..23573978cf 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -675,7 +675,12 @@ let invalidate_actions = [ "__builtin___snprintf_chk", writes [1];(*keep [1]*) "sprintf", writes [1];(*keep [1]*) "sscanf", writesAllButFirst 2 readsAll;(*drop 2*) + "strcmp", readsAll;(*safe*) "strftime", writes [1];(*keep [1]*) + "strlen", readsAll;(*safe*) + "strncmp", readsAll;(*safe*) + "strncat", writes [1];(*keep [1]*) + "strstr", readsAll;(*safe*) "strdup", readsAll;(*safe*) "toupper", readsAll;(*safe*) "tolower", readsAll;(*safe*) @@ -745,6 +750,7 @@ let invalidate_actions = [ "__builtin_strchr", readsAll;(*safe*) "__builtin___strcpy", writes [1];(*keep [1]*) "__builtin___strcpy_chk", writes [1];(*keep [1]*) + "strcat", writes [1];(*keep [1]*) "strtok", readsAll;(*safe*) "getpgrp", readsAll;(*safe*) "umount2", readsAll;(*safe*) From 5ac4ca2a3b1f2276af60dcab296d883391a997b1 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Mon, 15 May 2023 17:17:59 +0200 Subject: [PATCH 191/518] Reintroduced another line that shouldn't have been deleted --- src/analyses/libraryFunctions.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 23573978cf..38cce16b02 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -740,6 +740,7 @@ let invalidate_actions = [ "sigaddset", writesAll;(*unsafe*) "pthread_sigmask", writesAllButFirst 2 readsAll;(*unsafe*) "raise", writesAll;(*unsafe*) + "_strlen", readsAll;(*safe*) "__builtin_alloca", readsAll;(*safe*) "dlopen", readsAll;(*safe*) "dlsym", readsAll;(*safe*) From 1ac36e362be435f5fc763c3c1c3497f9022a3104 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Mon, 15 May 2023 19:13:45 +0200 Subject: [PATCH 192/518] Added invalidate_actions --- src/analyses/libraryFunctions.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 38cce16b02..68ce1bfa2c 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -751,7 +751,10 @@ let invalidate_actions = [ "__builtin_strchr", readsAll;(*safe*) "__builtin___strcpy", writes [1];(*keep [1]*) "__builtin___strcpy_chk", writes [1];(*keep [1]*) + "__builtin___strncpy_chk", writes [1];(*keep [1]*) "strcat", writes [1];(*keep [1]*) + "__builtin___strcat_chk", writes[1];(*keep [1]*) + "__builtin___strncat_chk", writes[1];(*keep [1]*) "strtok", readsAll;(*safe*) "getpgrp", readsAll;(*safe*) "umount2", readsAll;(*safe*) From b7775e218561954ff2688974597379403e47f05c Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Mon, 15 May 2023 20:01:54 +0200 Subject: [PATCH 193/518] Incorporated github-code-scanning suggestions --- src/cdomains/addressDomain.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index eca1037cb9..16a755cd0c 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -194,11 +194,11 @@ struct let compare s1 s2 = let res = String.compare s1 s2 in if res = 0 then - Idx.of_int IInt (Z.of_int 0) + Idx.of_int IInt Z.zero else if res > 0 then - Idx.starting IInt (Z.of_int 1) + Idx.starting IInt Z.one else - Idx.ending IInt (Z.of_int (-1)) in + Idx.ending IInt (Z.neg (Z.one)) in (* if any of the input address sets contains an element that isn't a StrPtr, return top *) if List.exists ((=) None) x' || List.exists ((=) None) y' then From ffcf0ac24ddb6db5cfe18f2549ace622c05c968a Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 16 May 2023 10:09:01 +0200 Subject: [PATCH 194/518] Collect also recoverable mutexes --- src/analyses/mutexAnalysis.ml | 74 +++++++++++++------ src/domains/lattice.ml | 27 +++++++ src/domains/printable.ml | 29 ++++++++ .../25-phases-intricate-sound.c | 55 ++++++++++++++ 4 files changed, 164 insertions(+), 21 deletions(-) create mode 100644 tests/regression/58-base-mm-tid/25-phases-intricate-sound.c diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 27558350c0..e47e42c913 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -7,7 +7,7 @@ module Mutexes = LockDomain.Mutexes module LF = LibraryFunctions open GoblintCil open Analyses - +open Batteries module VarSet = SetDomain.Make (Basetype.Variables) @@ -21,7 +21,7 @@ struct (* Two global invariants: 1. varinfo -> set of mutexes -- used for protecting locksets (M[g]) - 2. mutex -> set of varinfos -- used for protected variables (G_m), only collected during postsolving *) + 2. mutex -> set of varinfos -- used for protected variables (G_m), only collected during postsolving (!) *) module V = struct @@ -36,17 +36,27 @@ struct module MakeG (G0: Lattice.S) = struct - module ReadWrite = + module ReadWriteNoRecover = + struct + include G0 + let name () = "readwriteNoRecover" + end + module WriteNoRecover = struct include G0 - let name () = "readwrite" + let name () = "writeNoRecover" end - module Write = + module ReadWriteRecover = struct include G0 - let name () = "write" + let name () = "readwriteRecover" end - include Lattice.Prod (ReadWrite) (Write) + module WriteRecover = + struct + include G0 + let name () = "writeNoRecover" + end + include Lattice.Prod4 (ReadWriteNoRecover) (WriteNoRecover) (ReadWriteRecover) (WriteRecover) end module GProtecting = MakeG (LockDomain.Simple) @@ -114,9 +124,9 @@ struct `Index (i_exp, conv_offset_inv o) let query ctx (type a) (q: a Queries.t): a Queries.result = - let check_fun ~write ls = + let check_fun ~write ~recover ls = let locks = Lockset.export_locks ls in - if write then (Mutexes.bot (), locks) else (locks, Mutexes.bot ()) + if write then (Mutexes.bot (), locks, Mutexes.bot (), if recover then locks else Mutexes.bot ()) else (locks, Mutexes.bot (), (if recover then locks else Mutexes.bot ()), Mutexes.bot ()) in let non_overlapping locks1 locks2 = let intersect = GProtecting.join locks1 locks2 in @@ -125,7 +135,7 @@ struct match q with | Queries.MayBePublic _ when Lockset.is_bot ctx.local -> false | Queries.MayBePublic {global=v; write} -> - let held_locks: GProtecting.t = check_fun ~write (Lockset.filter snd ctx.local) in + let held_locks: GProtecting.t = check_fun ~write ~recover:false (Lockset.filter snd ctx.local) in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks ctx.local) then false @@ -133,7 +143,7 @@ struct non_overlapping held_locks (G.protecting (ctx.global (V.protecting v))) | Queries.MayBePublicWithout _ when Lockset.is_bot ctx.local -> false | Queries.MayBePublicWithout {global=v; write; without_mutex} -> - let held_locks: GProtecting.t = check_fun ~write (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in + let held_locks: GProtecting.t = check_fun ~write ~recover:false (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks (Lockset.remove (without_mutex, true) ctx.local)) then false @@ -141,7 +151,7 @@ struct non_overlapping held_locks (G.protecting (ctx.global (V.protecting v))) | Queries.MustBeProtectedBy {mutex; global; write} -> let mutex_lockset = Lockset.singleton (mutex, true) in - let held_locks: GProtecting.t = check_fun ~write mutex_lockset in + let held_locks: GProtecting.t = check_fun ~write ~recover:false mutex_lockset in (* TODO: unsound in 29/24, why did we do this before? *) (* if LockDomain.Addr.equal mutex verifier_atomic then true @@ -160,7 +170,7 @@ struct let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in Mutexes.mem (LockDomain.Addr.from_var LF.verifier_atomic_var) held_locks | Queries.MustProtectedVars {mutex = m; write} -> - let protected = (if write then snd else fst) (G.protected (ctx.global (V.protected m))) in + let protected = (if write then Tuple4.second else Tuple4.first) (G.protected (ctx.global (V.protected m))) in VarSet.fold (fun v acc -> Queries.LS.add (v, `NoOffset) acc ) protected (Queries.LS.empty ()) @@ -171,13 +181,13 @@ struct begin match g with | `Left g' -> (* protecting *) if GobConfig.get_bool "dbg.print_protection" then ( - let (protecting, _) = G.protecting (ctx.global g) in (* readwrite protecting *) + let (protecting, _, _, _) = G.protecting (ctx.global g) in (* readwrite protecting *) let s = Mutexes.cardinal protecting in M.info_noloc ~category:Race "Variable %a read-write protected by %d mutex(es): %a" CilType.Varinfo.pretty g' s Mutexes.pretty protecting ) | `Right m -> (* protected *) if GobConfig.get_bool "dbg.print_protection" then ( - let (protected, _) = G.protected (ctx.global g) in (* readwrite protected *) + let (protected, _, _ ,_) = G.protected (ctx.global g) in (* readwrite protected *) let s = VarSet.cardinal protected in max_protected := max !max_protected s; sum_protected := !sum_protected + s; @@ -210,6 +220,7 @@ struct let event ctx e octx = match e with | Events.Access {exp; lvals; kind; _} when ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) -> (* threadflag query in post-threadspawn ctx *) + let is_recovered_to_st = not (ThreadFlag.is_currently_multi (Analyses.ask_of_ctx ctx)) in (* must use original (pre-assign, etc) ctx queries *) let old_access var_opt offs_opt = (* TODO: this used to use ctx instead of octx, why? *) @@ -223,22 +234,43 @@ struct | Read -> false | Spawn -> false (* TODO: nonsense? *) in - let el = (locks, if write then locks else Mutexes.top ()) in + (* If the access is not a write, set to T so intersection with current write-protecting is identity *) + let wlocks = if write then locks else Mutexes.top () in + let el = + if is_recovered_to_st then + (* If we are in single-threaded mode again, this does not need to be added to set of mutexes protecting in mt-mode only *) + (locks, wlocks, Mutexes.top (), Mutexes.top ()) + else + (locks, wlocks, locks, wlocks) + in ctx.sideg (V.protecting v) (G.create_protecting el); if !GU.postsolving then ( - let held_locks = (if write then snd else fst) (G.protecting (ctx.global (V.protecting v))) in + let protecting = G.protecting (ctx.global (V.protecting v)) in let vs_empty = VarSet.empty () in + let vs = VarSet.singleton v in + let held_norecovery = (if write then Tuple4.second else Tuple4.first) protecting in + let held_recovery = (if write then Tuple4.fourth else Tuple4.third) protecting in Mutexes.iter (fun addr -> - let vs = VarSet.singleton v in let protected = if write then - (vs_empty, vs) + (vs_empty, vs, vs_empty, vs) + else + (vs, vs_empty, vs, vs_empty) + in + ctx.sideg (V.protected addr) (G.create_protected protected) + ) held_norecovery; + (* If the mutex set here is top, it is actually not accessed *) + if is_recovered_to_st && not @@ Mutexes.is_top held_recovery then + Mutexes.iter (fun addr -> + let protected = + if write then + (vs_empty, vs_empty, vs_empty, vs) else - (vs, vs_empty) + (vs_empty, vs_empty, vs, vs_empty) in ctx.sideg (V.protected addr) (G.create_protected protected) - ) held_locks + ) held_recovery; ) | None -> M.info ~category:Unsound "Write to unknown address: privatization is unsound." in diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index 960a2a69ac..803a5ce343 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -462,6 +462,33 @@ struct let narrow = op_scheme Base1.narrow Base2.narrow Base3.narrow end +module Prod4 (Base1: S) (Base2: S) (Base3: S) (Base4: S) = +struct + include Printable.Prod4 (Base1) (Base2) (Base3) (Base4) + + let bot () = (Base1.bot (), Base2.bot (), Base3.bot (), Base4.bot ()) + let is_bot (x1,x2,x3,x4) = Base1.is_bot x1 && Base2.is_bot x2 && Base3.is_bot x3 && Base4.is_bot x4 + let top () = (Base1.top (), Base2.top (), Base3.top (), Base4.top ()) + let is_top (x1,x2,x3,x4) = Base1.is_top x1 && Base2.is_top x2 && Base3.is_top x3 && Base4.is_top x4 + let leq (x1,x2,x3,x4) (y1,y2,y3,y4) = Base1.leq x1 y1 && Base2.leq x2 y2 && Base3.leq x3 y3 && Base4.leq x4 y4 + + let pretty_diff () ((x1,x2,x3,x4:t),(y1,y2,y3,y4:t)): Pretty.doc = + if not (Base1.leq x1 y1) then + Base1.pretty_diff () (x1,y1) + else if not (Base2.leq x2 y2) then + Base2.pretty_diff () (x2,y2) + else if not (Base3.leq x3 y3) then + Base3.pretty_diff () (x3,y3) + else + Base4.pretty_diff () (x4,y4) + + let op_scheme op1 op2 op3 op4 (x1,x2,x3,x4) (y1,y2,y3,y4): t = (op1 x1 y1, op2 x2 y2, op3 x3 y3, op4 x4 y4) + let join = op_scheme Base1.join Base2.join Base3.join Base4.join + let meet = op_scheme Base1.meet Base2.meet Base3.meet Base4.meet + let widen = op_scheme Base1.widen Base2.widen Base3.widen Base4.widen + let narrow = op_scheme Base1.narrow Base2.narrow Base3.narrow Base4.narrow +end + module LiftBot (Base : S) = struct include Printable.LiftBot (Base) diff --git a/src/domains/printable.ml b/src/domains/printable.ml index 4f68bc29a5..60403771b8 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -429,6 +429,35 @@ struct let arbitrary () = QCheck.triple (Base1.arbitrary ()) (Base2.arbitrary ()) (Base3.arbitrary ()) end +module Prod4 (Base1: S) (Base2: S) (Base3: S) (Base4: S) = struct + type t = Base1.t * Base2.t * Base3.t * Base4.t [@@deriving eq, ord, hash] + include Std + + let show (x,y,z,w) = "(" ^ Base1.show x ^ ", " ^ Base2.show y ^ ", " ^ Base3.show z ^ ", " ^ Base4.show w ^ ")" + + let pretty () (x,y,z,w) = + text "(" ++ + Base1.pretty () x + ++ text ", " ++ + Base2.pretty () y + ++ text ", " ++ + Base3.pretty () z + ++ text ", " ++ + Base4.pretty () w + ++ text ")" + + let printXml f (x,y,z,w) = + BatPrintf.fprintf f "\n\n\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n%s\n\n%a\n\n" (XmlUtil.escape (Base1.name ())) Base1.printXml x (XmlUtil.escape (Base2.name ())) Base2.printXml y (XmlUtil.escape (Base3.name ())) Base3.printXml z (XmlUtil.escape (Base4.name ())) Base4.printXml w + + let to_yojson (x, y, z, w) = + `Assoc [ (Base1.name (), Base1.to_yojson x); (Base2.name (), Base2.to_yojson y); (Base3.name (), Base3.to_yojson z); (Base4.name (), Base4.to_yojson w) ] + + let name () = Base1.name () ^ " * " ^ Base2.name () ^ " * " ^ Base3.name () ^ " * " ^ Base4.name () + + let relift (x,y,z,w) = (Base1.relift x, Base2.relift y, Base3.relift z, Base4.relift w) + let arbitrary () = QCheck.quad (Base1.arbitrary ()) (Base2.arbitrary ()) (Base3.arbitrary ()) (Base4.arbitrary ()) +end + module Liszt (Base: S) = struct type t = Base.t list [@@deriving eq, ord, hash, to_yojson] diff --git a/tests/regression/58-base-mm-tid/25-phases-intricate-sound.c b/tests/regression/58-base-mm-tid/25-phases-intricate-sound.c new file mode 100644 index 0000000000..8b4d3cdcb2 --- /dev/null +++ b/tests/regression/58-base-mm-tid/25-phases-intricate-sound.c @@ -0,0 +1,55 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins --set ana.activated[+] thread +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t B = PTHREAD_MUTEX_INITIALIZER; + +void *t_benign(void *arg) { + pthread_mutex_lock(&A); + pthread_mutex_lock(&B); + g = 10; + __goblint_check(g == 10); //TODO + pthread_mutex_unlock(&B); + pthread_mutex_unlock(&A); + return NULL; +} + +void *t_benign2(void *arg) { + pthread_mutex_lock(&A); + pthread_mutex_lock(&B); + g = 10; + __goblint_check(g == 10); //TODO + pthread_mutex_unlock(&B); + pthread_mutex_unlock(&A); + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + g = 20; + __goblint_check(g == 20); + + // Modified while holding one of the locks that is protecting in MT mode + pthread_mutex_lock(&A); + g = g + 5; + pthread_mutex_unlock(&A); + + pthread_create(&id2, NULL, t_benign2, NULL); + + pthread_mutex_lock(&A); + pthread_mutex_lock(&B); + __goblint_check(g == 25); //UNKNOWN! + __goblint_check(g == 10); //UNKNOWN! + pthread_mutex_unlock(&B); + pthread_mutex_unlock(&A); + + + return 0; +} From f1eea0627989799c459f0861ebd2ca11aba3ab02 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 16 May 2023 15:36:36 +0200 Subject: [PATCH 195/518] Support for recovering from multi-threaded mode --- src/analyses/base.ml | 2 +- src/analyses/basePriv.ml | 57 ++++++++-- src/analyses/basePriv.mli | 1 + src/analyses/commonPriv.ml | 16 +-- src/analyses/mutexAnalysis.ml | 20 ++-- src/domains/queries.ml | 6 +- .../58-base-mm-tid/24-phases-sound.c | 8 +- .../58-base-mm-tid/26-phases-trivial.c | 28 +++++ tests/regression/58-base-mm-tid/27-phases.c | 51 +++++++++ .../69-doublelocking/07-rec-dyn-osx.c | 101 ++++++++++++++++++ 10 files changed, 255 insertions(+), 35 deletions(-) create mode 100644 tests/regression/58-base-mm-tid/26-phases-trivial.c create mode 100644 tests/regression/58-base-mm-tid/27-phases.c create mode 100644 tests/regression/69-doublelocking/07-rec-dyn-osx.c diff --git a/src/analyses/base.ml b/src/analyses/base.ml index fb12000f33..06885f7b35 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2438,7 +2438,7 @@ struct | None -> () end; (* D.join ctx.local @@ *) - ctx.local + Priv.threadspawn (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) (priv_sideg ctx.sideg) ctx.local let unassume (ctx: (D.t, _, _, _) ctx) e uuids = (* TODO: structural unassume instead of invariant hack *) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 2b4c213e3c..a55ffbfe56 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -36,6 +36,7 @@ sig 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 val threadenter: Q.ask -> BaseComponents (D).t -> BaseComponents (D).t + val threadspawn: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> BaseComponents (D).t val iter_sys_vars: (V.t -> G.t) -> VarQuery.t -> V.t VarQuery.f -> unit val thread_join: ?force:bool -> Q.ask -> (V.t -> G.t) -> Cil.exp -> BaseComponents (D).t -> BaseComponents (D).t @@ -82,6 +83,7 @@ struct let escape ask getg sideg st escaped = st let enter_multithreaded ask getg sideg st = st let threadenter = old_threadenter + let threadspawn ask getg sideg st = st let iter_sys_vars getg vq vf = match vq with @@ -204,6 +206,7 @@ struct {st with cpa = cpa'} let threadenter = old_threadenter + let threadspawn ask get set st = st let thread_join ?(force=false) ask get e st = st let thread_return ask get set tid st = st @@ -403,6 +406,12 @@ struct let long_meet m1 m2 = CPA.long_map2 VD.meet m1 m2 + let update_if_mem var value m = + if CPA.mem var m then + CPA.add var value m + else + m + let get_mutex_global_g_with_mutex_inits inits ask getg g = let get_mutex_global_g = get_relevant_writes_nofilter ask @@ G.mutex @@ getg (V.global g) in let r = if not inits then @@ -417,7 +426,7 @@ struct let get_relevant_writes (ask:Q.ask) m v = let current = ThreadId.get_current ask in let must_joined = ask.f Queries.MustJoinedThreads in - let is_in_Gm x _ = is_protected_by ask m x in + let is_in_Gm x _ = is_protected_by ~recoverable:true ask m x in GMutex.fold (fun k v acc -> if compatible ask current must_joined k then CPA.join acc (CPA.filter is_in_Gm v) @@ -432,7 +441,7 @@ struct get_m else let get_mutex_inits = merge_all @@ G.mutex @@ getg V.mutex_inits in - let is_in_Gm x _ = is_protected_by ask m x in + let is_in_Gm x _ = is_protected_by ~recoverable:true ask m x in let get_mutex_inits' = CPA.filter is_in_Gm get_mutex_inits in CPA.join get_m get_mutex_inits' in @@ -443,7 +452,7 @@ struct let lm = LLock.global x in let tmp = get_mutex_global_g_with_mutex_inits (not (LMust.mem lm lmust)) ask getg x in let local_m = BatOption.default (CPA.bot ()) (L.find_opt lm l) in - if is_unprotected ask x then + if is_unprotected ask ~recoverable:true x then (* We can not rely upon the old value here, it may be too small due to reuse at widening points (and or nice bot/top confusion) in Base *) CPA.find x (CPA.join tmp local_m) else @@ -451,14 +460,14 @@ struct let read_global ask getg st x = let v = read_global ask getg st x in - if M.tracing then M.tracel "priv" "READ GLOBAL %a %B %a = %a\n" CilType.Varinfo.pretty x (is_unprotected ask x) CPA.pretty st.cpa VD.pretty v; + if M.tracing then M.tracel "priv" "READ GLOBAL %a %B %a = %a\n" CilType.Varinfo.pretty x (is_unprotected ~recoverable:true ask x) CPA.pretty st.cpa VD.pretty v; v let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = let w,lmust,l = st.priv in let lm = LLock.global x in let cpa' = - if is_unprotected ask x then + if is_unprotected ask ~recoverable:true x then st.cpa else CPA.add x v st.cpa @@ -467,6 +476,13 @@ struct let tid = ThreadId.get_current ask in let sidev = GMutex.singleton tid (CPA.singleton x v) in let l' = L.add lm (CPA.singleton x v) l in + let is_recovered_st = ask.f (Queries.MustBeSingleThreaded {since_start = false}) && not @@ ask.f (Queries.MustBeSingleThreaded {since_start = true}) in + let l' = if is_recovered_st then + (* update value of local record for all where it appears *) + L.map (update_if_mem x v) l' + else + l' + in sideg (V.global x) (G.create_global sidev); {st with cpa = cpa'; priv = (W.add x w,LMust.add lm lmust,l')} @@ -476,9 +492,10 @@ struct let lm = LLock.mutex m in let get_m = get_m_with_mutex_inits (not (LMust.mem lm lmust)) ask getg m in let local_m = BatOption.default (CPA.bot ()) (L.find_opt lm l) in - let is_in_Gm x _ = is_protected_by ask m x in + let is_in_Gm x _ = is_protected_by ~recoverable:true ask m x in let local_m = CPA.filter is_in_Gm local_m in - let meet = long_meet st.cpa (CPA.join get_m local_m) in + let r = CPA.join get_m local_m in + let meet = long_meet st.cpa r in {st with cpa = meet} ) else @@ -487,18 +504,18 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let w,lmust,l = st.priv in let cpa' = CPA.fold (fun x v cpa -> - if is_protected_by ask m x && is_unprotected_without ask x m then + if is_protected_by ~recoverable:true ask m x && is_unprotected_without ~recoverable:true ask x m then CPA.remove x cpa else cpa ) st.cpa st.cpa in - let w' = W.filter (fun v -> not (is_unprotected_without ask v m)) w in - let side_needed = W.exists (fun v -> is_protected_by ask m v) w in + let w' = W.filter (fun v -> not (is_unprotected_without ~recoverable:true ask v m)) w in + let side_needed = W.exists (fun v -> is_protected_by ~recoverable:true ask m v) w in if not side_needed then {st with cpa = cpa'; priv = (w',lmust,l)} else - let is_in_Gm x _ = is_protected_by ask m x in + let is_in_Gm x _ = is_protected_by ~recoverable:true ask m x in let tid = ThreadId.get_current ask in let sidev = GMutex.singleton tid (CPA.filter is_in_Gm st.cpa) in sideg (V.mutex m) (G.create_mutex sidev); @@ -586,6 +603,21 @@ struct let _,lmust,l = st.priv in {st with cpa = new_cpa; priv = (W.bot (),lmust,l)} + let threadspawn (ask:Queries.ask) get set (st: BaseComponents (D).t) = + let is_recovered_st = ask.f (Queries.MustBeSingleThreaded {since_start = false}) && not @@ ask.f (Queries.MustBeSingleThreaded {since_start = true}) in + if is_recovered_st then + (* Remove all things that are now unprotected *) + let cpa' = CPA.fold (fun x v cpa -> + (* recoverable is false as after this, we will be multi-threaded *) + if is_unprotected ask ~recoverable:false x then + CPA.remove x cpa + else + cpa + ) st.cpa st.cpa + in + {st with cpa = cpa'} + else st + let read_unprotected_global getg x = let get_mutex_global_x = merge_all @@ G.mutex @@ getg (V.global x) in let get_mutex_global_x' = CPA.find x get_mutex_global_x in @@ -739,6 +771,7 @@ struct ) st.cpa st let threadenter = startstate_threadenter startstate + let threadspawn ask get set st = st let thread_join ?(force=false) ask get e st = st let thread_return ask get set tid st = st @@ -865,6 +898,7 @@ struct let thread_join ?(force=false) ask get e st = st let thread_return ask get set tid st = st + let threadspawn ask get set st = st end module MineNaivePrivBase = @@ -1604,6 +1638,7 @@ struct let escape ask getg sideg st escaped = time "escape" (Priv.escape ask getg sideg st) escaped let enter_multithreaded ask getg sideg st = time "enter_multithreaded" (Priv.enter_multithreaded ask getg sideg) st let threadenter ask st = time "threadenter" (Priv.threadenter ask) st + let threadspawn ask get set st = time "threadspawn" (Priv.threadspawn ask get set) st let iter_sys_vars getg vq vf = time "iter_sys_vars" (Priv.iter_sys_vars getg vq) vf let invariant_global getg v = time "invariant_global" (Priv.invariant_global getg) v let invariant_vars ask getg st = time "invariant_vars" (Priv.invariant_vars ask getg) st diff --git a/src/analyses/basePriv.mli b/src/analyses/basePriv.mli index 781771c221..83935f5ce1 100644 --- a/src/analyses/basePriv.mli +++ b/src/analyses/basePriv.mli @@ -21,6 +21,7 @@ sig 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 val threadenter: Queries.ask -> BaseDomain.BaseComponents (D).t -> BaseDomain.BaseComponents (D).t + val threadspawn: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> BaseDomain.BaseComponents (D).t val iter_sys_vars: (V.t -> G.t) -> VarQuery.t -> V.t VarQuery.f -> unit (** [Queries.IterSysVars] for base. *) val thread_join: ?force:bool -> Queries.ask -> (V.t -> G.t) -> Cil.exp -> BaseDomain.BaseComponents (D).t -> BaseDomain.BaseComponents (D).t diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 2e437321b4..32504b2ace 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -39,22 +39,22 @@ end module Protection = struct - let is_unprotected ask x: bool = - let multi = ThreadFlag.has_ever_been_multi ask in + let is_unprotected ask ?(recoverable=false) x: bool = + let multi = if recoverable then ThreadFlag.is_currently_multi ask else ThreadFlag.has_ever_been_multi ask in (!GU.earlyglobs && not multi && not (is_excluded_from_earlyglobs x)) || ( multi && - ask.f (Q.MayBePublic {global=x; write=true}) + ask.f (Q.MayBePublic {global=x; write=true; recoverable}) ) - let is_unprotected_without ask ?(write=true) x m: bool = - ThreadFlag.has_ever_been_multi ask && - ask.f (Q.MayBePublicWithout {global=x; write; without_mutex=m}) + let is_unprotected_without ask ?(write=true) ?(recoverable=false) x m: bool = + (if recoverable then ThreadFlag.is_currently_multi ask else ThreadFlag.has_ever_been_multi ask) && + ask.f (Q.MayBePublicWithout {global=x; write; without_mutex=m; recoverable}) - let is_protected_by ask m x: bool = + let is_protected_by ask ?(recoverable=false) m x: bool = is_global ask x && not (VD.is_immediate_type x.vtype) && - ask.f (Q.MustBeProtectedBy {mutex=m; global=x; write=true}) + ask.f (Q.MustBeProtectedBy {mutex=m; global=x; write=true; recoverable}) let protected_vars (ask: Q.ask): varinfo list = let module VS = Set.Make (CilType.Varinfo) in diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index e47e42c913..257acb88b9 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -54,7 +54,7 @@ struct module WriteRecover = struct include G0 - let name () = "writeNoRecover" + let name () = "writeRecover" end include Lattice.Prod4 (ReadWriteNoRecover) (WriteNoRecover) (ReadWriteRecover) (WriteRecover) end @@ -126,7 +126,11 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = let check_fun ~write ~recover ls = let locks = Lockset.export_locks ls in - if write then (Mutexes.bot (), locks, Mutexes.bot (), if recover then locks else Mutexes.bot ()) else (locks, Mutexes.bot (), (if recover then locks else Mutexes.bot ()), Mutexes.bot ()) + let rw,w = if write then (Mutexes.bot (),locks) else (locks, Mutexes.bot ()) in + if recover then + (Mutexes.bot (), Mutexes.bot (), rw, w) + else + (rw, w, Mutexes.bot (), Mutexes.bot ()) in let non_overlapping locks1 locks2 = let intersect = GProtecting.join locks1 locks2 in @@ -134,24 +138,24 @@ struct in match q with | Queries.MayBePublic _ when Lockset.is_bot ctx.local -> false - | Queries.MayBePublic {global=v; write} -> - let held_locks: GProtecting.t = check_fun ~write ~recover:false (Lockset.filter snd ctx.local) in + | Queries.MayBePublic {global=v; write; recoverable} -> + let held_locks: GProtecting.t = check_fun ~write ~recover:recoverable (Lockset.filter snd ctx.local) in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks ctx.local) then false else *) non_overlapping held_locks (G.protecting (ctx.global (V.protecting v))) | Queries.MayBePublicWithout _ when Lockset.is_bot ctx.local -> false - | Queries.MayBePublicWithout {global=v; write; without_mutex} -> - let held_locks: GProtecting.t = check_fun ~write ~recover:false (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in + | Queries.MayBePublicWithout {global=v; write; without_mutex; recoverable} -> + let held_locks: GProtecting.t = check_fun ~write ~recover:recoverable (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks (Lockset.remove (without_mutex, true) ctx.local)) then false else *) non_overlapping held_locks (G.protecting (ctx.global (V.protecting v))) - | Queries.MustBeProtectedBy {mutex; global; write} -> + | Queries.MustBeProtectedBy {mutex; global; write; recoverable} -> let mutex_lockset = Lockset.singleton (mutex, true) in - let held_locks: GProtecting.t = check_fun ~write ~recover:false mutex_lockset in + let held_locks: GProtecting.t = check_fun ~write ~recover:recoverable mutex_lockset in (* TODO: unsound in 29/24, why did we do this before? *) (* if LockDomain.Addr.equal mutex verifier_atomic then true diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 7869399ee4..eba8a26693 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -37,9 +37,9 @@ module MustBool = BoolDomain.MustBool module Unit = Lattice.Unit (* Helper definitions for deriving complex parts of Any.compare below. *) -type maybepublic = {global: CilType.Varinfo.t; write: bool} [@@deriving ord, hash] -type maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: PreValueDomain.Addr.t} [@@deriving ord, hash] -type mustbeprotectedby = {mutex: PreValueDomain.Addr.t; global: CilType.Varinfo.t; write: bool} [@@deriving ord, hash] +type maybepublic = {global: CilType.Varinfo.t; write: bool; recoverable: bool} [@@deriving ord, hash] +type maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: PreValueDomain.Addr.t; recoverable: bool} [@@deriving ord, hash] +type mustbeprotectedby = {mutex: PreValueDomain.Addr.t; global: CilType.Varinfo.t; write: bool; recoverable: bool} [@@deriving ord, hash] type mustprotectedvars = {mutex: PreValueDomain.Addr.t; write: bool} [@@deriving ord, hash] type memory_access = {exp: CilType.Exp.t; var_opt: CilType.Varinfo.t option; kind: AccessKind.t} [@@deriving ord, hash] type access = diff --git a/tests/regression/58-base-mm-tid/24-phases-sound.c b/tests/regression/58-base-mm-tid/24-phases-sound.c index 506088c9d3..c1fa5d1aef 100644 --- a/tests/regression/58-base-mm-tid/24-phases-sound.c +++ b/tests/regression/58-base-mm-tid/24-phases-sound.c @@ -10,7 +10,7 @@ pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; void *t_benign(void *arg) { pthread_mutex_lock(&A); g = 10; - __goblint_check(g == 10); //TODO + __goblint_check(g == 10); pthread_mutex_unlock(&A); return NULL; } @@ -19,7 +19,7 @@ void *t_benign2(void *arg) { pthread_mutex_lock(&A); __goblint_check(g == 20); g = 10; - __goblint_check(g == 10); //TODO + __goblint_check(g == 10); pthread_mutex_unlock(&A); return NULL; } @@ -34,8 +34,8 @@ int main(void) { g = 20; __goblint_check(g == 20); - - pthread_create(&id2, NULL, t_benign2, NULL); + pthread_t id; + pthread_create(&id, NULL, t_benign2, NULL); pthread_mutex_lock(&A); diff --git a/tests/regression/58-base-mm-tid/26-phases-trivial.c b/tests/regression/58-base-mm-tid/26-phases-trivial.c new file mode 100644 index 0000000000..323c6df251 --- /dev/null +++ b/tests/regression/58-base-mm-tid/26-phases-trivial.c @@ -0,0 +1,28 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins --set ana.activated[+] thread +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + + +void *t_benign(void *arg) { + pthread_mutex_lock(&A); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + + +int main(void) { + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + g = 20; + __goblint_check(g == 20); + + return 0; +} diff --git a/tests/regression/58-base-mm-tid/27-phases.c b/tests/regression/58-base-mm-tid/27-phases.c new file mode 100644 index 0000000000..eb450d2465 --- /dev/null +++ b/tests/regression/58-base-mm-tid/27-phases.c @@ -0,0 +1,51 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins --set ana.activated[+] thread +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + + +void *t_benign(void *arg) { + pthread_mutex_lock(&A); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +void *t_benign2(void *arg) { + pthread_mutex_lock(&A); + __goblint_check(g == 20); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + + g = 20; + __goblint_check(g == 20); + + pthread_mutex_lock(&A); + __goblint_check(g == 20); + pthread_mutex_unlock(&A); + + pthread_create(&id2, NULL, t_benign2, NULL); + + + pthread_mutex_lock(&A); + __goblint_check(g == 20); //UNKNOWN! + __goblint_check(g == 10); //UNKNOWN! + pthread_mutex_unlock(&A); + + + return 0; +} diff --git a/tests/regression/69-doublelocking/07-rec-dyn-osx.c b/tests/regression/69-doublelocking/07-rec-dyn-osx.c new file mode 100644 index 0000000000..a221bc2417 --- /dev/null +++ b/tests/regression/69-doublelocking/07-rec-dyn-osx.c @@ -0,0 +1,101 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +typedef signed char __int8_t; +typedef unsigned char __uint8_t; +typedef short __int16_t; +typedef unsigned short __uint16_t; +typedef int __int32_t; +typedef unsigned int __uint32_t; +typedef long long __int64_t; +typedef unsigned long long __uint64_t; +typedef long __darwin_intptr_t; +typedef unsigned int __darwin_natural_t; +typedef int __darwin_ct_rune_t; + + +struct __darwin_pthread_handler_rec { + void (*__routine)(void *); + void *__arg; + struct __darwin_pthread_handler_rec *__next; +}; + +struct _opaque_pthread_attr_t { + long __sig; + char __opaque[56]; +}; + +struct _opaque_pthread_mutex_t { + long __sig; + char __opaque[56]; +}; + +struct _opaque_pthread_mutexattr_t { + long __sig; + char __opaque[8]; +}; + +struct _opaque_pthread_t { + long __sig; + struct __darwin_pthread_handler_rec *__cleanup_stack; + char __opaque[8176]; +}; + +typedef struct _opaque_pthread_attr_t __darwin_pthread_attr_t; +typedef struct _opaque_pthread_mutex_t __darwin_pthread_mutex_t; +typedef struct _opaque_pthread_mutexattr_t __darwin_pthread_mutexattr_t; +typedef struct _opaque_pthread_t *__darwin_pthread_t; + +typedef __darwin_pthread_attr_t pthread_attr_t; +typedef __darwin_pthread_mutex_t pthread_mutex_t; +typedef __darwin_pthread_mutexattr_t pthread_mutexattr_t; +typedef __darwin_pthread_t pthread_t; + +int pthread_create(pthread_t _Nullable restrict, + const pthread_attr_t * _Nullable restrict, + void * , + void *); + +int pthread_join(pthread_t , void *); +int pthread_mutex_init(pthread_mutex_t * restrict, const pthread_mutexattr_t * _Nullable restrict); +int pthread_mutex_lock(pthread_mutex_t *); +int pthread_mutex_unlock(pthread_mutex_t *); +int pthread_mutexattr_destroy(pthread_mutexattr_t *); +int pthread_mutexattr_init(pthread_mutexattr_t *); +int pthread_mutexattr_settype(pthread_mutexattr_t *, int); + + +int g; + +void* f1(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + + pthread_mutex_lock(mut); + pthread_mutex_lock(mut); + pthread_mutex_unlock(mut); + pthread_mutex_unlock(mut); + return ((void *)0); +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_mutex_t mut; + + pthread_mutexattr_t attr; + pthread_mutexattr_settype(&attr, 2); + pthread_mutex_init(&mut, &attr); + + + pthread_create(&t1,((void *)0),f1,&mut); + + + pthread_mutex_lock(&mut); + pthread_mutex_lock(&mut); + pthread_mutex_unlock(&mut); + pthread_mutex_unlock(&mut); + + pthread_join(t1, ((void *)0)); + + + return 0; +} From 12face422b5adabdf53c15ffc5811a4b304b17dd Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 16 May 2023 15:50:30 +0200 Subject: [PATCH 196/518] Add tests --- src/analyses/basePriv.ml | 3 +- .../58-base-mm-tid/28-phases-prot.c | 48 +++++++++++++++++++ 2 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 tests/regression/58-base-mm-tid/28-phases-prot.c diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index a55ffbfe56..2f7a080b7c 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -605,11 +605,12 @@ struct let threadspawn (ask:Queries.ask) get set (st: BaseComponents (D).t) = let is_recovered_st = ask.f (Queries.MustBeSingleThreaded {since_start = false}) && not @@ ask.f (Queries.MustBeSingleThreaded {since_start = true}) in + let unprotected_after x = ask.f (Q.MayBePublic {global=x; write=true; recoverable=true}) in if is_recovered_st then (* Remove all things that are now unprotected *) let cpa' = CPA.fold (fun x v cpa -> (* recoverable is false as after this, we will be multi-threaded *) - if is_unprotected ask ~recoverable:false x then + if unprotected_after x then CPA.remove x cpa else cpa diff --git a/tests/regression/58-base-mm-tid/28-phases-prot.c b/tests/regression/58-base-mm-tid/28-phases-prot.c new file mode 100644 index 0000000000..12773177ab --- /dev/null +++ b/tests/regression/58-base-mm-tid/28-phases-prot.c @@ -0,0 +1,48 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins --set ana.activated[+] thread +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + + +void *t_benign(void *arg) { + pthread_mutex_lock(&A); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +void *t_benign2(void *arg) { + pthread_mutex_lock(&A); + __goblint_check(g == 30); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + + g = 20; + __goblint_check(g == 20); + + pthread_mutex_lock(&A); + __goblint_check(g == 20); + pthread_mutex_unlock(&A); + + pthread_mutex_lock(&A); + g = 30; + pthread_create(&id2, NULL, t_benign2, NULL); + __goblint_check(g == 30); + pthread_mutex_unlock(&A); + + return 0; +} From ac3508786b124fed4bcc0c6359f6a7d0a0d3a9bd Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 16 May 2023 17:13:48 +0200 Subject: [PATCH 197/518] Base prot --- src/analyses/basePriv.ml | 7 +- .../58-base-mm-tid/28-phases-prot.c | 2 +- .../58-base-mm-tid/29-phases-prot-prime.c | 49 +++++++++ .../58-base-mm-tid/30-create-lock.c | 36 +++++++ .../69-doublelocking/07-rec-dyn-osx.c | 101 ------------------ 5 files changed, 88 insertions(+), 107 deletions(-) create mode 100644 tests/regression/58-base-mm-tid/29-phases-prot-prime.c create mode 100644 tests/regression/58-base-mm-tid/30-create-lock.c delete mode 100644 tests/regression/69-doublelocking/07-rec-dyn-osx.c diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 2f7a080b7c..c1bbe87a93 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -596,12 +596,9 @@ struct {st with cpa= cpa_local } let threadenter ask (st: BaseComponents (D).t): BaseComponents (D).t = - (* Copy-paste from Base make_entry *) - let globals = CPA.filter (fun k v -> is_global ask k) st.cpa in - (* let new_cpa = if !GU.earlyglobs || ThreadFlag.is_multi ctx.ask then CPA.filter (fun k v -> is_private ctx.ask ctx.local k) globals else globals in *) - let new_cpa = globals in + (* We cannot copy over protected things, the thread may start with things privatized that are overwritten before becoming public *) let _,lmust,l = st.priv in - {st with cpa = new_cpa; priv = (W.bot (),lmust,l)} + {st with cpa = CPA.bot (); priv = (W.bot (),lmust,l)} let threadspawn (ask:Queries.ask) get set (st: BaseComponents (D).t) = let is_recovered_st = ask.f (Queries.MustBeSingleThreaded {since_start = false}) && not @@ ask.f (Queries.MustBeSingleThreaded {since_start = true}) in diff --git a/tests/regression/58-base-mm-tid/28-phases-prot.c b/tests/regression/58-base-mm-tid/28-phases-prot.c index 12773177ab..905448c300 100644 --- a/tests/regression/58-base-mm-tid/28-phases-prot.c +++ b/tests/regression/58-base-mm-tid/28-phases-prot.c @@ -17,7 +17,7 @@ void *t_benign(void *arg) { void *t_benign2(void *arg) { pthread_mutex_lock(&A); - __goblint_check(g == 30); + __goblint_check(g == 30); //TODO (does not work as 20 from parent thread is potentially read) g = 10; __goblint_check(g == 10); pthread_mutex_unlock(&A); diff --git a/tests/regression/58-base-mm-tid/29-phases-prot-prime.c b/tests/regression/58-base-mm-tid/29-phases-prot-prime.c new file mode 100644 index 0000000000..64a50b40aa --- /dev/null +++ b/tests/regression/58-base-mm-tid/29-phases-prot-prime.c @@ -0,0 +1,49 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins --set ana.activated[+] thread +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + + +void *t_benign(void *arg) { + pthread_mutex_lock(&A); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +void *t_benign2(void *arg) { + pthread_mutex_lock(&A); + __goblint_check(g == 30); //UNKNOWN! + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + + g = 20; + __goblint_check(g == 20); + + pthread_mutex_lock(&A); + __goblint_check(g == 20); + pthread_mutex_unlock(&A); + + pthread_mutex_lock(&A); + g = 30; + pthread_create(&id2, NULL, t_benign2, NULL); + __goblint_check(g == 30); + g = 40; + pthread_mutex_unlock(&A); + + return 0; +} diff --git a/tests/regression/58-base-mm-tid/30-create-lock.c b/tests/regression/58-base-mm-tid/30-create-lock.c new file mode 100644 index 0000000000..56462681da --- /dev/null +++ b/tests/regression/58-base-mm-tid/30-create-lock.c @@ -0,0 +1,36 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + + +void *t_benign(void *arg) { + return NULL; +} + +void *t_benign2(void *arg) { + pthread_mutex_lock(&A); + int x = g == 40; + // Adding this back leads to ArithmeticOnBottom errors ?!?! + // __goblint_check(g == 40); //UNKNOWN! + __goblint_check(x); //UNKNOWN! + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + pthread_mutex_lock(&A); + g = 30; + pthread_create(&id2, NULL, t_benign2, NULL); + g = 40; + pthread_mutex_unlock(&A); + + return 0; +} diff --git a/tests/regression/69-doublelocking/07-rec-dyn-osx.c b/tests/regression/69-doublelocking/07-rec-dyn-osx.c deleted file mode 100644 index a221bc2417..0000000000 --- a/tests/regression/69-doublelocking/07-rec-dyn-osx.c +++ /dev/null @@ -1,101 +0,0 @@ -// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' -typedef signed char __int8_t; -typedef unsigned char __uint8_t; -typedef short __int16_t; -typedef unsigned short __uint16_t; -typedef int __int32_t; -typedef unsigned int __uint32_t; -typedef long long __int64_t; -typedef unsigned long long __uint64_t; -typedef long __darwin_intptr_t; -typedef unsigned int __darwin_natural_t; -typedef int __darwin_ct_rune_t; - - -struct __darwin_pthread_handler_rec { - void (*__routine)(void *); - void *__arg; - struct __darwin_pthread_handler_rec *__next; -}; - -struct _opaque_pthread_attr_t { - long __sig; - char __opaque[56]; -}; - -struct _opaque_pthread_mutex_t { - long __sig; - char __opaque[56]; -}; - -struct _opaque_pthread_mutexattr_t { - long __sig; - char __opaque[8]; -}; - -struct _opaque_pthread_t { - long __sig; - struct __darwin_pthread_handler_rec *__cleanup_stack; - char __opaque[8176]; -}; - -typedef struct _opaque_pthread_attr_t __darwin_pthread_attr_t; -typedef struct _opaque_pthread_mutex_t __darwin_pthread_mutex_t; -typedef struct _opaque_pthread_mutexattr_t __darwin_pthread_mutexattr_t; -typedef struct _opaque_pthread_t *__darwin_pthread_t; - -typedef __darwin_pthread_attr_t pthread_attr_t; -typedef __darwin_pthread_mutex_t pthread_mutex_t; -typedef __darwin_pthread_mutexattr_t pthread_mutexattr_t; -typedef __darwin_pthread_t pthread_t; - -int pthread_create(pthread_t _Nullable restrict, - const pthread_attr_t * _Nullable restrict, - void * , - void *); - -int pthread_join(pthread_t , void *); -int pthread_mutex_init(pthread_mutex_t * restrict, const pthread_mutexattr_t * _Nullable restrict); -int pthread_mutex_lock(pthread_mutex_t *); -int pthread_mutex_unlock(pthread_mutex_t *); -int pthread_mutexattr_destroy(pthread_mutexattr_t *); -int pthread_mutexattr_init(pthread_mutexattr_t *); -int pthread_mutexattr_settype(pthread_mutexattr_t *, int); - - -int g; - -void* f1(void* ptr) { - pthread_mutex_t* mut = (pthread_mutex_t*) ptr; - - pthread_mutex_lock(mut); - pthread_mutex_lock(mut); - pthread_mutex_unlock(mut); - pthread_mutex_unlock(mut); - return ((void *)0); -} - - -int main(int argc, char const *argv[]) -{ - pthread_t t1; - pthread_mutex_t mut; - - pthread_mutexattr_t attr; - pthread_mutexattr_settype(&attr, 2); - pthread_mutex_init(&mut, &attr); - - - pthread_create(&t1,((void *)0),f1,&mut); - - - pthread_mutex_lock(&mut); - pthread_mutex_lock(&mut); - pthread_mutex_unlock(&mut); - pthread_mutex_unlock(&mut); - - pthread_join(t1, ((void *)0)); - - - return 0; -} From 2bc08297c298f68edcc64efc41fb172b16a7123d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 17 May 2023 11:11:05 +0300 Subject: [PATCH 198/518] Pin newer apron for make 4.4 compatibility fixes --- goblint.opam | 2 +- goblint.opam.locked | 2 +- goblint.opam.template | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/goblint.opam b/goblint.opam index b1b226abe6..678ad53d13 100644 --- a/goblint.opam +++ b/goblint.opam @@ -79,5 +79,5 @@ pin-depends: [ # TODO: add back after release, only pinned for optimization (https://github.com/ocaml-ppx/ppx_deriving/pull/252) [ "ppx_deriving.5.2.1" "git+https://github.com/ocaml-ppx/ppx_deriving.git#0a89b619f94cbbfc3b0fb3255ab4fe5bc77d32d6" ] # TODO: add back after release, only pinned for CI stability - [ "apron.v0.9.13" "git+https://github.com/antoinemine/apron.git#c852ebcc89e5cf4a5a3318e7c13c73e1756abb11"] + [ "apron.v0.9.13" "git+https://github.com/antoinemine/apron.git#1a8e91062c0d7d1e80333d19d5a432332bbbaec8"] ] diff --git a/goblint.opam.locked b/goblint.opam.locked index 61decf72bd..acb49a7b14 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -133,7 +133,7 @@ pin-depends: [ ] [ "apron.v0.9.13" - "git+https://github.com/antoinemine/apron.git#c852ebcc89e5cf4a5a3318e7c13c73e1756abb11" + "git+https://github.com/antoinemine/apron.git#1a8e91062c0d7d1e80333d19d5a432332bbbaec8" ] [ "ppx_deriving.5.2.1" diff --git a/goblint.opam.template b/goblint.opam.template index 84a6a827c2..b7f5a7abff 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -6,5 +6,5 @@ pin-depends: [ # TODO: add back after release, only pinned for optimization (https://github.com/ocaml-ppx/ppx_deriving/pull/252) [ "ppx_deriving.5.2.1" "git+https://github.com/ocaml-ppx/ppx_deriving.git#0a89b619f94cbbfc3b0fb3255ab4fe5bc77d32d6" ] # TODO: add back after release, only pinned for CI stability - [ "apron.v0.9.13" "git+https://github.com/antoinemine/apron.git#c852ebcc89e5cf4a5a3318e7c13c73e1756abb11"] + [ "apron.v0.9.13" "git+https://github.com/antoinemine/apron.git#1a8e91062c0d7d1e80333d19d5a432332bbbaec8"] ] From b4947045804d8858cae2f8af1f061305498a2bc8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 17 May 2023 14:24:59 +0300 Subject: [PATCH 199/518] Move mygprintf to GobPretty --- src/util/gobPretty.ml | 53 +++++++++++++++++++++++++++++++++++++++++++ src/util/messages.ml | 6 ++--- src/util/tracing.ml | 52 +----------------------------------------- 3 files changed, 57 insertions(+), 54 deletions(-) diff --git a/src/util/gobPretty.ml b/src/util/gobPretty.ml index b69e2d22b9..557d995cb2 100644 --- a/src/util/gobPretty.ml +++ b/src/util/gobPretty.ml @@ -6,3 +6,56 @@ let sprint f x = show (f () x) let sprintf (fmt: ('a, unit, Pretty.doc, string) format4): 'a = Pretty.gprintf show fmt + + +open Pretty + +(* Parses a format string to generate a nop-function of the correct type. *) +let igprintf (finish: 'b) (format : ('a, unit, doc, 'b) format4) : 'a = + let format = string_of_format format in + let flen = String.length format in + let fget = String.unsafe_get format in + let rec literal acc i = + let rec skipChars j = + if j >= flen || (match fget j with '%' | '@' | '\n' -> true | _ -> false) then + collect nil j + else + skipChars (succ j) + in + skipChars (succ i) + and collect (acc: doc) (i: int) = + if i >= flen then begin + Obj.magic finish + end else begin + let c = fget i in + if c = '%' then begin + let j = skip_args (succ i) in + match fget j with + '%' -> literal acc j + | ',' -> collect acc (succ j) + | 's' | 'c' | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' + | 'f' | 'e' | 'E' | 'g' | 'G' | 'b' | 'B' -> + Obj.magic(fun b -> collect nil (succ j)) + | 'L' | 'l' | 'n' -> Obj.magic(fun n -> collect nil (succ (succ j))) + | 'a' -> Obj.magic(fun pprinter arg -> collect nil (succ j)) + | 't' -> Obj.magic(fun pprinter -> collect nil (succ j)) + | c -> invalid_arg ("dprintf: unknown format %s" ^ String.make 1 c) + end else if c = '@' then begin + if i + 1 < flen then begin + match fget (succ i) with + '[' | ']' | '!' | '?' | '^' | '@' -> collect nil (i + 2) + | '<' | '>' -> collect nil (i + 1) + | c -> invalid_arg ("dprintf: unknown format @" ^ String.make 1 c) + end else + invalid_arg "dprintf: incomplete format @" + end else if c = '\n' then begin + collect nil (i + 1) + end else + literal acc i + end + and skip_args j = + match String.unsafe_get format j with + '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j) + | c -> j + in + collect nil 0 diff --git a/src/util/messages.ml b/src/util/messages.ml index 7ab7f1ab58..3996d6167a 100644 --- a/src/util/messages.ml +++ b/src/util/messages.ml @@ -260,7 +260,7 @@ let msg severity ?loc ?(tags=[]) ?(category=Category.Unknown) fmt = Pretty.gprintf finish fmt ) else - Tracing.mygprintf () fmt + GobPretty.igprintf () fmt let msg_noloc severity ?(tags=[]) ?(category=Category.Unknown) fmt = if !GU.should_warn && Severity.should_warn severity && (Category.should_warn category || Tags.should_warn tags) then ( @@ -271,7 +271,7 @@ let msg_noloc severity ?(tags=[]) ?(category=Category.Unknown) fmt = Pretty.gprintf finish fmt ) else - Tracing.mygprintf () fmt + GobPretty.igprintf () fmt let msg_group severity ?(tags=[]) ?(category=Category.Unknown) fmt = if !GU.should_warn && Severity.should_warn severity && (Category.should_warn category || Tags.should_warn tags) then ( @@ -286,7 +286,7 @@ let msg_group severity ?(tags=[]) ?(category=Category.Unknown) fmt = Pretty.gprintf finish fmt ) else - Tracing.mygprintf (fun msgs -> ()) fmt + GobPretty.igprintf (fun msgs -> ()) fmt (* must eta-expand to get proper (non-weak) polymorphism for format *) let warn ?loc = msg Warning ?loc diff --git a/src/util/tracing.ml b/src/util/tracing.ml index ea1183ac98..e3bcdc6126 100644 --- a/src/util/tracing.ml +++ b/src/util/tracing.ml @@ -31,56 +31,6 @@ let indent_level = ref 0 let traceIndent () = indent_level := !indent_level + 2 let traceOutdent () = indent_level := !indent_level - 2 -(* Parses a format string to generate a nop-function of the correct type. *) -let mygprintf (finish: 'b) (format : ('a, unit, doc, 'b) format4) : 'a = - let format = string_of_format format in - let flen = String.length format in - let fget = String.unsafe_get format in - let rec literal acc i = - let rec skipChars j = - if j >= flen || (match fget j with '%' | '@' | '\n' -> true | _ -> false) then - collect nil j - else - skipChars (succ j) - in - skipChars (succ i) - and collect (acc: doc) (i: int) = - if i >= flen then begin - Obj.magic finish - end else begin - let c = fget i in - if c = '%' then begin - let j = skip_args (succ i) in - match fget j with - '%' -> literal acc j - | ',' -> collect acc (succ j) - | 's' | 'c' | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' - | 'f' | 'e' | 'E' | 'g' | 'G' | 'b' | 'B' -> - Obj.magic(fun b -> collect nil (succ j)) - | 'L' | 'l' | 'n' -> Obj.magic(fun n -> collect nil (succ (succ j))) - | 'a' -> Obj.magic(fun pprinter arg -> collect nil (succ j)) - | 't' -> Obj.magic(fun pprinter -> collect nil (succ j)) - | c -> invalid_arg ("dprintf: unknown format %s" ^ String.make 1 c) - end else if c = '@' then begin - if i + 1 < flen then begin - match fget (succ i) with - '[' | ']' | '!' | '?' | '^' | '@' -> collect nil (i + 2) - | '<' | '>' -> collect nil (i + 1) - | c -> invalid_arg ("dprintf: unknown format @" ^ String.make 1 c) - end else - invalid_arg "dprintf: incomplete format @" - end else if c = '\n' then begin - collect nil (i + 1) - end else - literal acc i - end - and skip_args j = - match String.unsafe_get format j with - '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j) - | c -> j - in - collect nil 0 - let traceTag (sys : string) : Pretty.doc = let rec ind (i : int) : string = if (i <= 0) then "" else " " ^ (ind (i-1)) in (text ((ind !indent_level) ^ "%%% " ^ sys ^ ": ")) @@ -104,7 +54,7 @@ let gtrace always f sys var ?loc do_subsys fmt = do_subsys (); gprintf (f sys) fmt end else - mygprintf () fmt + GobPretty.igprintf () fmt let trace sys ?var fmt = gtrace true printtrace sys var ignore fmt From 5c49c4060d7d625368b1383740ea00289d1dff2a Mon Sep 17 00:00:00 2001 From: karoliineh Date: Wed, 17 May 2023 16:40:02 +0300 Subject: [PATCH 200/518] Disable cil allowDuplication --- src/util/cilfacade.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml index d266083376..50906ae503 100644 --- a/src/util/cilfacade.ml +++ b/src/util/cilfacade.ml @@ -38,7 +38,8 @@ let init () = Mergecil.ignore_merge_conflicts := true; (* lineDirectiveStyle := None; *) RmUnused.keepUnused := true; - print_CIL_Input := true + print_CIL_Input := true; + Cabs2cil.allowDuplication := false let current_file = ref dummyFile From 6a1bc3a1eaba3113d71d34ac9b7c1ba89baf51b1 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Wed, 17 May 2023 19:45:13 +0200 Subject: [PATCH 201/518] Added Apple's version of str(n)cpy and str(n)cat to library functions + cleaned up unused code --- src/analyses/libraryFunctions.ml | 21 +++++++++----------- src/cdomains/addressDomain.ml | 33 -------------------------------- 2 files changed, 9 insertions(+), 45 deletions(-) diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 68ce1bfa2c..9492f25b94 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -16,12 +16,21 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__builtin_memcpy", special [__ "dest" [w]; __ "src" [r]; drop "n" []] @@ fun dest src -> Memcpy { dest; src }); ("__builtin___memcpy_chk", special [__ "dest" [w]; __ "src" [r]; drop "n" []; drop "os" []] @@ fun dest src -> Memcpy { dest; src }); ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; n = None; }); + ("__builtin_strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; n = None; }); + ("__builtin___strcpy_chk", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; n = None; }); ("strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); + ("__builtin_strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); + ("__builtin___strncpy_chk", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); + ("__builtin_strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); + ("__builtin___strcat_chk", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); ("strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); + ("__builtin_strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); + ("__builtin___strncat_chk", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); ("strstr", special [__ "haystack" [r]; __ "needle" [r]] @@ fun haystack needle -> Strstr { haystack; needle; }); ("strcmp", special [__ "s1" [r]; __ "s2" [r]] @@ fun s1 s2 -> Strcmp { s1; s2; n = None; }); + ("__builtin_strcmp", special [__ "s1" [r]; __ "s2" [r]] @@ fun s1 s2 -> Strcmp { s1; s2; n = None; }); ("strncmp", special [__ "s1" [r]; __ "s2" [r]; __ "n" []] @@ fun s1 s2 n -> Strcmp { s1; s2; n = Some n; }); ("malloc", special [__ "size" []] @@ fun size -> Malloc size); ("realloc", special [__ "ptr" [r; f]; __ "size" []] @@ fun ptr size -> Realloc { ptr; size }); @@ -675,12 +684,7 @@ let invalidate_actions = [ "__builtin___snprintf_chk", writes [1];(*keep [1]*) "sprintf", writes [1];(*keep [1]*) "sscanf", writesAllButFirst 2 readsAll;(*drop 2*) - "strcmp", readsAll;(*safe*) "strftime", writes [1];(*keep [1]*) - "strlen", readsAll;(*safe*) - "strncmp", readsAll;(*safe*) - "strncat", writes [1];(*keep [1]*) - "strstr", readsAll;(*safe*) "strdup", readsAll;(*safe*) "toupper", readsAll;(*safe*) "tolower", readsAll;(*safe*) @@ -699,7 +703,6 @@ let invalidate_actions = [ "sigfillset", writesAll; (*unsafe*) "sigprocmask", writesAll; (*unsafe*) "uname", writesAll;(*unsafe*) - "__builtin_strcmp", readsAll;(*safe*) "getopt_long", writesAllButFirst 2 readsAll;(*drop 2*) "__strdup", readsAll;(*safe*) "strtoul__extinline", readsAll;(*safe*) @@ -749,12 +752,6 @@ let invalidate_actions = [ "stat__extinline", writesAllButFirst 1 readsAll;(*drop 1*) "lstat__extinline", writesAllButFirst 1 readsAll;(*drop 1*) "__builtin_strchr", readsAll;(*safe*) - "__builtin___strcpy", writes [1];(*keep [1]*) - "__builtin___strcpy_chk", writes [1];(*keep [1]*) - "__builtin___strncpy_chk", writes [1];(*keep [1]*) - "strcat", writes [1];(*keep [1]*) - "__builtin___strcat_chk", writes[1];(*keep [1]*) - "__builtin___strncat_chk", writes[1];(*keep [1]*) "strtok", readsAll;(*safe*) "getpgrp", readsAll;(*safe*) "umount2", readsAll;(*safe*) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 16a755cd0c..342e756779 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -106,16 +106,6 @@ struct let to_string x = List.filter_map Addr.to_string (elements x) - let to_n_string n x = - let transform n elem = - match Addr.to_n_string n elem with - | Some s -> from_string s - | None -> top_ptr in - (* maps any StrPtr for which n is valid to the prefix of length n of its content, otherwise maps to top *) - List.map (transform n) (elements x) - (* and returns the least upper bound of computed AddressDomain values *) - |> List.fold_left join (bot ()) - let to_string_length x = let transform elem = match Addr.to_string_length elem with @@ -125,29 +115,6 @@ struct List.map transform (elements x) (* and returns the least upper bound of computed IntDomain values *) |> List.fold_left Idx.join (Idx.bot_of IUInt) - - let string_concat x y n = - let f = match n with - | Some num -> Addr.to_n_string num - | None -> Addr.to_string in - - (* map all StrPtr elements in input address sets to contained strings / n-substrings *) - let x' = List.map Addr.to_string (elements x) in - let y' = List.map f (elements y) in - - (* helper function *) - let extract_string = function - | Some s -> s - | None -> failwith "unreachable" in - - (* if any of the input address sets contains an element that isn't a StrPtr, return top *) - if List.exists ((=) None) x' || List.exists ((=) None) y' then - top_ptr - else - (* else concatenate every string of x' with every string of y' and return the least upper bound *) - BatList.cartesian_product x' y' - |> List.map (fun (s1, s2) -> from_string ((extract_string s1) ^ (extract_string s2))) - |> List.fold_left join (bot ()) let substring_extraction haystack needle = (* map all StrPtr elements in input address sets to contained strings *) From cea104f4dfe51d74c980dd105d6cefa6aa59f5dc Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Wed, 17 May 2023 20:28:04 +0200 Subject: [PATCH 202/518] Added missing argument of chk versions of strcpy and co. --- src/analyses/libraryFunctions.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 9492f25b94..e8d30160fe 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -17,16 +17,16 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__builtin___memcpy_chk", special [__ "dest" [w]; __ "src" [r]; drop "n" []; drop "os" []] @@ fun dest src -> Memcpy { dest; src }); ("strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; n = None; }); ("__builtin_strcpy", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; n = None; }); - ("__builtin___strcpy_chk", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcpy { dest; src; n = None; }); + ("__builtin___strcpy_chk", special [__ "dest" [w]; __ "src" [r]; drop "os" []] @@ fun dest src -> Strcpy { dest; src; n = None; }); ("strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); ("__builtin_strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); - ("__builtin___strncpy_chk", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); + ("__builtin___strncpy_chk", special [__ "dest" [w]; __ "src" [r]; __ "n" []; drop "os" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); ("__builtin_strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); - ("__builtin___strcat_chk", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); + ("__builtin___strcat_chk", special [__ "dest" [w]; __ "src" [r]; drop "os" []] @@ fun dest src -> Strcat { dest; src; n = None; }); ("strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); ("__builtin_strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); - ("__builtin___strncat_chk", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); + ("__builtin___strncat_chk", special [__ "dest" [w]; __ "src" [r]; __ "n" []; drop "os" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); ("strstr", special [__ "haystack" [r]; __ "needle" [r]] @@ fun haystack needle -> Strstr { haystack; needle; }); ("strcmp", special [__ "s1" [r]; __ "s2" [r]] @@ fun s1 s2 -> Strcmp { s1; s2; n = None; }); From 4acfb23d4f312d5dc741a3287ba168f1230969a1 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Wed, 17 May 2023 21:03:02 +0200 Subject: [PATCH 203/518] Added __builtin_object_size to invalide_actions --- src/analyses/libraryFunctions.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index e8d30160fe..4f1addbfdf 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -744,6 +744,7 @@ let invalidate_actions = [ "pthread_sigmask", writesAllButFirst 2 readsAll;(*unsafe*) "raise", writesAll;(*unsafe*) "_strlen", readsAll;(*safe*) + "__builtin_object_size", readsAll;(*safe*) "__builtin_alloca", readsAll;(*safe*) "dlopen", readsAll;(*safe*) "dlsym", readsAll;(*safe*) From 8bb9e09e3c700c9037a1f1441be1a052c4489cd7 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 May 2023 12:18:08 +0300 Subject: [PATCH 204/518] Add TODOs for non-working array invariant unassumes --- src/cdomains/arrayDomain.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index 1510c85b2f..c8a8713af7 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -194,6 +194,7 @@ struct let set ask (xl, xr) (ie, i) v = match ie with | Some ie when CilType.Exp.equal ie Lval.all_index_exp -> + (* TODO: Doesn't seem to work for unassume because unrolled elements are top-initialized, not bot-initialized. *) (BatList.make (factor ()) v, v) | _ -> set ask (xl, xr) (ie, i) v @@ -481,6 +482,7 @@ struct if M.tracing then M.trace "update_offset" "part array set_with_length %a %s %a\n" pretty x (BatOption.map_default Basetype.CilExp.show "None" i) Val.pretty a; match i with | Some ie when CilType.Exp.equal ie Lval.all_index_exp -> + (* TODO: Doesn't seem to work for unassume. *) Joint a | Some i when CilType.Exp.equal i Lval.any_index_exp -> (assert !Goblintutil.global_initialization; (* just joining with xm here assumes that all values will be set, which is guaranteed during inits *) From 5c2f363b7df2b9ccb0e0df87a8c8dd2a3f558f8a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 May 2023 12:40:41 +0300 Subject: [PATCH 205/518] Fix --html when run from elsewhere --- src/util/options.schema.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 2a4f94c5c9..ef3b36df43 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -1651,9 +1651,9 @@ }, "g2html_path": { "title": "exp.g2html_path", - "description": "Location of the g2html.jar file.", + "description": "Location of the g2html.jar file. If empty, then goblint executable directory is used.", "type": "string", - "default": "." + "default": "" }, "extraspecials": { "title": "exp.extraspecials", From 0084c6e80e68eb831fcc345be26daf8d2fab443b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 May 2023 12:46:36 +0300 Subject: [PATCH 206/518] Clean up Maingoblint.do_html_output --- src/maingoblint.ml | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/maingoblint.ml b/src/maingoblint.ml index 3323b07430..459faa937d 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -557,18 +557,24 @@ let do_analyze change_info merged_AST = ) let do_html_output () = - (* TODO: Fpath *) - let jar = Filename.concat (get_string "exp.g2html_path") "g2html.jar" in if get_bool "g2html" then ( - if Sys.file_exists jar then ( - let command = "java -jar "^ jar ^" --num-threads " ^ (string_of_int (jobs ())) ^ " --dot-timeout 0 --result-dir "^ (get_string "outfile")^" "^ !Messages.xml_file_name in - try match Timing.wrap "g2html" Unix.system command with - | Unix.WEXITED 0 -> () - | _ -> eprintf "HTML generation failed! Command: %s\n" command - with Unix.Unix_error (e, f, a) -> + let jar = Fpath.(v (get_string "exp.g2html_path") / "g2html.jar") in + if Sys.file_exists (Fpath.to_string jar) then ( + let command = Filename.quote_command "java" [ + "-jar"; Fpath.to_string jar; + "--num-threads"; string_of_int (jobs ()); + "--dot-timeout"; "0"; + "--result-dir"; get_string "outfile"; + !Messages.xml_file_name + ] + in + match Timing.wrap "g2html" Unix.system command with + | Unix.WEXITED 0 -> () + | _ -> eprintf "HTML generation failed! Command: %s\n" command + | exception Unix.Unix_error (e, f, a) -> eprintf "%s at syscall %s with argument \"%s\".\n" (Unix.error_message e) f a ) else - eprintf "Warning: jar file %s not found.\n" jar + Format.eprintf "Warning: jar file %a not found.\n" Fpath.pp jar ) let do_gobview cilfile = From 622da5d3ef58eb5ee9294c4d13dd7f30736977c9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 May 2023 18:17:22 +0300 Subject: [PATCH 207/518] Remove dbg.debug option --- conf/incremental.json | 4 +++- conf/minimal_incremental.json | 4 +++- docs/developer-guide/firstanalysis.md | 2 +- docs/developer-guide/testing.md | 2 +- regtest.sh | 2 +- scripts/creduce/privPrecCompare.sh | 2 +- scripts/spec/check.sh | 2 +- scripts/test-incremental-multiple.sh | 2 +- scripts/test-incremental.sh | 2 +- scripts/update_suite.rb | 6 +++--- src/analyses/spec.ml | 1 - src/domains/access.ml | 8 +------- src/framework/control.ml | 2 +- src/maingoblint.ml | 3 --- src/solvers/postSolver.ml | 2 +- src/util/options.schema.json | 6 ------ tests/incremental/00-basic/09-unreach.json | 2 +- tests/incremental/00-basic/10-reach.json | 2 +- tests/incremental/00-basic/11-unreach-reusesuper.json | 2 +- 19 files changed, 22 insertions(+), 34 deletions(-) diff --git a/conf/incremental.json b/conf/incremental.json index 3d8a20416c..a9c5fcd152 100644 --- a/conf/incremental.json +++ b/conf/incremental.json @@ -28,11 +28,13 @@ "trace": { "context": true }, - "debug": true, "timing": { "enabled": true } }, + "warn": { + "debug": true + }, "result": "none", "solver": "td3", "solvers": { diff --git a/conf/minimal_incremental.json b/conf/minimal_incremental.json index a92468c698..4eb9f8289a 100644 --- a/conf/minimal_incremental.json +++ b/conf/minimal_incremental.json @@ -27,11 +27,13 @@ "trace": { "context": true }, - "debug": true, "timing": { "enabled": true } }, + "warn": { + "debug": true + }, "result": "none", "solver": "td3", "solvers": { diff --git a/docs/developer-guide/firstanalysis.md b/docs/developer-guide/firstanalysis.md index 38668c28da..b2ce143828 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 dbg.debug tests/regression/99-tutorials/01-first.c +./goblint --enable warn.debug tests/regression/99-tutorials/01-first.c ``` This will claim that the assertion in unknown. diff --git a/docs/developer-guide/testing.md b/docs/developer-guide/testing.md index e185ce554b..3ab442424b 100644 --- a/docs/developer-guide/testing.md +++ b/docs/developer-guide/testing.md @@ -24,7 +24,7 @@ gobopt='--set ana.base.privatization write+lock' ./scripts/update_suite.rb ``` ### Writing -* Add parameters to a regression test in the first line: `// PARAM: --set dbg.debug true` +* Add parameters to a regression test in the first line: `// PARAM: --set warn.debug true` * Annotate lines inside the regression test with comments: `arr[9] = 10; // WARN` ## Cram Tests diff --git a/regtest.sh b/regtest.sh index e89278a551..488dd0bab4 100755 --- a/regtest.sh +++ b/regtest.sh @@ -14,7 +14,7 @@ if [[ $OSTYPE == 'darwin'* ]]; then grep="ggrep" fi params="`$grep -oP "PARAM: \K.*" $file`" -cmd="./goblint --enable dbg.debug --enable dbg.regression --html $params ${@:3} $file" # -v +cmd="./goblint --enable warn.debug --enable dbg.regression --html $params ${@:3} $file" # -v echo "$cmd" eval $cmd echo "See result/index.xml" diff --git a/scripts/creduce/privPrecCompare.sh b/scripts/creduce/privPrecCompare.sh index 2608034d28..fdc5f9219d 100755 --- a/scripts/creduce/privPrecCompare.sh +++ b/scripts/creduce/privPrecCompare.sh @@ -22,7 +22,7 @@ for PRIV in "${PRIVS[@]}"; do PRIVDUMP="$OUTDIR/$PRIV" LOG="$OUTDIR/$PRIV.log" rm -f $PRIVDUMP - $GOBLINTDIR/goblint --sets exp.privatization $PRIV --sets exp.priv-prec-dump $PRIVDUMP $OPTS -v --enable dbg.debug &> $LOG + $GOBLINTDIR/goblint --sets exp.privatization $PRIV --sets exp.priv-prec-dump $PRIVDUMP $OPTS -v --enable warn.debug &> $LOG grep -F "Function definition missing" $LOG && exit 1 done diff --git a/scripts/spec/check.sh b/scripts/spec/check.sh index a69fac5007..57b63edfd2 100755 --- a/scripts/spec/check.sh +++ b/scripts/spec/check.sh @@ -12,7 +12,7 @@ else ana="spec" opt="--set ana.spec.file $spec" fi -cmd="./goblint --set ana.activated[0][+] $ana $opt --html --set dbg.debug $debug $file" +cmd="./goblint --set ana.activated[0][+] $ana $opt --html --set warn.debug $debug $file" echo -e "$(tput setaf 6)$cmd$(tput sgr 0)" $cmd diff --git a/scripts/test-incremental-multiple.sh b/scripts/test-incremental-multiple.sh index 7afdadf6a0..8b56b2f6c5 100644 --- a/scripts/test-incremental-multiple.sh +++ b/scripts/test-incremental-multiple.sh @@ -7,7 +7,7 @@ conf=$base/$test.json patch1=$base/${test}_1.patch patch2=$base/${test}_2.patch -args="--enable dbg.debug --enable dbg.timing.enabled -v" +args="--enable warn.debug --enable dbg.timing.enabled -v" cat $source diff --git a/scripts/test-incremental.sh b/scripts/test-incremental.sh index 5047390718..ae5022d1bd 100755 --- a/scripts/test-incremental.sh +++ b/scripts/test-incremental.sh @@ -11,7 +11,7 @@ source=$base/$test.c conf=$base/$test.json patch=$base/$test.patch -args="--enable dbg.debug --enable dbg.timing.enabled -v --enable allglobs" +args="--enable warn.debug --enable dbg.timing.enabled -v --enable allglobs" ./goblint --conf $conf $args --enable incremental.save $source &> $base/$test.before.log diff --git a/scripts/update_suite.rb b/scripts/update_suite.rb index 5e65bb8c6c..e99068829e 100755 --- a/scripts/update_suite.rb +++ b/scripts/update_suite.rb @@ -496,8 +496,8 @@ def create_test_set(lines) end def run () filename = File.basename(@path) - cmd1 = "#{$goblint} #{filename} #{@params} #{ENV['gobopt']} 1>#{@testset.warnfile}0 --enable dbg.debug --set dbg.timing.enabled true --enable witness.yaml.enabled --set goblint-dir .goblint-#{@id.sub('/','-')}-witness1 2>#{@testset.statsfile}0" - cmd2 = "#{$goblint} #{filename} #{@params} #{ENV['gobopt']} 1>#{@testset.warnfile} --set ana.activated[+] unassume --enable dbg.debug --set dbg.timing.enabled true --set witness.yaml.unassume witness.yml --set goblint-dir .goblint-#{@id.sub('/','-')}-witness2 2>#{@testset.statsfile}" + cmd1 = "#{$goblint} #{filename} #{@params} #{ENV['gobopt']} 1>#{@testset.warnfile}0 --enable warn.debug --set dbg.timing.enabled true --enable witness.yaml.enabled --set goblint-dir .goblint-#{@id.sub('/','-')}-witness1 2>#{@testset.statsfile}0" + cmd2 = "#{$goblint} #{filename} #{@params} #{ENV['gobopt']} 1>#{@testset.warnfile} --set ana.activated[+] unassume --enable warn.debug --set dbg.timing.enabled true --set witness.yaml.unassume witness.yml --set goblint-dir .goblint-#{@id.sub('/','-')}-witness2 2>#{@testset.statsfile}" starttime = Time.now run_testset(@testset, cmd1, starttime) starttime = Time.now @@ -544,7 +544,7 @@ def run () if $1 then params = $1 else params = "" end end # always enable debugging so that the warnings would work - params << " --set dbg.debug true" + params << " --set warn.debug true" p = if incremental then patch = f[0..-3] + ".patch" patch_path = File.expand_path(patch, grouppath) diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml index bac6dc8e65..2fb56cca53 100644 --- a/src/analyses/spec.ml +++ b/src/analyses/spec.ml @@ -444,7 +444,6 @@ struct | _ -> ctx.local let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = - (* let _ = GobConfig.set_bool "dbg.debug" false in *) let arglist = List.map (Cil.stripCasts) arglist in (* remove casts, TODO safe? *) let get_key c = match SC.get_key_variant c with | `Lval s -> diff --git a/src/domains/access.ml b/src/domains/access.ml index e87dd3f6ce..8d9d585015 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -462,17 +462,11 @@ let incr_summary safe vulnerable unsafe (lv, ty) grouped_accs = let print_accesses (lv, ty) grouped_accs = let allglobs = get_bool "allglobs" in - let debug = get_bool "dbg.debug" in let race_threshold = get_int "warn.race-threshold" in let msgs race_accs = let h (conf,kind,node,e,a) = let d_msg () = dprintf "%a with %a (conf. %d)" AccessKind.pretty kind MCPAccess.A.pretty a conf in - let doc = - if debug then - dprintf "%t (exp: %a)" d_msg d_exp e - else - d_msg () - in + let doc = dprintf "%t (exp: %a)" d_msg d_exp e in (doc, Some (Messages.Location.Node node)) in AS.elements race_accs diff --git a/src/framework/control.ml b/src/framework/control.ml index 699cfb4147..823f3eb375 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -590,7 +590,7 @@ struct (* check for dead code at the last state: *) let main_sol = try LHT.find lh (List.hd startvars') with Not_found -> Spec.D.bot () in - if get_bool "dbg.debug" && Spec.D.is_bot main_sol then + if Spec.D.is_bot main_sol then M.warn_noloc ~category:Deadcode "Function 'main' does not return"; if get_bool "dump_globs" then diff --git a/src/maingoblint.ml b/src/maingoblint.ml index 459faa937d..51f4a9400f 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -170,9 +170,6 @@ let handle_flags () = Errormsg.verboseFlag := true ); - if get_bool "dbg.debug" then - set_bool "warn.debug" true; - if get_bool "ana.sv-comp.functions" then set_auto "lib.activated[+]" "sv-comp"; diff --git a/src/solvers/postSolver.ml b/src/solvers/postSolver.ml index 021f5a0b62..faa5f28083 100644 --- a/src/solvers/postSolver.ml +++ b/src/solvers/postSolver.ml @@ -61,7 +61,7 @@ module Prune: F = include Unit (S) (VH) let finalize ~vh ~reachable = - if get_bool "dbg.debug" then + if get_bool "dbg.verbose" then print_endline "Pruning result"; VH.filteri_inplace (fun x _ -> diff --git a/src/util/options.schema.json b/src/util/options.schema.json index ef3b36df43..23f2860f73 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -1737,12 +1737,6 @@ "description": "Debugging options", "type": "object", "properties": { - "debug": { - "title": "dbg.debug", - "description": "Debug mode: for testing the analyzer itself.", - "type": "boolean", - "default": false - }, "verbose": { "title": "dbg.verbose", "description": "Prints some status information.", diff --git a/tests/incremental/00-basic/09-unreach.json b/tests/incremental/00-basic/09-unreach.json index c1e5e17542..6b4665a772 100644 --- a/tests/incremental/00-basic/09-unreach.json +++ b/tests/incremental/00-basic/09-unreach.json @@ -1,5 +1,5 @@ { - "dbg": { + "warn": { "debug": true }, "incremental" : { diff --git a/tests/incremental/00-basic/10-reach.json b/tests/incremental/00-basic/10-reach.json index c1e5e17542..6b4665a772 100644 --- a/tests/incremental/00-basic/10-reach.json +++ b/tests/incremental/00-basic/10-reach.json @@ -1,5 +1,5 @@ { - "dbg": { + "warn": { "debug": true }, "incremental" : { diff --git a/tests/incremental/00-basic/11-unreach-reusesuper.json b/tests/incremental/00-basic/11-unreach-reusesuper.json index ef6bdab239..c0f0363135 100644 --- a/tests/incremental/00-basic/11-unreach-reusesuper.json +++ b/tests/incremental/00-basic/11-unreach-reusesuper.json @@ -1,5 +1,5 @@ { - "dbg": { + "warn": { "debug": true }, "incremental" : { From 5753fc06d6d6f854fd4dd75022f83dae989ca60d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 May 2023 18:48:20 +0300 Subject: [PATCH 208/518] Promote cram test changes --- tests/regression/00-sanity/01-assert.t | 1 + tests/regression/04-mutex/01-simple_rc.t | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/tests/regression/00-sanity/01-assert.t b/tests/regression/00-sanity/01-assert.t index a0a26e4bed..7205b70357 100644 --- a/tests/regression/00-sanity/01-assert.t +++ b/tests/regression/00-sanity/01-assert.t @@ -2,6 +2,7 @@ [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Deadcode] Function 'main' does not return [Warning][Deadcode] Function 'main' has dead code: on lines 13..14 (01-assert.c:13-14) [Warning][Deadcode] Logical lines of code (LLoC) summary: diff --git a/tests/regression/04-mutex/01-simple_rc.t b/tests/regression/04-mutex/01-simple_rc.t index 3c38c73394..c55edf4d33 100644 --- a/tests/regression/04-mutex/01-simple_rc.t +++ b/tests/regression/04-mutex/01-simple_rc.t @@ -4,10 +4,10 @@ dead: 0 total lines: 12 [Warning][Race] Memory location myglobal@01-simple_rc.c:4:5-4:13 (race with conf. 110): - write with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40]] (conf. 110) (01-simple_rc.c:10:3-10:22) - write with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40]}}, lock:{mutex2}, thread:[main]] (conf. 110) (01-simple_rc.c:19:3-19:22) - read with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40]] (conf. 110) (01-simple_rc.c:10:3-10:22) - read with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40]}}, lock:{mutex2}, thread:[main]] (conf. 110) (01-simple_rc.c:19:3-19:22) + write with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40]] (conf. 110) (exp: & myglobal) (01-simple_rc.c:10:3-10:22) + write with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40]}}, lock:{mutex2}, thread:[main]] (conf. 110) (exp: & myglobal) (01-simple_rc.c:19:3-19:22) + read with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40]] (conf. 110) (exp: & myglobal) (01-simple_rc.c:10:3-10:22) + read with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40]}}, lock:{mutex2}, thread:[main]] (conf. 110) (exp: & myglobal) (01-simple_rc.c:19:3-19:22) [Info][Race] Memory locations race summary: safe: 0 vulnerable: 0 From 527ee456779404b2063e033c956b437f26094941 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt <73504207+nathanschmidt@users.noreply.github.com> Date: Sat, 20 May 2023 21:37:04 +0200 Subject: [PATCH 209/518] Excluded str(n)cpy / str(n)cat portion of string literals test for macOS --- .../71-strings/01-string_literals.c | 31 +++++++++++-------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index d2cf30ef7b..d004fd3aff 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -59,19 +59,24 @@ int main() { i = strncmp(s1, s2, 5); __goblint_check(i != 0); + + #ifdef __APPLE__ + /* the following portion fails on macOS because of a spurious warning: + * see issue goblint/cil#143 */ + #else + strcpy(s1, "hi"); // WARN + strncpy(s1, "hi", 1); // WARN + strcat(s1, "hi"); // WARN + strncat(s1, "hi", 1); // WARN + + char s4[] = "hello"; + strcpy(s4, s2); // NOWARN + strncpy(s4, s3, 2); // NOWARN - strcpy(s1, "hi"); // WARN - strncpy(s1, "hi", 1); // WARN - strcat(s1, "hi"); // WARN - strncat(s1, "hi", 1); // WARN - - char s4[] = "hello"; - strcpy(s4, s2); // NOWARN - strncpy(s4, s3, 2); // NOWARN - - char s5[13] = "hello"; - strcat(s5, " world"); // NOWARN - strncat(s5, "! some further text", 1); // NOWARN + char s5[13] = "hello"; + strcat(s5, " world"); // NOWARN + strncat(s5, "! some further text", 1); // NOWARN + #endif return 0; -} \ No newline at end of file +} From 50193f2ec488e83d55e267db6aa76c0c2d488404 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt <73504207+nathanschmidt@users.noreply.github.com> Date: Sat, 20 May 2023 22:03:53 +0200 Subject: [PATCH 210/518] Changed test annotations until CIL issue fixed --- tests/regression/71-strings/01-string_literals.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index d004fd3aff..c8cb359bc9 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -64,10 +64,10 @@ int main() { /* the following portion fails on macOS because of a spurious warning: * see issue goblint/cil#143 */ #else - strcpy(s1, "hi"); // WARN - strncpy(s1, "hi", 1); // WARN - strcat(s1, "hi"); // WARN - strncat(s1, "hi", 1); // WARN + strcpy(s1, "hi"); // will warn -- change to normal annotation when issue fixed + strncpy(s1, "hi", 1); // will warn + strcat(s1, "hi"); // will warn + strncat(s1, "hi", 1); // will warn char s4[] = "hello"; strcpy(s4, s2); // NOWARN From d501f9296331d2e110f3c54578ffc278e1bedda7 Mon Sep 17 00:00:00 2001 From: Stanimir Bozhilov Date: Sun, 21 May 2023 16:20:16 +0200 Subject: [PATCH 211/518] Add documentation about Goblint's transfer functions --- docs/developer-guide/firstanalysis.md | 1 + src/framework/analyses.ml | 26 +++++++++++++++++++++++++- 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/docs/developer-guide/firstanalysis.md b/docs/developer-guide/firstanalysis.md index 38668c28da..ea42ac8491 100644 --- a/docs/developer-guide/firstanalysis.md +++ b/docs/developer-guide/firstanalysis.md @@ -69,6 +69,7 @@ There is no need to implement the transfer functions for branching for this exam The assignment relies on the function `eval`, which is almost there. It just needs you to fix the evaluation of constants! Unless you jumped straight to this line, it should not be too complicated to fix this. With this in place, we should have sufficient information to tell Goblint that the assertion does hold. +For more information on the signature of the individual transfer functions, please check out their documentation in the file which they're defined in: [src/framework/analyses.ml](https://github.com/goblint/analyzer/blob/master/src/framework/analyses.ml#LL355C1-L355C17). ## Extending the domain diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index acac5a81eb..0c2ee2a791 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -384,16 +384,40 @@ sig val sync : (D.t, G.t, C.t, V.t) ctx -> [`Normal | `Join | `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., + it handles program points of the form "lval = rval;" *) val assign: (D.t, G.t, C.t, V.t) ctx -> lval -> exp -> D.t + + (* A transfer function typically used for handling variable arguments (varargs) *) val vdecl : (D.t, G.t, C.t, V.t) ctx -> varinfo -> D.t + + (** A transfer function which handles conditional branching yielding the + truth value passed as a boolean argument *) val branch: (D.t, G.t, C.t, V.t) ctx -> exp -> bool -> D.t + + (** A transfer function which handles going from the start node of a function (fundec) into + its function body. Meant to handle, e.g., initialization of local variables *) val body : (D.t, G.t, C.t, V.t) ctx -> fundec -> D.t + + (** A transfer function which handles the return statement, i.e., + "return exp" or "return" in the passed function (fundec) *) val return: (D.t, G.t, C.t, V.t) ctx -> exp option -> fundec -> D.t + + (* A transfer function meant to handle inline assembler program points *) val asm : (D.t, G.t, C.t, V.t) ctx -> D.t - val skip : (D.t, G.t, C.t, V.t) ctx -> D.t + (* A transfer function which works as the identity function, i.e., it skips and does nothing *) + val skip : (D.t, G.t, C.t, V.t) ctx -> D.t + (** A transfer function which, for a call to a _special_ function f "lval = f(args)" or "f(args)", + computes the caller state after the function call *) val special : (D.t, G.t, C.t, V.t) ctx -> lval option -> varinfo -> exp list -> D.t + + (** For a function call "lval = f(args)" or "f(args)", + [enter] returns a caller state, and the initial state of the callee. + In [enter], the caller state can usually be returned unchanged, as [combine_env] and [combine_assign] (below) + will compute the caller state after the function call, given the return state of the callee *) val enter : (D.t, G.t, C.t, V.t) ctx -> lval option -> fundec -> exp list -> (D.t * D.t) list (* Combine is split into two steps: *) From 7fd33417f49b163c921bdd06b0c1f690e26a4750 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Sun, 21 May 2023 18:21:17 +0200 Subject: [PATCH 212/518] Clarified test comments --- tests/regression/71-strings/01-string_literals.c | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index c8cb359bc9..d2dfda1497 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -62,12 +62,14 @@ int main() { #ifdef __APPLE__ /* the following portion fails on macOS because of a spurious warning: - * see issue goblint/cil#143 */ + * see issue goblint/cil#143 + * + * remove #ifdef portion and change "should warn" to "WARN" as soon as issue fixed */ #else - strcpy(s1, "hi"); // will warn -- change to normal annotation when issue fixed - strncpy(s1, "hi", 1); // will warn - strcat(s1, "hi"); // will warn - strncat(s1, "hi", 1); // will warn + strcpy(s1, "hi"); // should warn + strncpy(s1, "hi", 1); // should warn + strcat(s1, "hi"); // should warn + strncat(s1, "hi", 1); // should warn char s4[] = "hello"; strcpy(s4, s2); // NOWARN From db30ec3a9d26ac3bf34b6059d98a7e286c9ff420 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Sun, 21 May 2023 19:00:32 +0200 Subject: [PATCH 213/518] Fixed false warning --- tests/regression/71-strings/01-string_literals.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index d2dfda1497..29d4df513e 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -64,7 +64,7 @@ int main() { /* the following portion fails on macOS because of a spurious warning: * see issue goblint/cil#143 * - * remove #ifdef portion and change "should warn" to "WARN" as soon as issue fixed */ + * remove #ifdef portion and change "should warn" to normal warning as soon as issue fixed */ #else strcpy(s1, "hi"); // should warn strncpy(s1, "hi", 1); // should warn From dc7c4d7f1b73ff724b883d1dfb593daf63a8ef4e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 22 May 2023 11:21:36 +0300 Subject: [PATCH 214/518] Add UniqueType marshaling TODO --- src/util/uniqueType.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/util/uniqueType.ml b/src/util/uniqueType.ml index b8733992e0..6df408fcc6 100644 --- a/src/util/uniqueType.ml +++ b/src/util/uniqueType.ml @@ -2,6 +2,8 @@ open GoblintCil (* Type invariant variables. *) let type_inv_tbl = Hashtbl.create 13 +(* TODO: This should probably be marshaled (for incremental mode) or even use RichVarinfo mapping. *) + let type_inv (c:compinfo) : varinfo = try Hashtbl.find type_inv_tbl c.ckey with Not_found -> From 3741881452cc0928a67ac0f6bd383fbed7ce0af2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 22 May 2023 11:36:08 +0300 Subject: [PATCH 215/518] Rename StackTrace.Spec name argument --- src/analyses/stackTrace.ml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/analyses/stackTrace.ml b/src/analyses/stackTrace.ml index 8af3bc5567..4ecb569bee 100644 --- a/src/analyses/stackTrace.ml +++ b/src/analyses/stackTrace.ml @@ -4,12 +4,11 @@ open GoblintCil open Analyses module LF = LibraryFunctions -module Spec (D: StackDomain.S) (P: sig val name : string end)= +module Spec (D: StackDomain.S) (N: sig val name : string end)= struct - module ArgP = P include Analyses.IdentitySpec - let name () = ArgP.name + let name () = N.name module D = D module C = D From 09276ca0fffa43d03bfe8a2de3d00145d2a9e316 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Mon, 22 May 2023 15:43:23 +0200 Subject: [PATCH 216/518] Improvements after review --- src/analyses/libraryFunctions.ml | 12 ++++++------ src/cdomains/addressDomain.ml | 16 +++++----------- src/cdomains/lval.ml | 6 +++++- tests/regression/71-strings/01-string_literals.c | 10 ++++++---- 4 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/analyses/libraryFunctions.ml b/src/analyses/libraryFunctions.ml index 4f1addbfdf..984fa086a2 100644 --- a/src/analyses/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -21,12 +21,12 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); ("__builtin_strncpy", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); ("__builtin___strncpy_chk", special [__ "dest" [w]; __ "src" [r]; __ "n" []; drop "os" []] @@ fun dest src n -> Strcpy { dest; src; n = Some n; }); - ("strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); - ("__builtin_strcat", special [__ "dest" [w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); - ("__builtin___strcat_chk", special [__ "dest" [w]; __ "src" [r]; drop "os" []] @@ fun dest src -> Strcat { dest; src; n = None; }); - ("strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); - ("__builtin_strncat", special [__ "dest" [w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); - ("__builtin___strncat_chk", special [__ "dest" [w]; __ "src" [r]; __ "n" []; drop "os" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); + ("strcat", special [__ "dest" [r; w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); + ("__builtin_strcat", special [__ "dest" [r; w]; __ "src" [r]] @@ fun dest src -> Strcat { dest; src; n = None; }); + ("__builtin___strcat_chk", special [__ "dest" [r; w]; __ "src" [r]; drop "os" []] @@ fun dest src -> Strcat { dest; src; n = None; }); + ("strncat", special [__ "dest" [r; w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); + ("__builtin_strncat", special [__ "dest" [r; w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); + ("__builtin___strncat_chk", special [__ "dest" [r; w]; __ "src" [r]; __ "n" []; drop "os" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); ("strstr", special [__ "haystack" [r]; __ "needle" [r]] @@ fun haystack needle -> Strstr { haystack; needle; }); ("strcmp", special [__ "s1" [r]; __ "s2" [r]] @@ fun s1 s2 -> Strcmp { s1; s2; n = None; }); diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 342e756779..3f385adcc0 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -122,9 +122,6 @@ struct let needle' = List.map Addr.to_string (elements needle) in (* helper functions *) - let extract_string = function - | Some s -> s - | None -> failwith "unreachable" in let extract_lval_string = function | Some s -> from_string s | None -> null_ptr in @@ -135,14 +132,14 @@ struct with Not_found -> None in (* if any of the input address sets contains an element that isn't a StrPtr, return top *) - if List.exists ((=) None) haystack' || List.exists ((=) None) needle' then + if List.mem None haystack' || List.mem None needle' then top_ptr else (* else try to find the first occurrence of all strings in needle' in all strings s of haystack', collect s starting from that occurrence or if there is none, collect a NULL pointer, and return the least upper bound *) BatList.cartesian_product haystack' needle' - |> List.map (fun (s1, s2) -> extract_lval_string (compute_substring (extract_string s1) (extract_string s2))) + |> List.map (fun (s1, s2) -> extract_lval_string (compute_substring (Option.get s1) (Option.get s2))) |> List.fold_left join (bot ()) let string_comparison x y n = @@ -155,9 +152,6 @@ struct let y' = List.map f (elements y) in (* helper functions *) - let extract_string = function - | Some s -> s - | None -> failwith "unreachable" in let compare s1 s2 = let res = String.compare s1 s2 in if res = 0 then @@ -168,17 +162,17 @@ struct Idx.ending IInt (Z.neg (Z.one)) in (* if any of the input address sets contains an element that isn't a StrPtr, return top *) - if List.exists ((=) None) x' || List.exists ((=) None) y' then + if List.mem None x' || List.mem None y' then Idx.top_of IInt else (* else compare every string of x' with every string of y' and return the least upper bound *) BatList.cartesian_product x' y' - |> List.map (fun (s1, s2) -> compare (extract_string s1) (extract_string s2)) + |> List.map (fun (s1, s2) -> compare (Option.get s1) (Option.get s2)) |> List.fold_left Idx.join (Idx.bot_of IInt) 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 (fun x -> match x with Some _ -> true | None -> false) (List.map Addr.to_string (elements dest)) then + if List.exists Option.is_some (List.map Addr.to_string (elements 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 diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 731060b686..2f7736c3ce 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -266,7 +266,11 @@ struct Some (String.sub x 0 n) | _ -> None let to_string_length = function - | StrPtr (Some x) -> Some (String.length x) + | StrPtr (Some x) -> + begin match String.split_on_char '\x00' x with + | s::_ -> Some (String.length s) + | [] -> None + end | _ -> None (* exception if the offset can't be followed completely *) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index 29d4df513e..9a7928e8b4 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -9,13 +9,14 @@ char* hello_world() { } void id(char* s) { - s = s; + strcpy(s, s); // should warn } int main() { char* s1 = "abcde"; char* s2 = "abcdfg"; char* s3 = hello_world(); + char* edge_case = "hello\0world"; int i = strlen(s1); __goblint_check(i == 5); @@ -26,9 +27,8 @@ int main() { i = strlen(s3); __goblint_check(i == 12); - id(s2); - i = strlen(s2); - __goblint_check(i == 6); + i = strlen(edge_case); + __goblint_check(i == 5); i = strcmp(s1, s2); __goblint_check(i < 0); @@ -66,6 +66,8 @@ int main() { * * remove #ifdef portion and change "should warn" to normal warning as soon as issue fixed */ #else + id(s2); + strcpy(s1, "hi"); // should warn strncpy(s1, "hi", 1); // should warn strcat(s1, "hi"); // should warn From 74e90e4526dc6230e9ef8592e911b8bed932be68 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Mon, 22 May 2023 15:45:16 +0200 Subject: [PATCH 217/518] Use Cil.kindOfSizeOf instead of IUInt for strlen --- src/cdomains/addressDomain.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 3f385adcc0..82ff0fa59d 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -109,12 +109,12 @@ struct let to_string_length x = let transform elem = match Addr.to_string_length elem with - | Some x -> Idx.of_int IUInt (Z.of_int x) - | None -> Idx.top_of IUInt in + | Some x -> Idx.of_int !Cil.kindOfSizeOf (Z.of_int x) + | None -> Idx.top_of !Cil.kindOfSizeOf in (* maps any StrPtr to the length of its content, otherwise maps to top *) List.map transform (elements x) (* and returns the least upper bound of computed IntDomain values *) - |> List.fold_left Idx.join (Idx.bot_of IUInt) + |> List.fold_left Idx.join (Idx.bot_of !Cil.kindOfSizeOf) let substring_extraction haystack needle = (* map all StrPtr elements in input address sets to contained strings *) From e92cc88d924bfce5290d091d0d8e3f0d829b8fee Mon Sep 17 00:00:00 2001 From: Nathan Schmidt <73504207+nathanschmidt@users.noreply.github.com> Date: Mon, 22 May 2023 15:58:45 +0200 Subject: [PATCH 218/518] Updated test 01 --- tests/regression/71-strings/01-string_literals.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index 9a7928e8b4..37aca6b7f8 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -66,7 +66,7 @@ int main() { * * remove #ifdef portion and change "should warn" to normal warning as soon as issue fixed */ #else - id(s2); + id(s2); // should warn strcpy(s1, "hi"); // should warn strncpy(s1, "hi", 1); // should warn From a903e753c695af1db3e597e1c7a4663748a743aa Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 22 May 2023 17:13:46 +0300 Subject: [PATCH 219/518] Add API docs workflow --- .github/workflows/docs.yml | 68 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 .github/workflows/docs.yml diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml new file mode 100644 index 0000000000..9944e678c4 --- /dev/null +++ b/.github/workflows/docs.yml @@ -0,0 +1,68 @@ +name: docs + +on: + push: + branches: + - api-docs # TODO: change to master + + workflow_dispatch: + +permissions: + contents: read + pages: write + id-token: write + +concurrency: + group: "pages" + cancel-in-progress: true + +jobs: + api-build: + strategy: + matrix: + os: + - ubuntu-latest + ocaml-compiler: + - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file + # don't add any other because they won't be used + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v3 + + - name: Set up OCaml ${{ matrix.ocaml-compiler }} + env: + # otherwise setup-ocaml pins non-locked dependencies + # https://github.com/ocaml/setup-ocaml/issues/166 + OPAMLOCKED: locked + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + + - name: Setup Pages + id: pages + uses: actions/configure-pages@v2 + + - name: Install dependencies + run: opam install . --deps-only --locked --with-doc + + - name: Build API docs + run: opam exec -- dune build @doc + + - name: Upload artifact + uses: actions/upload-pages-artifact@v1 + with: + path: _build/default/_doc/_html/ + + api-deploy: + environment: + name: github-pages + url: ${{ steps.deployment.outputs.page_url }} + runs-on: ubuntu-latest + needs: api-build + steps: + - name: Deploy to GitHub Pages + id: deployment + uses: actions/deploy-pages@v1 From 99cd65a8a1e755614da40fdade989b6bfd51fe08 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 22 May 2023 18:12:13 +0300 Subject: [PATCH 220/518] Add semi-organized Goblint_lib interface --- src/goblint_lib.ml | 305 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 305 insertions(+) create mode 100644 src/goblint_lib.ml diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml new file mode 100644 index 0000000000..f341ab9fc3 --- /dev/null +++ b/src/goblint_lib.ml @@ -0,0 +1,305 @@ + +(** {1 Framework} *) + +module Maingoblint = Maingoblint +module Server = Server + +module Analyses = Analyses +module Constraints = Constraints +module Control = Control +module ControlSpecC = ControlSpecC +module Events = Events +module Queries = Queries + +module MCP = MCP +module MCPAccess = MCPAccess +module MCPRegistry = MCPRegistry + +module PostSolver = PostSolver +module Refinement = Refinement + +module ResultQuery = ResultQuery +module VarQuery = VarQuery + +(** {2 CFG} *) + +module CfgTools = CfgTools +module Edge = Edge +module MyCFG = MyCFG +module Node = Node +module Node0 = Node0 + +(** {2 Configuration} *) + +module GobConfig = GobConfig +module AfterConfig = AfterConfig + +module AutoTune = AutoTune +module AutoTune0 = AutoTune0 +module JsonSchema = JsonSchema +module Options = Options + +(** {1 Analyses} *) + +module AbortUnless = AbortUnless +module AccessAnalysis = AccessAnalysis +module ActiveLongjmp = ActiveLongjmp +module ActiveSetjmp = ActiveSetjmp +module AffineEqualityAnalysis = AffineEqualityAnalysis +module ApronAnalysis = ApronAnalysis +module Assert = Assert +module Base = Base +module BasePriv = BasePriv +module CondVars = CondVars +module Constants = Constants +module Deadlock = Deadlock +module ExpRelation = ExpRelation +module Expsplit = Expsplit +module ExtractPthread = ExtractPthread +module FileUse = FileUse +module LocksetAnalysis = LocksetAnalysis +module MHPAnalysis = MHPAnalysis +module MallocFresh = MallocFresh +module MallocWrapperAnalysis = MallocWrapperAnalysis +module Malloc_null = Malloc_null +module MayLocks = MayLocks +module ModifiedSinceLongjmp = ModifiedSinceLongjmp +module MutexAnalysis = MutexAnalysis +module MutexEventsAnalysis = MutexEventsAnalysis +module ObserverAnalysis = ObserverAnalysis +module PoisonVariables = PoisonVariables +module PthreadSignals = PthreadSignals +module RaceAnalysis = RaceAnalysis +module Region = Region +module RelationAnalysis = RelationAnalysis +module RelationPriv = RelationPriv +module Signs = Signs +module Spec = Spec +module StackTrace = StackTrace +module SymbLocks = SymbLocks +module Taint = Taint +module TaintPartialContexts = TaintPartialContexts +module Termination = Termination +module ThreadAnalysis = ThreadAnalysis +module ThreadEscape = ThreadEscape +module ThreadFlag = ThreadFlag +module ThreadId = ThreadId +module ThreadJoins = ThreadJoins +module ThreadReturn = ThreadReturn +module UnassumeAnalysis = UnassumeAnalysis +module Uninit = Uninit +module UnitAnalysis = UnitAnalysis +module VarEq = VarEq +module Vla = Vla + +(** {1 Domains} *) + +module Printable = Printable +module Lattice = Lattice +module FlagHelper = FlagHelper + +(** {2 General} *) + +module BoolDomain = BoolDomain +module DisjointDomain = DisjointDomain +module HoareDomain = HoareDomain +module MapDomain = MapDomain +module PartitionDomain = PartitionDomain +module SetDomain = SetDomain + +(** {2 Analysis-specific} *) + +module Access = Access +module AccessDomain = AccessDomain +module AddressDomain = AddressDomain +module AffineEqualityDomain = AffineEqualityDomain +module ApronDomain = ApronDomain +module ArrayDomain = ArrayDomain +module BaseDomain = BaseDomain +module CilLval = CilLval +module ConcDomain = ConcDomain +module DeadlockDomain = DeadlockDomain +module EscapeDomain = EscapeDomain +module FileDomain = FileDomain +module FlagModeDomain = FlagModeDomain +module FloatDomain = FloatDomain +module IntDomain = IntDomain +module JmpBufDomain = JmpBufDomain +module LockDomain = LockDomain +module Lval = Lval +module LvalMapDomain = LvalMapDomain +module MHP = MHP +module MusteqDomain = MusteqDomain +module PreValueDomain = PreValueDomain +module PthreadDomain = PthreadDomain +module RegionDomain = RegionDomain +module RelationDomain = RelationDomain +module SpecDomain = SpecDomain +module StackDomain = StackDomain +module StructDomain = StructDomain +module SymbLocksDomain = SymbLocksDomain +module ThreadFlagDomain = ThreadFlagDomain +module ThreadIdDomain = ThreadIdDomain +module UnionDomain = UnionDomain +module ValueDomain = ValueDomain +module ValueDomainQueries = ValueDomainQueries + +(** {2 Testing} *) + +module AbstractionDomainProperties = AbstractionDomainProperties +module DomainProperties = DomainProperties +module IntDomainProperties = IntDomainProperties + +(** {1 Incremental} *) + +module CilMaps = CilMaps +module CompareAST = CompareAST +module CompareCFG = CompareCFG +module CompareCIL = CompareCIL +module MaxIdUtil = MaxIdUtil +module Serialize = Serialize +module UpdateCil = UpdateCil +module UpdateCil0 = UpdateCil0 + +(** {1 Transformation} *) + +module DeadCode = DeadCode +module EvalAssert = EvalAssert +module ExpressionEvaluation = ExpressionEvaluation +module Transform = Transform + +(** {1 Solvers} *) + +module EffectWConEq = EffectWConEq +module Generic = Generic +module LocalFixpoint = LocalFixpoint +module SLR = SLR +module SLRphased = SLRphased +module SLRterm = SLRterm +module Selector = Selector +module Td3 = Td3 +module TopDown = TopDown +module TopDown_deprecated = TopDown_deprecated +module TopDown_space_cache_term = TopDown_space_cache_term +module TopDown_term = TopDown_term +module Worklist = Worklist + +(** {1 Output} *) + +module MessageCategory = MessageCategory +module MessageUtil = MessageUtil +module Messages = Messages + +module Sarif = Sarif +module SarifRules = SarifRules +module SarifType = SarifType + +module Tracing = Tracing + +(** {1 Utility} *) + +module Goblintutil = Goblintutil + +module Timing = Timing + +module GoblintDir = GoblintDir + + +(** {2 General} *) + +module AccessKind = AccessKind +module Basetype = Basetype +module FloatOps = FloatOps +module IntOps = IntOps +module LazyEval = LazyEval +module LibraryDesc = LibraryDesc +module LibraryDsl = LibraryDsl +module LibraryFunctions = LibraryFunctions + +module PrecCompare = PrecCompare +module PrecCompareUtil = PrecCompareUtil + +module ProcessPool = ProcessPool +module ResettableLazy = ResettableLazy + +module SolverBox = SolverBox + +module TimeUtil = TimeUtil +module Timeout = Timeout +module XmlUtil = XmlUtil + +(** {2 CIL} *) + +module Cilfacade = Cilfacade +module Cilfacade0 = Cilfacade0 +module CilCfg = CilCfg +module CilType = CilType +module LoopUnrolling = LoopUnrolling +module RichVarinfo = RichVarinfo + +(** {2 Input} *) + +module CompilationDatabase = CompilationDatabase +module MakefileUtil = MakefileUtil +module Preprocessor = Preprocessor + +module SpecLexer = SpecLexer +module SpecParser = SpecParser + +(** {2 Analysis-specific} *) + +module ApronPrecCompareUtil = ApronPrecCompareUtil +module BaseInvariant = BaseInvariant +module BaseUtil = BaseUtil +module CommonPriv = CommonPriv +module ContextUtil = ContextUtil +module PrecisionUtil = PrecisionUtil +module PrivPrecCompareUtil = PrivPrecCompareUtil +module RelationPrecCompareUtil = RelationPrecCompareUtil +module SharedFunctions = SharedFunctions +module SpecCore = SpecCore +module SpecUtil = SpecUtil +module VectorMatrix = VectorMatrix +module WideningThresholds = WideningThresholds + +(** {2 Witnesses} *) + +module ArgTools = ArgTools +module Graphml = Graphml +module Invariant = Invariant +module InvariantCil = InvariantCil +module MyARG = MyARG +module ObserverAutomaton = ObserverAutomaton +module Svcomp = Svcomp +module SvcompSpec = SvcompSpec +module Violation = Violation +module ViolationZ3 = ViolationZ3 +module WideningTokens = WideningTokens +module Witness = Witness +module WitnessConstraints = WitnessConstraints +module WitnessUtil = WitnessUtil +module YamlWitness = YamlWitness +module YamlWitnessType = YamlWitnessType + +(** {2 Config} *) + +module ConfigOcaml = ConfigOcaml +module ConfigProfile = ConfigProfile +module ConfigVersion = ConfigVersion +module Version = Version + +(** {1 Library extensions} *) + +module GobUnix = GobUnix +module GobFormat = GobFormat +module GobFpath = GobFpath +module GobHashtbl = GobHashtbl +module GobList = GobList +module GobOption = GobOption +module GobPretty = GobPretty +module GobResult = GobResult +module GobSys = GobSys +module GobYaml = GobYaml +module GobYojson = GobYojson +module GobZ = GobZ +module MyCheck = MyCheck From a1964c6a7e33097d1dcb7c41e2d1a931d5366a83 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 11:25:14 +0300 Subject: [PATCH 221/518] Add organized Goblint_lib interface --- src/cdomains/flagModeDomain.ml | 2 + src/goblint_lib.ml | 409 +++++++++++++++++++-------------- 2 files changed, 244 insertions(+), 167 deletions(-) diff --git a/src/cdomains/flagModeDomain.ml b/src/cdomains/flagModeDomain.ml index 6d290fbf29..70ee6d0015 100644 --- a/src/cdomains/flagModeDomain.ml +++ b/src/cdomains/flagModeDomain.ml @@ -1,3 +1,5 @@ +(* TODO: unused *) + module Eq = IntDomain.MakeBooleans (struct let truename="==" let falsename="!=" end) module Method = IntDomain.MakeBooleans (struct let truename="guard" let falsename="assign" end) diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index f341ab9fc3..3ef538227d 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -2,303 +2,378 @@ (** {1 Framework} *) module Maingoblint = Maingoblint +module Control = Control module Server = Server +(** {2 CFG} *) + +module Node = Node +module Edge = Edge +module MyCFG = MyCFG +module CfgTools = CfgTools + +(** {2 Specification} *) + module Analyses = Analyses module Constraints = Constraints -module Control = Control module ControlSpecC = ControlSpecC -module Events = Events -module Queries = Queries module MCP = MCP -module MCPAccess = MCPAccess module MCPRegistry = MCPRegistry +module MCPAccess = MCPAccess +module Queries = Queries +module Events = Events -module PostSolver = PostSolver -module Refinement = Refinement +(** {2 Results} *) module ResultQuery = ResultQuery module VarQuery = VarQuery -(** {2 CFG} *) - -module CfgTools = CfgTools -module Edge = Edge -module MyCFG = MyCFG -module Node = Node -module Node0 = Node0 - (** {2 Configuration} *) module GobConfig = GobConfig module AfterConfig = AfterConfig module AutoTune = AutoTune -module AutoTune0 = AutoTune0 + module JsonSchema = JsonSchema module Options = Options + (** {1 Analyses} *) -module AbortUnless = AbortUnless -module AccessAnalysis = AccessAnalysis -module ActiveLongjmp = ActiveLongjmp -module ActiveSetjmp = ActiveSetjmp -module AffineEqualityAnalysis = AffineEqualityAnalysis -module ApronAnalysis = ApronAnalysis -module Assert = Assert +(** {2 Value} *) + module Base = Base -module BasePriv = BasePriv +module RelationAnalysis = RelationAnalysis +module ApronAnalysis = ApronAnalysis +module AffineEqualityAnalysis = AffineEqualityAnalysis +module VarEq = VarEq module CondVars = CondVars -module Constants = Constants -module Deadlock = Deadlock -module ExpRelation = ExpRelation -module Expsplit = Expsplit -module ExtractPthread = ExtractPthread -module FileUse = FileUse -module LocksetAnalysis = LocksetAnalysis -module MHPAnalysis = MHPAnalysis -module MallocFresh = MallocFresh + +(** {2 Heap} *) + module MallocWrapperAnalysis = MallocWrapperAnalysis +module Region = Region +module MallocFresh = MallocFresh module Malloc_null = Malloc_null -module MayLocks = MayLocks -module ModifiedSinceLongjmp = ModifiedSinceLongjmp -module MutexAnalysis = MutexAnalysis + +(** {2 Concurrency} *) + +(** {3 Locks} *) + module MutexEventsAnalysis = MutexEventsAnalysis -module ObserverAnalysis = ObserverAnalysis -module PoisonVariables = PoisonVariables -module PthreadSignals = PthreadSignals -module RaceAnalysis = RaceAnalysis -module Region = Region -module RelationAnalysis = RelationAnalysis -module RelationPriv = RelationPriv -module Signs = Signs -module Spec = Spec -module StackTrace = StackTrace +module LocksetAnalysis = LocksetAnalysis +module MutexAnalysis = MutexAnalysis +module MayLocks = MayLocks module SymbLocks = SymbLocks -module Taint = Taint -module TaintPartialContexts = TaintPartialContexts -module Termination = Termination -module ThreadAnalysis = ThreadAnalysis -module ThreadEscape = ThreadEscape +module Deadlock = Deadlock + +(** {3 Threads} *) + module ThreadFlag = ThreadFlag module ThreadId = ThreadId +module ThreadAnalysis = ThreadAnalysis module ThreadJoins = ThreadJoins +module MHPAnalysis = MHPAnalysis module ThreadReturn = ThreadReturn -module UnassumeAnalysis = UnassumeAnalysis -module Uninit = Uninit -module UnitAnalysis = UnitAnalysis -module VarEq = VarEq + +(** {3 Other} *) + +module RaceAnalysis = RaceAnalysis +module BasePriv = BasePriv +module RelationPriv = RelationPriv +module ThreadEscape = ThreadEscape +module PthreadSignals = PthreadSignals +module ExtractPthread = ExtractPthread + +(** {2 Longjmp} *) + +module ActiveSetjmp = ActiveSetjmp +module ModifiedSinceLongjmp = ModifiedSinceLongjmp +module ActiveLongjmp = ActiveLongjmp +module PoisonVariables = PoisonVariables module Vla = Vla +(** {2 Tutorial} *) + +module Constants = Constants +module Signs = Signs +module Taint = Taint +module UnitAnalysis = UnitAnalysis + +(** {2 Other} *) + +module Assert = Assert +module FileUse = FileUse +module Uninit = Uninit +module Termination = Termination +module Expsplit = Expsplit +module StackTrace = StackTrace +module Spec = Spec + +(** {2 Helper} *) + +module AccessAnalysis = AccessAnalysis +module TaintPartialContexts = TaintPartialContexts +module UnassumeAnalysis = UnassumeAnalysis +module ExpRelation = ExpRelation +module AbortUnless = AbortUnless + + (** {1 Domains} *) module Printable = Printable module Lattice = Lattice -module FlagHelper = FlagHelper (** {2 General} *) module BoolDomain = BoolDomain +module SetDomain = SetDomain +module MapDomain = MapDomain module DisjointDomain = DisjointDomain module HoareDomain = HoareDomain -module MapDomain = MapDomain module PartitionDomain = PartitionDomain -module SetDomain = SetDomain +module FlagHelper = FlagHelper (** {2 Analysis-specific} *) -module Access = Access -module AccessDomain = AccessDomain -module AddressDomain = AddressDomain -module AffineEqualityDomain = AffineEqualityDomain -module ApronDomain = ApronDomain -module ArrayDomain = ArrayDomain +(** {3 Value} *) + +(** {4 Non-relational} *) + module BaseDomain = BaseDomain -module CilLval = CilLval -module ConcDomain = ConcDomain -module DeadlockDomain = DeadlockDomain -module EscapeDomain = EscapeDomain -module FileDomain = FileDomain -module FlagModeDomain = FlagModeDomain -module FloatDomain = FloatDomain +module ValueDomain = ValueDomain module IntDomain = IntDomain +module FloatDomain = FloatDomain +module AddressDomain = AddressDomain +module StructDomain = StructDomain +module UnionDomain = UnionDomain +module ArrayDomain = ArrayDomain module JmpBufDomain = JmpBufDomain +module ValueDomainQueries = ValueDomainQueries + +(** {4 Relational} *) + +module RelationDomain = RelationDomain +module ApronDomain = ApronDomain +module AffineEqualityDomain = AffineEqualityDomain + +(** {3 Concurrency} *) + module LockDomain = LockDomain -module Lval = Lval -module LvalMapDomain = LvalMapDomain +module SymbLocksDomain = SymbLocksDomain +module DeadlockDomain = DeadlockDomain + +module ThreadFlagDomain = ThreadFlagDomain +module ThreadIdDomain = ThreadIdDomain +module ConcDomain = ConcDomain module MHP = MHP -module MusteqDomain = MusteqDomain -module PreValueDomain = PreValueDomain + +module EscapeDomain = EscapeDomain module PthreadDomain = PthreadDomain + +(** {3 Other} *) + +module Basetype = Basetype +module Lval = Lval +module CilLval = CilLval +module Access = Access +module AccessDomain = AccessDomain + +module MusteqDomain = MusteqDomain module RegionDomain = RegionDomain -module RelationDomain = RelationDomain -module SpecDomain = SpecDomain +module FileDomain = FileDomain module StackDomain = StackDomain -module StructDomain = StructDomain -module SymbLocksDomain = SymbLocksDomain -module ThreadFlagDomain = ThreadFlagDomain -module ThreadIdDomain = ThreadIdDomain -module UnionDomain = UnionDomain -module ValueDomain = ValueDomain -module ValueDomainQueries = ValueDomainQueries + +module LvalMapDomain = LvalMapDomain +module SpecDomain = SpecDomain (** {2 Testing} *) -module AbstractionDomainProperties = AbstractionDomainProperties module DomainProperties = DomainProperties +module AbstractionDomainProperties = AbstractionDomainProperties module IntDomainProperties = IntDomainProperties + (** {1 Incremental} *) -module CilMaps = CilMaps +module CompareCIL = CompareCIL module CompareAST = CompareAST module CompareCFG = CompareCFG -module CompareCIL = CompareCIL +module UpdateCil = UpdateCil module MaxIdUtil = MaxIdUtil module Serialize = Serialize -module UpdateCil = UpdateCil -module UpdateCil0 = UpdateCil0 +module CilMaps = CilMaps -(** {1 Transformation} *) - -module DeadCode = DeadCode -module EvalAssert = EvalAssert -module ExpressionEvaluation = ExpressionEvaluation -module Transform = Transform (** {1 Solvers} *) -module EffectWConEq = EffectWConEq -module Generic = Generic -module LocalFixpoint = LocalFixpoint -module SLR = SLR -module SLRphased = SLRphased -module SLRterm = SLRterm -module Selector = Selector +(** {2 Top-down} *) + module Td3 = Td3 module TopDown = TopDown -module TopDown_deprecated = TopDown_deprecated -module TopDown_space_cache_term = TopDown_space_cache_term module TopDown_term = TopDown_term +module TopDown_space_cache_term = TopDown_space_cache_term +module TopDown_deprecated = TopDown_deprecated + +(** {2 SLR} *) + +module SLR = SLR +module SLRterm = SLRterm +module SLRphased = SLRphased + +(** {2 Other} *) + +module EffectWConEq = EffectWConEq module Worklist = Worklist +module Generic = Generic +module Selector = Selector + +module PostSolver = PostSolver +module LocalFixpoint = LocalFixpoint +module SolverBox = SolverBox -(** {1 Output} *) -module MessageCategory = MessageCategory -module MessageUtil = MessageUtil +(** {1 I/O} *) + module Messages = Messages +module Tracing = Tracing + +(** {2 Front-end} *) + +module Preprocessor = Preprocessor +module CompilationDatabase = CompilationDatabase +module MakefileUtil = MakefileUtil + +(** {2 Witnesses} *) + +module Svcomp = Svcomp +module SvcompSpec = SvcompSpec + +module Invariant = Invariant +module InvariantCil = InvariantCil +module WitnessUtil = WitnessUtil + +(** {3 GraphML} *) + +module MyARG = MyARG +module WitnessConstraints = WitnessConstraints +module ArgTools = ArgTools +module Witness = Witness +module Graphml = Graphml + +(** {3 YAML}*) + +module YamlWitness = YamlWitness +module YamlWitnessType = YamlWitnessType +module WideningTokens = WideningTokens + +(** {3 Violation} *) + +module Violation = Violation +module ViolationZ3 = ViolationZ3 +module ObserverAutomaton = ObserverAutomaton +module ObserverAnalysis = ObserverAnalysis +module Refinement = Refinement + +(** {2 SARIF} *) module Sarif = Sarif -module SarifRules = SarifRules module SarifType = SarifType +module SarifRules = SarifRules -module Tracing = Tracing -(** {1 Utility} *) +(** {1 Transformations} *) -module Goblintutil = Goblintutil +module Transform = Transform +module DeadCode = DeadCode +module EvalAssert = EvalAssert +module ExpressionEvaluation = ExpressionEvaluation -module Timing = Timing +(** {1 Utilities} *) + +module Goblintutil = Goblintutil +module Timing = Timing module GoblintDir = GoblintDir (** {2 General} *) -module AccessKind = AccessKind -module Basetype = Basetype -module FloatOps = FloatOps module IntOps = IntOps -module LazyEval = LazyEval -module LibraryDesc = LibraryDesc -module LibraryDsl = LibraryDsl -module LibraryFunctions = LibraryFunctions - -module PrecCompare = PrecCompare -module PrecCompareUtil = PrecCompareUtil +module FloatOps = FloatOps -module ProcessPool = ProcessPool +module LazyEval = LazyEval module ResettableLazy = ResettableLazy -module SolverBox = SolverBox +module ProcessPool = ProcessPool +module Timeout = Timeout module TimeUtil = TimeUtil -module Timeout = Timeout +module MessageUtil = MessageUtil module XmlUtil = XmlUtil (** {2 CIL} *) -module Cilfacade = Cilfacade -module Cilfacade0 = Cilfacade0 -module CilCfg = CilCfg module CilType = CilType -module LoopUnrolling = LoopUnrolling +module Cilfacade = Cilfacade module RichVarinfo = RichVarinfo -(** {2 Input} *) +module CilCfg = CilCfg +module LoopUnrolling = LoopUnrolling -module CompilationDatabase = CompilationDatabase -module MakefileUtil = MakefileUtil -module Preprocessor = Preprocessor +(** {2 Library specification} *) -module SpecLexer = SpecLexer -module SpecParser = SpecParser +module AccessKind = AccessKind +module LibraryDesc = LibraryDesc +module LibraryDsl = LibraryDsl +module LibraryFunctions = LibraryFunctions (** {2 Analysis-specific} *) -module ApronPrecCompareUtil = ApronPrecCompareUtil -module BaseInvariant = BaseInvariant module BaseUtil = BaseUtil -module CommonPriv = CommonPriv -module ContextUtil = ContextUtil module PrecisionUtil = PrecisionUtil -module PrivPrecCompareUtil = PrivPrecCompareUtil -module RelationPrecCompareUtil = RelationPrecCompareUtil -module SharedFunctions = SharedFunctions -module SpecCore = SpecCore -module SpecUtil = SpecUtil -module VectorMatrix = VectorMatrix +module ContextUtil = ContextUtil +module BaseInvariant = BaseInvariant +module CommonPriv = CommonPriv module WideningThresholds = WideningThresholds -(** {2 Witnesses} *) +module VectorMatrix = VectorMatrix +module SharedFunctions = SharedFunctions -module ArgTools = ArgTools -module Graphml = Graphml -module Invariant = Invariant -module InvariantCil = InvariantCil -module MyARG = MyARG -module ObserverAutomaton = ObserverAutomaton -module Svcomp = Svcomp -module SvcompSpec = SvcompSpec -module Violation = Violation -module ViolationZ3 = ViolationZ3 -module WideningTokens = WideningTokens -module Witness = Witness -module WitnessConstraints = WitnessConstraints -module WitnessUtil = WitnessUtil -module YamlWitness = YamlWitness -module YamlWitnessType = YamlWitnessType +(** {2 Precision comparison} *) -(** {2 Config} *) +module PrecCompare = PrecCompare +module PrecCompareUtil = PrecCompareUtil +module PrivPrecCompareUtil = PrivPrecCompareUtil +module RelationPrecCompareUtil = RelationPrecCompareUtil +module ApronPrecCompareUtil = ApronPrecCompareUtil + +(** {2 Build info} *) module ConfigOcaml = ConfigOcaml module ConfigProfile = ConfigProfile -module ConfigVersion = ConfigVersion module Version = Version +module ConfigVersion = ConfigVersion + (** {1 Library extensions} *) -module GobUnix = GobUnix +(** {2 Standard library} *) + module GobFormat = GobFormat -module GobFpath = GobFpath module GobHashtbl = GobHashtbl module GobList = GobList -module GobOption = GobOption -module GobPretty = GobPretty module GobResult = GobResult +module GobOption = GobOption module GobSys = GobSys +module GobUnix = GobUnix + +(** {2 Other libraries} *) + +module GobFpath = GobFpath +module GobPretty = GobPretty module GobYaml = GobYaml module GobYojson = GobYojson module GobZ = GobZ From 7979db758429f4eb4c55d74db7566454bf23ffcf Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 12:22:41 +0300 Subject: [PATCH 222/518] Add framework synopses --- src/analyses/mCP.ml | 2 +- src/analyses/mCPAccess.ml | 1 + src/analyses/mCPRegistry.ml | 3 +++ src/autoTune.ml | 2 ++ src/domains/events.ml | 2 ++ src/domains/queries.ml | 2 +- src/framework/analyses.ml | 2 +- src/framework/cfgTools.ml | 2 ++ src/framework/constraints.ml | 3 ++- src/framework/controlSpecC.mli | 2 ++ src/framework/edge.ml | 3 +++ src/framework/myCFG.ml | 4 +++- src/framework/node.ml | 3 +++ src/framework/resultQuery.ml | 2 ++ src/framework/varQuery.mli | 2 ++ src/goblint_lib.ml | 27 +++++++++++++++++++++++---- src/util/afterConfig.ml | 2 ++ src/util/gobConfig.ml | 2 ++ src/util/jsonSchema.ml | 2 ++ src/util/options.ml | 2 ++ 20 files changed, 61 insertions(+), 9 deletions(-) diff --git a/src/analyses/mCP.ml b/src/analyses/mCP.ml index 739ec43455..b2e8a280fa 100644 --- a/src/analyses/mCP.ml +++ b/src/analyses/mCP.ml @@ -1,4 +1,4 @@ -(** Master Control Program *) +(** MCP analysis specification. *) open Batteries open GoblintCil diff --git a/src/analyses/mCPAccess.ml b/src/analyses/mCPAccess.ml index 44b5931496..92db6fbc5d 100644 --- a/src/analyses/mCPAccess.ml +++ b/src/analyses/mCPAccess.ml @@ -1,3 +1,4 @@ +(** {{!Analyses.MCPA} Memory access metadata module} for MCP. *) open MCPRegistry module Pretty = GoblintCil.Pretty diff --git a/src/analyses/mCPRegistry.ml b/src/analyses/mCPRegistry.ml index 48acb7d0be..bbd6dc5c6b 100644 --- a/src/analyses/mCPRegistry.ml +++ b/src/analyses/mCPRegistry.ml @@ -1,3 +1,6 @@ +(** Registry of dynamically activatable analyses. + Analysis specification modules for the dynamic product. *) + open Batteries open GoblintCil open Pretty diff --git a/src/autoTune.ml b/src/autoTune.ml index 79d85d8009..8ad5f8d655 100644 --- a/src/autoTune.ml +++ b/src/autoTune.ml @@ -1,3 +1,5 @@ +(** Autotuning of the configuration based on syntactic heuristics. *) + open GobConfig open GoblintCil open AutoTune0 diff --git a/src/domains/events.ml b/src/domains/events.ml index 07cce9feab..2141ad17dd 100644 --- a/src/domains/events.ml +++ b/src/domains/events.ml @@ -1,3 +1,5 @@ +(** Events. *) + open GoblintCil open Pretty diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 7869399ee4..d99955bf11 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -1,4 +1,4 @@ -(** Structures for the querying subsystem. *) +(** Queries and their result lattices. *) open GoblintCil diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index acac5a81eb..8590cd56a8 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -1,4 +1,4 @@ -(** Signatures for analyzers, analysis specifications, and result output. *) +(** {{!Spec} Analysis specification} and {{!MonSystem} constraint system} signatures. *) open Batteries open GoblintCil diff --git a/src/framework/cfgTools.ml b/src/framework/cfgTools.ml index ac52dae19a..d960bcf876 100644 --- a/src/framework/cfgTools.ml +++ b/src/framework/cfgTools.ml @@ -1,3 +1,5 @@ +(** Construction and output of CFGs. *) + open MyCFG open GoblintCil open Pretty diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index 36627f360a..c6e3c50723 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -1,4 +1,5 @@ -(** How to generate constraints for a solver using specifications described in [Analyses]. *) +(** Construction of a {{!Analyses.MonSystem} constraint system} from an {{!Analyses.Spec} analysis specification} and {{!MyCFG.CfgBackward} CFGs}. + Transformatons of analysis specifications as functors. *) open Batteries open GoblintCil diff --git a/src/framework/controlSpecC.mli b/src/framework/controlSpecC.mli index 47f37b5c88..330fd4bf73 100644 --- a/src/framework/controlSpecC.mli +++ b/src/framework/controlSpecC.mli @@ -1,3 +1,5 @@ +(** {{!Analyses.Spec.C} Context module} for the dynamically composed analysis. *) + (** Top-level Control Spec context as static module, which delegates to {!control_spec_c}. This allows using top-level context values inside individual analyses. *) include Printable.S diff --git a/src/framework/edge.ml b/src/framework/edge.ml index 87b9c45a3f..e6f214a4c8 100644 --- a/src/framework/edge.ml +++ b/src/framework/edge.ml @@ -1,3 +1,6 @@ +(** CFG edge. + Corresponds to a (primitive) program statement between program points (and their states). *) + open GoblintCil open Pretty diff --git a/src/framework/myCFG.ml b/src/framework/myCFG.ml index 1b5ffba98b..76675f3c88 100644 --- a/src/framework/myCFG.ml +++ b/src/framework/myCFG.ml @@ -1,4 +1,6 @@ -(** Our Control-flow graph implementation. *) +(** Control-flow graph. + + Distinct from CIL's CFG. *) open GoblintCil diff --git a/src/framework/node.ml b/src/framework/node.ml index e3493e5a6e..906f9e1d77 100644 --- a/src/framework/node.ml +++ b/src/framework/node.ml @@ -1,3 +1,6 @@ +(** CFG node. + Corresponds to a program point between program statements. *) + open GoblintCil open Pretty diff --git a/src/framework/resultQuery.ml b/src/framework/resultQuery.ml index 63b0765fdb..ce5839ef30 100644 --- a/src/framework/resultQuery.ml +++ b/src/framework/resultQuery.ml @@ -1,3 +1,5 @@ +(** Perform {{!Queries.t} queries} on the constraint system solution. *) + open Analyses module Query (SpecSys: SpecSys) = diff --git a/src/framework/varQuery.mli b/src/framework/varQuery.mli index 77894b62ef..86abc389fc 100644 --- a/src/framework/varQuery.mli +++ b/src/framework/varQuery.mli @@ -1,3 +1,5 @@ +(** Queries for constraint variables related to semantic elements. *) + open GoblintCil type t = diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 3ef538227d..d36f3e1dbe 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -5,31 +5,50 @@ module Maingoblint = Maingoblint module Control = Control module Server = Server -(** {2 CFG} *) +(** {2 CFG} + + Control-flow graphs (CFGs) are used to represent each function. *) module Node = Node module Edge = Edge module MyCFG = MyCFG module CfgTools = CfgTools -(** {2 Specification} *) +(** {2 Specification} + + Analyses are specified by domains and transfer functions. + A dynamic composition of analyses is combined with CFGs to produce a constraint system. *) module Analyses = Analyses module Constraints = Constraints module ControlSpecC = ControlSpecC +(** Master control program (MCP) is the analysis specification for the dynamic product of activated analyses. *) + module MCP = MCP module MCPRegistry = MCPRegistry module MCPAccess = MCPAccess + +(** MCP allows activated analyses to query each other during the analysis. + Query results from different analyses for the same query are {{!Lattice.S.meet} met} for precision. *) + module Queries = Queries + +(** MCP allows activated analyses to emit events to each other during the analysis. *) + module Events = Events -(** {2 Results} *) +(** {2 Results} + + The following modules help query the constraint system solution using semantic information. *) module ResultQuery = ResultQuery module VarQuery = VarQuery -(** {2 Configuration} *) +(** {2 Configuration} + + Runtime configuration is represented as JSON. + Options are specified and documented by the JSON schema [src/util/options.schema.json]. *) module GobConfig = GobConfig module AfterConfig = AfterConfig diff --git a/src/util/afterConfig.ml b/src/util/afterConfig.ml index a49e4f31cc..ddc544ef0b 100644 --- a/src/util/afterConfig.ml +++ b/src/util/afterConfig.ml @@ -1,3 +1,5 @@ +(** Hooks which run after the runtime configuration is fully loaded. *) + let callbacks = ref [] let register callback = diff --git a/src/util/gobConfig.ml b/src/util/gobConfig.ml index a596468eec..d918e535d1 100644 --- a/src/util/gobConfig.ml +++ b/src/util/gobConfig.ml @@ -1,3 +1,5 @@ +(** Configuration access. *) + (** New, untyped, path-based configuration subsystem. diff --git a/src/util/jsonSchema.ml b/src/util/jsonSchema.ml index 9accd2a270..701c948f3a 100644 --- a/src/util/jsonSchema.ml +++ b/src/util/jsonSchema.ml @@ -1,3 +1,5 @@ +(** JSON schema validation. *) + module JS = Json_schema.Make (Json_repr.Yojson) module JE = Json_encoding.Make (Json_repr.Yojson) module JQ = Json_query.Make (Json_repr.Yojson) diff --git a/src/util/options.ml b/src/util/options.ml index 7fb6cabae9..d352c86465 100644 --- a/src/util/options.ml +++ b/src/util/options.ml @@ -1,3 +1,5 @@ +(** [src/util/options.schema.json] low-level access. *) + open Json_schema let schema = From 340506726eac73f4dc48c5d76c27f7dcf7ec950f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 14:09:18 +0300 Subject: [PATCH 223/518] Add analyses synopses --- src/analyses/abortUnless.ml | 4 ++- src/analyses/accessAnalysis.ml | 2 +- src/analyses/activeLongjmp.ml | 2 +- src/analyses/activeSetjmp.ml | 2 +- .../apron/affineEqualityAnalysis.apron.ml | 6 ++-- src/analyses/apron/apronAnalysis.apron.ml | 3 +- src/analyses/apron/relationAnalysis.apron.ml | 4 +++ src/analyses/apron/relationPriv.apron.ml | 4 ++- src/analyses/assert.ml | 2 ++ src/analyses/base.ml | 2 +- src/analyses/basePriv.mli | 4 +++ src/analyses/condVars.ml | 2 +- src/analyses/deadlock.ml | 2 +- src/analyses/expRelation.ml | 2 ++ src/analyses/expsplit.ml | 2 ++ src/analyses/extractPthread.ml | 2 +- src/analyses/fileUse.ml | 4 ++- src/analyses/mHPAnalysis.ml | 3 +- src/analyses/mallocFresh.ml | 2 ++ src/analyses/mallocWrapperAnalysis.ml | 5 ++- src/analyses/malloc_null.ml | 2 +- src/analyses/mayLocks.ml | 4 ++- src/analyses/modifiedSinceLongjmp.ml | 4 ++- src/analyses/mutexAnalysis.ml | 2 +- src/analyses/mutexEventsAnalysis.ml | 4 ++- src/analyses/poisonVariables.ml | 2 ++ src/analyses/pthreadSignals.ml | 2 +- src/analyses/raceAnalysis.ml | 2 +- src/analyses/region.ml | 4 ++- src/analyses/spec.ml | 6 +++- src/analyses/stackTrace.ml | 2 +- src/analyses/symbLocks.ml | 4 +-- src/analyses/taintPartialContexts.ml | 2 ++ src/analyses/termination.ml | 2 +- src/analyses/threadAnalysis.ml | 2 +- src/analyses/threadEscape.ml | 2 +- src/analyses/threadFlag.ml | 2 +- src/analyses/threadId.ml | 2 +- src/analyses/threadJoins.ml | 3 +- src/analyses/threadReturn.ml | 2 +- src/analyses/tutorials/constants.ml | 1 + src/analyses/tutorials/signs.ml | 2 +- src/analyses/tutorials/taint.ml | 2 ++ src/analyses/tutorials/unitAnalysis.ml | 2 +- src/analyses/unassumeAnalysis.ml | 3 +- src/analyses/uninit.ml | 2 +- src/analyses/varEq.ml | 2 +- src/analyses/vla.ml | 2 +- src/goblint_lib.ml | 36 ++++++++++++++----- 49 files changed, 117 insertions(+), 49 deletions(-) diff --git a/src/analyses/abortUnless.ml b/src/analyses/abortUnless.ml index d030ca8a24..ebff78f578 100644 --- a/src/analyses/abortUnless.ml +++ b/src/analyses/abortUnless.ml @@ -1,4 +1,6 @@ -(** An analysis checking whether a function only returns if its only argument has a non-zero value. *) +(** Analysis of [assume_abort_if_not]-style functions ([abortUnless]). + + Such function only returns if its only argument has a non-zero value. *) open GoblintCil open Analyses diff --git a/src/analyses/accessAnalysis.ml b/src/analyses/accessAnalysis.ml index 999856516c..da53d0cab9 100644 --- a/src/analyses/accessAnalysis.ml +++ b/src/analyses/accessAnalysis.ml @@ -1,4 +1,4 @@ -(** Access analysis. *) +(** Analysis of memory accesses ([access]). *) module LF = LibraryFunctions open GoblintCil diff --git a/src/analyses/activeLongjmp.ml b/src/analyses/activeLongjmp.ml index 72905862c3..9c9868e32f 100644 --- a/src/analyses/activeLongjmp.ml +++ b/src/analyses/activeLongjmp.ml @@ -1,4 +1,4 @@ -(** Analysis tracking which longjmp is currently active *) +(** Analysis of active [longjmp] targets ([activeLongjmp]). *) open GoblintCil open Analyses diff --git a/src/analyses/activeSetjmp.ml b/src/analyses/activeSetjmp.ml index f144046a44..498d89ea3b 100644 --- a/src/analyses/activeSetjmp.ml +++ b/src/analyses/activeSetjmp.ml @@ -1,4 +1,4 @@ -(** Analysis tracking which setjmp(s) are currently active *) +(** Analysis of active [setjmp] buffers ([activeSetjmp]). *) open GoblintCil open Analyses diff --git a/src/analyses/apron/affineEqualityAnalysis.apron.ml b/src/analyses/apron/affineEqualityAnalysis.apron.ml index fe59209ca6..03a9ecdb57 100644 --- a/src/analyses/apron/affineEqualityAnalysis.apron.ml +++ b/src/analyses/apron/affineEqualityAnalysis.apron.ml @@ -1,5 +1,7 @@ -(* Ref: Affine Relationships Among Variables of a Program, Michael Karr 1976 - https://link.springer.com/content/pdf/10.1007/BF00268497.pdf *) +(** {{!RelationAnalysis} Relational integer value analysis} using an OCaml implementation of the affine equalities domain ([affeq]). + + @see Karr, M. Affine relationships among variables of a program. *) + open Analyses include RelationAnalysis diff --git a/src/analyses/apron/apronAnalysis.apron.ml b/src/analyses/apron/apronAnalysis.apron.ml index f3a2374bc1..29e295a662 100644 --- a/src/analyses/apron/apronAnalysis.apron.ml +++ b/src/analyses/apron/apronAnalysis.apron.ml @@ -1,4 +1,5 @@ -(** Analysis using Apron for integer variables. *) +(** {{!RelationAnalysis} Relational integer value analysis} using {!Apron} domains ([apron]). *) + open Analyses include RelationAnalysis diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 6790c73382..cb9334f517 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -1,3 +1,7 @@ +(** Abstract relational {e integer} value analysis. + + See {!ApronAnalysis} and {!AffineEqualityAnalysis}. *) + (** Contains most of the implementation of the original apronDomain, but now solely operates with functions provided by relationDomain. *) open Batteries diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index c2726b42df..160d2b07ed 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -1,4 +1,6 @@ -(** Has been modified to work with any domain that uses the functions provided relationDomain. *) +(** Relational thread-modular value analyses for {!RelationAnalysis}, i.e. {!ApronAnalysis} and {!AffineEqualityAnalysis}. + + @see Schwarz, M., Saan, S., Seidl, H., Erhard, J., Vojdani, V. Clustered Relational Thread-Modular Abstract Interpretation with Local Traces. *) open Batteries open GoblintCil diff --git a/src/analyses/assert.ml b/src/analyses/assert.ml index 33dbe448ec..8247a0d7e8 100644 --- a/src/analyses/assert.ml +++ b/src/analyses/assert.ml @@ -1,3 +1,5 @@ +(** Analysis of [assert] results ([assert]). *) + open Batteries open GoblintCil open Analyses diff --git a/src/analyses/base.ml b/src/analyses/base.ml index a5c972d0fd..918cb5c43f 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1,4 +1,4 @@ -(** Value analysis. *) +(** Non-relational value analysis aka {e base analysis} ([base]). *) open Batteries open GoblintCil diff --git a/src/analyses/basePriv.mli b/src/analyses/basePriv.mli index 781771c221..767e0e72bb 100644 --- a/src/analyses/basePriv.mli +++ b/src/analyses/basePriv.mli @@ -1,3 +1,7 @@ +(** Non-relational thread-modular value analyses for {!Base}. + + @see Schwarz, M., Saan, S., Seidl, H., Apinis, K., Erhard, J., Vojdani, V. Improving Thread-Modular Abstract Interpretation. *) + open GoblintCil (* Cannot use local module substitutions because ppx_import is still stuck at 4.07 AST: https://github.com/ocaml-ppx/ppx_import/issues/50#issuecomment-775817579. *) (* TODO: try again, because ppx_import is now removed *) diff --git a/src/analyses/condVars.ml b/src/analyses/condVars.ml index c4189661d9..abe9f61ae2 100644 --- a/src/analyses/condVars.ml +++ b/src/analyses/condVars.ml @@ -1,4 +1,4 @@ -(** Must equality between variables and logical expressions. *) +(** Symbolic variable - logical expression equalities analysis ([condvars]). *) (* TODO: unused, what is this analysis? *) open Batteries diff --git a/src/analyses/deadlock.ml b/src/analyses/deadlock.ml index 56a0ddaf4d..d07a7a1b33 100644 --- a/src/analyses/deadlock.ml +++ b/src/analyses/deadlock.ml @@ -1,4 +1,4 @@ -(** Deadlock analysis. *) +(** Deadlock analysis ([deadlock]). *) open Batteries open GoblintCil diff --git a/src/analyses/expRelation.ml b/src/analyses/expRelation.ml index 486cba79b9..ad44cfcaab 100644 --- a/src/analyses/expRelation.ml +++ b/src/analyses/expRelation.ml @@ -1,3 +1,5 @@ +(** Stateless symbolic comparison expression analysis ([expRelation]). *) + (** An analysis specification to answer questions about how two expressions relate to each other. *) (** Currently this works purely syntactically on the expressions, and only for =_{must}. *) (** Does not keep state, this is only formulated as an analysis to integrate well into framework *) diff --git a/src/analyses/expsplit.ml b/src/analyses/expsplit.ml index d5eac15a93..ec62e2a7c6 100644 --- a/src/analyses/expsplit.ml +++ b/src/analyses/expsplit.ml @@ -1,3 +1,5 @@ +(** Path-sensitive analysis according to arbitrary given expressions ([expsplit]). *) + open Batteries open GoblintCil open Analyses diff --git a/src/analyses/extractPthread.ml b/src/analyses/extractPthread.ml index d3ce19b35f..dd05500bc3 100644 --- a/src/analyses/extractPthread.ml +++ b/src/analyses/extractPthread.ml @@ -1,4 +1,4 @@ -(** Tracking of pthread lib code. Output to promela. *) +(** Promela extraction analysis for Pthread programs ([extract-pthread]). *) open GoblintCil open Pretty diff --git a/src/analyses/fileUse.ml b/src/analyses/fileUse.ml index 7c76cada54..eff2176ec6 100644 --- a/src/analyses/fileUse.ml +++ b/src/analyses/fileUse.ml @@ -1,4 +1,6 @@ -(** An analysis for checking correct use of file handles. *) +(** Analysis of correct file handle usage ([file]). + + @see Vogler, R. Verifying Regular Safety Properties of C Programs Using the Static Analyzer Goblint. Section 3.*) open Batteries open GoblintCil diff --git a/src/analyses/mHPAnalysis.ml b/src/analyses/mHPAnalysis.ml index 975f059bf2..a24dbc3cd6 100644 --- a/src/analyses/mHPAnalysis.ml +++ b/src/analyses/mHPAnalysis.ml @@ -1,4 +1,5 @@ -(** MHP access analysis. *) +(** May-happen-in-parallel (MHP) analysis for memory accesses ([mhp]). *) + open Analyses module Spec = diff --git a/src/analyses/mallocFresh.ml b/src/analyses/mallocFresh.ml index 3ecce39345..c4a0c035f2 100644 --- a/src/analyses/mallocFresh.ml +++ b/src/analyses/mallocFresh.ml @@ -1,3 +1,5 @@ +(** Analysis of unescaped (i.e. thread-local) heap locations ([mallocFresh]). *) + open GoblintCil open Analyses diff --git a/src/analyses/mallocWrapperAnalysis.ml b/src/analyses/mallocWrapperAnalysis.ml index 1b0ffbcb6f..47a0e4c3a2 100644 --- a/src/analyses/mallocWrapperAnalysis.ml +++ b/src/analyses/mallocWrapperAnalysis.ml @@ -1,4 +1,7 @@ -(** An analysis that handles the case when malloc is called from a wrapper function all over the code. *) +(** Analysis which provides symbolic heap locations for dynamic memory allocations. ([mallocWrapper]). + + Provided heap locations are based on the node and thread ID. + Considers [malloc] wrapper functions and a number of unique heap locations for additional precision. *) open GoblintCil open Analyses diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index e121bfcb3e..fcd55e2709 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -1,4 +1,4 @@ -(** Path-sensitive analysis that verifies checking the result of the malloc function. *) +(** Path-sensitive analysis of failed dynamic memory allocations ([malloc_null]). *) module AD = ValueDomain.AD module IdxDom = ValueDomain.IndexDomain diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 182b93ff3e..d2edeba776 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -1,4 +1,6 @@ -(** May lockset analysis (unused). *) +(** May lockset analysis ([maylocks]). *) + +(* TODO: unused *) open Analyses diff --git a/src/analyses/modifiedSinceLongjmp.ml b/src/analyses/modifiedSinceLongjmp.ml index 926c256bd1..f489b08fe9 100644 --- a/src/analyses/modifiedSinceLongjmp.ml +++ b/src/analyses/modifiedSinceLongjmp.ml @@ -1,4 +1,6 @@ -(** Locally track the variables that may have been written since the corresponding jumpbuffer was set *) +(** Analysis of variables modified since [setjmp] ([modifiedSinceLongjmp]). *) + +(* TODO: this name is wrong *) open GoblintCil open Analyses diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 631059f776..0119e804d6 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -1,4 +1,4 @@ -(** Protecting mutex analysis. Must locksets locally and for globals. *) +(** Must lockset and protecting lockset analysis ([mutex]). *) module M = Messages module Addr = ValueDomain.Addr diff --git a/src/analyses/mutexEventsAnalysis.ml b/src/analyses/mutexEventsAnalysis.ml index b62c688af9..ff6fce9562 100644 --- a/src/analyses/mutexEventsAnalysis.ml +++ b/src/analyses/mutexEventsAnalysis.ml @@ -1,4 +1,6 @@ -(** Mutex events analysis (Lock and Unlock). *) +(** Mutex locking and unlocking analysis ([mutexEvents]). + + Emits {!Events.Lock} and {!Events.Unlock} to other analyses. *) module M = Messages module Addr = ValueDomain.Addr diff --git a/src/analyses/poisonVariables.ml b/src/analyses/poisonVariables.ml index ee2ad4e7aa..fda8544201 100644 --- a/src/analyses/poisonVariables.ml +++ b/src/analyses/poisonVariables.ml @@ -1,3 +1,5 @@ +(** Taint analysis of variables modified between [setjmp] and [longjmp] ([poisonVariables]). *) + open Batteries open GoblintCil open Analyses diff --git a/src/analyses/pthreadSignals.ml b/src/analyses/pthreadSignals.ml index 7491e74b01..d49a8f12bc 100644 --- a/src/analyses/pthreadSignals.ml +++ b/src/analyses/pthreadSignals.ml @@ -1,4 +1,4 @@ -(** Analysis of must-received pthread_signals. *) +(** Must received signals analysis for Pthread condition variables ([pthreadSignals]). *) open GoblintCil open Analyses diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index 1c7d5864d3..4015f9d047 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -1,4 +1,4 @@ -(** Data race analysis. *) +(** Data race analysis ([race]). *) open GoblintCil open Analyses diff --git a/src/analyses/region.ml b/src/analyses/region.ml index c0e07c82d2..c079e65717 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -1,4 +1,6 @@ -(** Assigning static regions to dynamic memory. *) +(** Analysis of disjoint heap regions for dynamically allocated memory ([region]). + + @see Seidl, H., Vojdani, V. Region Analysis for Race Detection. *) open Batteries open GoblintCil diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml index 2fb56cca53..58559d7acc 100644 --- a/src/analyses/spec.ml +++ b/src/analyses/spec.ml @@ -1,4 +1,8 @@ -(** Analysis by specification file. *) +(** Analysis using finite automaton specification file ([spec]). + + @author Ralf Vogler + + @see Vogler, R. Verifying Regular Safety Properties of C Programs Using the Static Analyzer Goblint. Section 4. *) open Batteries open GoblintCil diff --git a/src/analyses/stackTrace.ml b/src/analyses/stackTrace.ml index 105f0c266b..d3dc0e6caf 100644 --- a/src/analyses/stackTrace.ml +++ b/src/analyses/stackTrace.ml @@ -1,4 +1,4 @@ -(** Stack-trace "analyses". *) +(** Call stack analyses ([stack_trace], [stack_trace_set], [stack_loc]). *) open GoblintCil open Analyses diff --git a/src/analyses/symbLocks.ml b/src/analyses/symbLocks.ml index c29421a130..489fbda918 100644 --- a/src/analyses/symbLocks.ml +++ b/src/analyses/symbLocks.ml @@ -1,6 +1,6 @@ -(** Symbolic lock-sets for use in per-element patterns. +(** Symbolic lockset analysis for per-element (field or index) locking patterns ([symb_locks]). - See Section 5 and 6 in https://dl.acm.org/doi/10.1145/2970276.2970337 for more details. *) + @see Static race detection for device drivers: the Goblint approach. Section 5 and 6. *) module LF = LibraryFunctions module LP = SymbLocksDomain.LockingPattern diff --git a/src/analyses/taintPartialContexts.ml b/src/analyses/taintPartialContexts.ml index aa4990fdd9..5edeb1e403 100644 --- a/src/analyses/taintPartialContexts.ml +++ b/src/analyses/taintPartialContexts.ml @@ -1,3 +1,5 @@ +(** Taint analysis of variables modified in a function ([taintPartialContexts]). *) + (* TaintPartialContexts: Set of Lvalues, which are tainted at a specific Node. *) (* An Lvalue is tainted, if its Rvalue might have been altered in the context of the current function, implying that the Rvalue of any Lvalue not in the set has definitely not been changed within the current context. *) diff --git a/src/analyses/termination.ml b/src/analyses/termination.ml index d448844596..1a06265458 100644 --- a/src/analyses/termination.ml +++ b/src/analyses/termination.ml @@ -1,4 +1,4 @@ -(** Termination of loops. *) +(** Termination analysis of loops using counter variables ([term]). *) open Batteries open GoblintCil diff --git a/src/analyses/threadAnalysis.ml b/src/analyses/threadAnalysis.ml index 97cb76a07c..275de3b005 100644 --- a/src/analyses/threadAnalysis.ml +++ b/src/analyses/threadAnalysis.ml @@ -1,4 +1,4 @@ -(** Thread creation and uniqueness analyses. *) +(** Created threads and their uniqueness analysis ([thread]). *) open GoblintCil open Analyses diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 2c3d9bb2f5..3dd6b9ec07 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -1,4 +1,4 @@ -(** Variables that escape threads using the last argument from pthread_create. *) +(** Escape analysis for thread-local variables ([escape]). *) open GoblintCil open Analyses diff --git a/src/analyses/threadFlag.ml b/src/analyses/threadFlag.ml index 7e81be2f8f..b14b553408 100644 --- a/src/analyses/threadFlag.ml +++ b/src/analyses/threadFlag.ml @@ -1,4 +1,4 @@ -(** Multi-threadedness analysis. *) +(** Multi-threadedness analysis ([threadflag]). *) module GU = Goblintutil module LF = LibraryFunctions diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index 4c852dadbf..995b43bc49 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -1,4 +1,4 @@ -(** Current thread ID analysis. *) +(** Current thread ID analysis ([threadid]). *) module GU = Goblintutil module LF = LibraryFunctions diff --git a/src/analyses/threadJoins.ml b/src/analyses/threadJoins.ml index ea5b13934c..c4cc38ee3d 100644 --- a/src/analyses/threadJoins.ml +++ b/src/analyses/threadJoins.ml @@ -1,4 +1,5 @@ -(** Thread join analysis. *) +(** Joined threads analysis ([threadJoins]). *) + open GoblintCil open Analyses diff --git a/src/analyses/threadReturn.ml b/src/analyses/threadReturn.ml index 4fd7303388..3a9d6b07e1 100644 --- a/src/analyses/threadReturn.ml +++ b/src/analyses/threadReturn.ml @@ -1,4 +1,4 @@ -(** Thread returning analysis. *) +(** Thread returning analysis using boolean call stack ([threadreturn]). *) open GoblintCil open Analyses diff --git a/src/analyses/tutorials/constants.ml b/src/analyses/tutorials/constants.ml index 6ffeaaa874..e1d341e993 100644 --- a/src/analyses/tutorials/constants.ml +++ b/src/analyses/tutorials/constants.ml @@ -1,3 +1,4 @@ +(** Simple intraprocedural integer constants analysis example ([constants]). *) open GoblintCil open Analyses diff --git a/src/analyses/tutorials/signs.ml b/src/analyses/tutorials/signs.ml index ddbb3b035e..dec69d03f7 100644 --- a/src/analyses/tutorials/signs.ml +++ b/src/analyses/tutorials/signs.ml @@ -1,4 +1,4 @@ -(** An analysis specification for didactic purposes. *) +(** Simple intraprocedural integer signs analysis template ([signs]). *) open GoblintCil open Analyses diff --git a/src/analyses/tutorials/taint.ml b/src/analyses/tutorials/taint.ml index f01c2bdd70..217125c8bd 100644 --- a/src/analyses/tutorials/taint.ml +++ b/src/analyses/tutorials/taint.ml @@ -1,3 +1,5 @@ +(** Simple interprocedural taint analysis template ([taint]). *) + (** An analysis specification for didactic purposes. *) (* Helpful link on CIL: https://goblint.in.tum.de/assets/goblint-cil/ *) (* Goblint documentation: https://goblint.readthedocs.io/en/latest/ *) diff --git a/src/analyses/tutorials/unitAnalysis.ml b/src/analyses/tutorials/unitAnalysis.ml index 0a72cb1c89..d3b8c69bfd 100644 --- a/src/analyses/tutorials/unitAnalysis.ml +++ b/src/analyses/tutorials/unitAnalysis.ml @@ -1,4 +1,4 @@ -(** An analysis specification for didactic purposes. *) +(** Simplest possible analysis with unit domain ([unit]). *) open GoblintCil open Analyses diff --git a/src/analyses/unassumeAnalysis.ml b/src/analyses/unassumeAnalysis.ml index 1379012d82..0ee8acf35a 100644 --- a/src/analyses/unassumeAnalysis.ml +++ b/src/analyses/unassumeAnalysis.ml @@ -1,6 +1,7 @@ -(** Unassume analysis. +(** Unassume analysis ([unassume]). Emits unassume events for other analyses based on YAML witness invariants. *) + open Analyses module Cil = GoblintCil.Cil diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index cdb3124c87..9501c4a166 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -1,4 +1,4 @@ -(** Local variable initialization analysis. *) +(** Analysis of initialized local variables ([uninit]). *) module M = Messages module AD = ValueDomain.AD diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index ad49a0d93d..7e310d9784 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -1,4 +1,4 @@ -(** Variable equalities necessary for per-element patterns. *) +(** Symbolic expression equalities analysis ([var_eq]). *) module Addr = ValueDomain.Addr module Offs = ValueDomain.Offs diff --git a/src/analyses/vla.ml b/src/analyses/vla.ml index 1b738d040f..865f22b20a 100644 --- a/src/analyses/vla.ml +++ b/src/analyses/vla.ml @@ -1,4 +1,4 @@ -(** An analysis to detect if an invocation is in the scope of a variably modified variable. *) +(** Analysis of variable-length arrays (VLAs) in scope ([vla]). *) open GoblintCil open Analyses diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index d36f3e1dbe..91abdf1bef 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -59,9 +59,13 @@ module JsonSchema = JsonSchema module Options = Options -(** {1 Analyses} *) +(** {1 Analyses} -(** {2 Value} *) + Analyses activatable under MCP. *) + +(** {2 Value} + + Analyses related to values of program variables. *) module Base = Base module RelationAnalysis = RelationAnalysis @@ -70,16 +74,22 @@ module AffineEqualityAnalysis = AffineEqualityAnalysis module VarEq = VarEq module CondVars = CondVars -(** {2 Heap} *) +(** {2 Heap} + + Analyses related to the heap. *) module MallocWrapperAnalysis = MallocWrapperAnalysis module Region = Region module MallocFresh = MallocFresh module Malloc_null = Malloc_null -(** {2 Concurrency} *) +(** {2 Concurrency} + + Analyses related to concurrency. *) + +(** {3 Locks} -(** {3 Locks} *) + Analyses related to locking. *) module MutexEventsAnalysis = MutexEventsAnalysis module LocksetAnalysis = LocksetAnalysis @@ -88,7 +98,9 @@ module MayLocks = MayLocks module SymbLocks = SymbLocks module Deadlock = Deadlock -(** {3 Threads} *) +(** {3 Threads} + + Analyses related to threads. *) module ThreadFlag = ThreadFlag module ThreadId = ThreadId @@ -106,7 +118,9 @@ module ThreadEscape = ThreadEscape module PthreadSignals = PthreadSignals module ExtractPthread = ExtractPthread -(** {2 Longjmp} *) +(** {2 Longjmp} + + Analyses related to [longjmp] and [setjmp]. *) module ActiveSetjmp = ActiveSetjmp module ModifiedSinceLongjmp = ModifiedSinceLongjmp @@ -114,7 +128,9 @@ module ActiveLongjmp = ActiveLongjmp module PoisonVariables = PoisonVariables module Vla = Vla -(** {2 Tutorial} *) +(** {2 Tutorial} + + Analyses for didactic purposes. *) module Constants = Constants module Signs = Signs @@ -131,7 +147,9 @@ module Expsplit = Expsplit module StackTrace = StackTrace module Spec = Spec -(** {2 Helper} *) +(** {2 Helper} + + Analyses which only support other analyses. *) module AccessAnalysis = AccessAnalysis module TaintPartialContexts = TaintPartialContexts From c5a9d9d749e0331d580453283591d0f378cc9f67 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 14:40:28 +0300 Subject: [PATCH 224/518] Add domains synopses --- src/cdomains/addressDomain.ml | 2 ++ .../apron/affineEqualityDomain.apron.ml | 4 +++ src/cdomains/apron/apronDomain.apron.ml | 2 ++ src/cdomains/apron/relationDomain.apron.ml | 4 ++- src/cdomains/arrayDomain.mli | 2 ++ src/cdomains/baseDomain.ml | 2 +- src/cdomains/basetype.ml | 2 ++ src/cdomains/cilLval.ml | 2 ++ src/cdomains/concDomain.ml | 2 ++ src/cdomains/deadlockDomain.ml | 2 ++ src/cdomains/escapeDomain.ml | 2 ++ src/cdomains/fileDomain.ml | 2 ++ src/cdomains/floatDomain.mli | 4 +-- src/cdomains/intDomain.mli | 4 +-- src/cdomains/jmpBufDomain.ml | 2 ++ src/cdomains/lockDomain.ml | 2 ++ src/cdomains/lval.ml | 2 ++ src/cdomains/lvalMapDomain.ml | 2 ++ src/cdomains/mHP.ml | 2 ++ src/cdomains/musteqDomain.ml | 2 ++ src/cdomains/pthreadDomain.ml | 2 ++ src/cdomains/regionDomain.ml | 2 ++ src/cdomains/specDomain.ml | 2 ++ src/cdomains/stackDomain.ml | 2 ++ src/cdomains/structDomain.mli | 2 +- src/cdomains/symbLocksDomain.ml | 2 ++ src/cdomains/threadFlagDomain.ml | 2 ++ src/cdomains/threadIdDomain.ml | 2 ++ src/cdomains/unionDomain.ml | 2 ++ src/cdomains/valueDomain.ml | 2 ++ src/domains/abstractionDomainProperties.ml | 2 ++ src/domains/access.ml | 2 ++ src/domains/accessDomain.ml | 2 ++ src/domains/boolDomain.ml | 2 ++ src/domains/domainProperties.ml | 2 ++ src/domains/flagHelper.ml | 2 ++ src/domains/intDomainProperties.ml | 2 ++ src/domains/lattice.ml | 3 ++- src/domains/mapDomain.ml | 2 +- src/domains/printable.ml | 3 ++- src/domains/setDomain.ml | 3 ++- src/domains/valueDomainQueries.ml | 2 ++ src/goblint_lib.ml | 27 ++++++++++++++----- 43 files changed, 105 insertions(+), 17 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index c6905a5cdc..cd3290ddff 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -1,3 +1,5 @@ +(** Domains for addresses/pointers. *) + open GoblintCil open IntOps diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 72448c7415..6c24a46c6e 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -1,3 +1,7 @@ +(** OCaml implementation of the affine equalities domain. + + @see Karr, M. Affine relationships among variables of a program. *) + (** Abstract states in the newly added domain are represented by structs containing a matrix and an apron environment. Matrices are modeled as proposed by Karr: Each variable is assigned to a column and each row represents a linear affine relationship that must hold at the corresponding program point. The apron environment is hereby used to organize the order of columns and variables. *) diff --git a/src/cdomains/apron/apronDomain.apron.ml b/src/cdomains/apron/apronDomain.apron.ml index eee8d50b60..d9928df597 100644 --- a/src/cdomains/apron/apronDomain.apron.ml +++ b/src/cdomains/apron/apronDomain.apron.ml @@ -1,3 +1,5 @@ +(** {!Apron} domains. *) + open Batteries open GoblintCil open Pretty diff --git a/src/cdomains/apron/relationDomain.apron.ml b/src/cdomains/apron/relationDomain.apron.ml index ca386b99bf..e52e704373 100644 --- a/src/cdomains/apron/relationDomain.apron.ml +++ b/src/cdomains/apron/relationDomain.apron.ml @@ -1,4 +1,6 @@ -(** Interfaces/implementations that generalize the apronDomain and affineEqualityDomain. *) +(** Signatures for relational value domains. + + See {!ApronDomain} and {!AffineEqualityDomain}. *) open Batteries open GoblintCil diff --git a/src/cdomains/arrayDomain.mli b/src/cdomains/arrayDomain.mli index 91e526235d..ebf265ac0b 100644 --- a/src/cdomains/arrayDomain.mli +++ b/src/cdomains/arrayDomain.mli @@ -1,3 +1,5 @@ +(** Abstract domains for C arrays. *) + open IntOps open GoblintCil module VDQ = ValueDomainQueries diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml index 00c7e0a7c2..242d83e708 100644 --- a/src/cdomains/baseDomain.ml +++ b/src/cdomains/baseDomain.ml @@ -1,4 +1,4 @@ -(** domain of the base analysis *) +(** Full domain of {!Base} analysis. *) open GoblintCil module VD = ValueDomain.Compound diff --git a/src/cdomains/basetype.ml b/src/cdomains/basetype.ml index 19aff2db5a..b7c1215746 100644 --- a/src/cdomains/basetype.ml +++ b/src/cdomains/basetype.ml @@ -1,3 +1,5 @@ +(** Printables and domains for some common types. *) + module GU = Goblintutil open GoblintCil diff --git a/src/cdomains/cilLval.ml b/src/cdomains/cilLval.ml index 74118785ef..9a86a3b083 100644 --- a/src/cdomains/cilLval.ml +++ b/src/cdomains/cilLval.ml @@ -1 +1,3 @@ +(** Domains for {!GoblintCil.lval}. *) + module Set = SetDomain.ToppedSet (CilType.Lval) (struct let topname = "All" end) diff --git a/src/cdomains/concDomain.ml b/src/cdomains/concDomain.ml index 94df15cb7a..b16cdf1d9f 100644 --- a/src/cdomains/concDomain.ml +++ b/src/cdomains/concDomain.ml @@ -1,3 +1,5 @@ +(** Domains for thread sets and their uniqueness. *) + module ThreadSet = SetDomain.ToppedSet (ThreadIdDomain.Thread) (struct let topname = "All Threads" end) module MustThreadSet = SetDomain.Reverse(ThreadSet) diff --git a/src/cdomains/deadlockDomain.ml b/src/cdomains/deadlockDomain.ml index 06fc16600c..1e62a48933 100644 --- a/src/cdomains/deadlockDomain.ml +++ b/src/cdomains/deadlockDomain.ml @@ -1,3 +1,5 @@ +(** Deadlock domain. *) + module Lock = LockDomain.Addr module LockEvent = Printable.Prod3 (Lock) (Node) (MCPAccess.A) diff --git a/src/cdomains/escapeDomain.ml b/src/cdomains/escapeDomain.ml index 4c2331d9ab..1e2769dcd7 100644 --- a/src/cdomains/escapeDomain.ml +++ b/src/cdomains/escapeDomain.ml @@ -1,3 +1,5 @@ +(** Domain for escaped thread-local variables. *) + module EscapedVars = struct include SetDomain.ToppedSet (Basetype.Variables) (struct let topname = "All Variables" end) diff --git a/src/cdomains/fileDomain.ml b/src/cdomains/fileDomain.ml index 775587da68..3a10d7f8b7 100644 --- a/src/cdomains/fileDomain.ml +++ b/src/cdomains/fileDomain.ml @@ -1,3 +1,5 @@ +(** Domains for file handles. *) + open Batteries module D = LvalMapDomain diff --git a/src/cdomains/floatDomain.mli b/src/cdomains/floatDomain.mli index 8be4304c5e..06dbf644f8 100644 --- a/src/cdomains/floatDomain.mli +++ b/src/cdomains/floatDomain.mli @@ -1,5 +1,5 @@ -(** Abstract Domains for floats. These are domains that support the C - * operations on double/float values. *) +(** Abstract domains for C floating-point numbers. *) + open GoblintCil exception ArithmeticOnFloatBot of string diff --git a/src/cdomains/intDomain.mli b/src/cdomains/intDomain.mli index 4671fb3013..a853c8acca 100644 --- a/src/cdomains/intDomain.mli +++ b/src/cdomains/intDomain.mli @@ -1,5 +1,5 @@ -(** Abstract Domains for integers. These are domains that support the C - * operations on integer values. *) +(** Abstract domains for C integers. *) + open GoblintCil val should_wrap: Cil.ikind -> bool diff --git a/src/cdomains/jmpBufDomain.ml b/src/cdomains/jmpBufDomain.ml index 4188ff55a6..3c94fa8f47 100644 --- a/src/cdomains/jmpBufDomain.ml +++ b/src/cdomains/jmpBufDomain.ml @@ -1,3 +1,5 @@ +(** Domains for [setjmp] and [longjmp] analyses, and [setjmp] buffers. *) + module BufferEntry = Printable.ProdSimple(Node)(ControlSpecC) module BufferEntryOrTop = struct diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 0ebcf4a8a5..6a4649b002 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -1,3 +1,5 @@ +(** Lockset domains. *) + module Addr = ValueDomain.Addr module Offs = ValueDomain.Offs module Equ = MusteqDomain.Equ diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index c6c585d751..8682864165 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -1,3 +1,5 @@ +(** Domains for offsets and lvalues. *) + open GoblintCil open Pretty diff --git a/src/cdomains/lvalMapDomain.ml b/src/cdomains/lvalMapDomain.ml index 4521142aa8..fe442745dd 100644 --- a/src/cdomains/lvalMapDomain.ml +++ b/src/cdomains/lvalMapDomain.ml @@ -1,3 +1,5 @@ +(** Domains for lvalue maps. *) + open Batteries open GoblintCil diff --git a/src/cdomains/mHP.ml b/src/cdomains/mHP.ml index 9bcd9d739f..8037cfa21d 100644 --- a/src/cdomains/mHP.ml +++ b/src/cdomains/mHP.ml @@ -1,3 +1,5 @@ +(** May-happen-in-parallel (MHP) domain. *) + include Printable.Std let name () = "mhp" diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index bf3d694c23..13acbca5fe 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -1,3 +1,5 @@ +(** Symbolic lvalue equalities domain. *) + open GoblintCil open Pretty diff --git a/src/cdomains/pthreadDomain.ml b/src/cdomains/pthreadDomain.ml index f16bf29722..8cef57bdbd 100644 --- a/src/cdomains/pthreadDomain.ml +++ b/src/cdomains/pthreadDomain.ml @@ -1,3 +1,5 @@ +(** Domains for extraction of Pthread programs. *) + open Batteries (** Thread ID *) diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index 1a500ee102..ed6e980d74 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -1,3 +1,5 @@ +(** Domains for disjoint heap regions. *) + open GoblintCil open GobConfig diff --git a/src/cdomains/specDomain.ml b/src/cdomains/specDomain.ml index 7194b83071..364657d2f7 100644 --- a/src/cdomains/specDomain.ml +++ b/src/cdomains/specDomain.ml @@ -1,3 +1,5 @@ +(** Domains for finite automaton specification file analysis. *) + open Batteries module D = LvalMapDomain diff --git a/src/cdomains/stackDomain.ml b/src/cdomains/stackDomain.ml index b3300bb11b..6cc007b701 100644 --- a/src/cdomains/stackDomain.ml +++ b/src/cdomains/stackDomain.ml @@ -1,3 +1,5 @@ +(** Call stack domains. *) + module GU = Goblintutil module type S = diff --git a/src/cdomains/structDomain.mli b/src/cdomains/structDomain.mli index d83d807096..15b75c6d41 100644 --- a/src/cdomains/structDomain.mli +++ b/src/cdomains/structDomain.mli @@ -1,4 +1,4 @@ -(** Abstract domains representing structs. *) +(** Abstract domains for C structs. *) open GoblintCil diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index 696d1655a4..24dfcdfd2b 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -1,3 +1,5 @@ +(** Symbolic lockset domain. *) + open GoblintCil module M = Messages diff --git a/src/cdomains/threadFlagDomain.ml b/src/cdomains/threadFlagDomain.ml index 09d19d9e74..80ba9b7a52 100644 --- a/src/cdomains/threadFlagDomain.ml +++ b/src/cdomains/threadFlagDomain.ml @@ -1,3 +1,5 @@ +(** Multi-threadedness flag domains. *) + module type S = sig include Lattice.S diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index 57e8b443dc..b81a86811a 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -1,3 +1,5 @@ +(** Thread ID domains. *) + open GoblintCil open FlagHelper diff --git a/src/cdomains/unionDomain.ml b/src/cdomains/unionDomain.ml index d2657621e7..08efecf421 100644 --- a/src/cdomains/unionDomain.ml +++ b/src/cdomains/unionDomain.ml @@ -1,3 +1,5 @@ +(** Abstract domains for C unions. *) + open GoblintCil module type Arg = diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 40904ee9b6..2d7a206c68 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -1,3 +1,5 @@ +(** Domain for a single {!Base} analysis value. *) + open GoblintCil open Pretty open PrecisionUtil diff --git a/src/domains/abstractionDomainProperties.ml b/src/domains/abstractionDomainProperties.ml index 208e433e86..1772af0b6b 100644 --- a/src/domains/abstractionDomainProperties.ml +++ b/src/domains/abstractionDomainProperties.ml @@ -1,3 +1,5 @@ +(** QCheck properties for abstract operations. *) + module type AbstractFunction = sig type c diff --git a/src/domains/access.ml b/src/domains/access.ml index 8d9d585015..c40e6f136c 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -1,3 +1,5 @@ +(** Memory accesses and their manipulation. *) + open Batteries open GoblintCil open Pretty diff --git a/src/domains/accessDomain.ml b/src/domains/accessDomain.ml index 3c4813299e..5884214976 100644 --- a/src/domains/accessDomain.ml +++ b/src/domains/accessDomain.ml @@ -1,3 +1,5 @@ +(** Domain for memory accesses. *) + open GoblintCil.Pretty module Event = diff --git a/src/domains/boolDomain.ml b/src/domains/boolDomain.ml index 4fe060a961..e088c3605c 100644 --- a/src/domains/boolDomain.ml +++ b/src/domains/boolDomain.ml @@ -1,3 +1,5 @@ +(** Boolean domains. *) + module Bool = struct include Basetype.RawBools diff --git a/src/domains/domainProperties.ml b/src/domains/domainProperties.ml index 38f32ea059..b2f0f7671a 100644 --- a/src/domains/domainProperties.ml +++ b/src/domains/domainProperties.ml @@ -1,3 +1,5 @@ +(** QCheck properties for lattice properties. *) + open QCheck module DomainTest (D: Lattice.S) = diff --git a/src/domains/flagHelper.ml b/src/domains/flagHelper.ml index 7ddf493048..933d371f48 100644 --- a/src/domains/flagHelper.ml +++ b/src/domains/flagHelper.ml @@ -1,3 +1,5 @@ +(** Domain alternatives chosen by a runtime flag. *) + module type FlagError = sig val msg: string val name: string diff --git a/src/domains/intDomainProperties.ml b/src/domains/intDomainProperties.ml index a40862b446..9dcb867efc 100644 --- a/src/domains/intDomainProperties.ml +++ b/src/domains/intDomainProperties.ml @@ -1,3 +1,5 @@ +(** QCheck properties for {!IntDomain}. *) + open GoblintCil module BI = IntOps.BigIntOps diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index 960a2a69ac..b21389665a 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -1,4 +1,5 @@ -(** The lattice signature and simple functors for building lattices. *) +(** Signature for lattices. + Functors for common lattices. *) module Pretty = GoblintCil.Pretty module GU = Goblintutil diff --git a/src/domains/mapDomain.ml b/src/domains/mapDomain.ml index 7b4902b1c2..83b0ec4c36 100644 --- a/src/domains/mapDomain.ml +++ b/src/domains/mapDomain.ml @@ -1,4 +1,4 @@ -(** Specification and functors for maps. *) +(** Map domains. *) module Pretty = GoblintCil.Pretty open Pretty diff --git a/src/domains/printable.ml b/src/domains/printable.ml index 4f68bc29a5..495d294e6e 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -1,4 +1,5 @@ -(** Some things are not quite lattices ... *) +(** Signature for comparable and outputtable elements. + Functors for common printables. *) module Pretty = GoblintCil.Pretty open Pretty diff --git a/src/domains/setDomain.ml b/src/domains/setDomain.ml index 69196fb8df..1b5239de80 100644 --- a/src/domains/setDomain.ml +++ b/src/domains/setDomain.ml @@ -1,4 +1,5 @@ -(** Abstract domains representing sets. *) +(** Set domains. *) + module Pretty = GoblintCil.Pretty open Pretty diff --git a/src/domains/valueDomainQueries.ml b/src/domains/valueDomainQueries.ml index 5f95320cfe..c89e491e58 100644 --- a/src/domains/valueDomainQueries.ml +++ b/src/domains/valueDomainQueries.ml @@ -1,3 +1,5 @@ +(** Queries within {!ValueDomain}. *) + open GoblintCil open BoolDomain diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 91abdf1bef..273264927b 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -158,12 +158,19 @@ module ExpRelation = ExpRelation module AbortUnless = AbortUnless -(** {1 Domains} *) +(** {1 Domains} + + Domains used by analysis specifications and constraint systems are {{!Lattice.S} lattices}. + + Besides lattice operations, their elements can also be compared and output (in various formats). + Those operations are specified by {!Printable.S}. *) module Printable = Printable module Lattice = Lattice -(** {2 General} *) +(** {2 General} + + Standard general-purpose domains and domain functors. *) module BoolDomain = BoolDomain module SetDomain = SetDomain @@ -173,11 +180,15 @@ module HoareDomain = HoareDomain module PartitionDomain = PartitionDomain module FlagHelper = FlagHelper -(** {2 Analysis-specific} *) +(** {2 Analysis-specific} + + Domains for specific analyses. *) (** {3 Value} *) -(** {4 Non-relational} *) +(** {4 Non-relational} + + Domains for {!Base} analysis. *) module BaseDomain = BaseDomain module ValueDomain = ValueDomain @@ -190,7 +201,9 @@ module ArrayDomain = ArrayDomain module JmpBufDomain = JmpBufDomain module ValueDomainQueries = ValueDomainQueries -(** {4 Relational} *) +(** {4 Relational} + + Domains for {!RelationAnalysis}. *) module RelationDomain = RelationDomain module ApronDomain = ApronDomain @@ -226,7 +239,9 @@ module StackDomain = StackDomain module LvalMapDomain = LvalMapDomain module SpecDomain = SpecDomain -(** {2 Testing} *) +(** {2 Testing} + + Modules related to (property-based) testing of domains. *) module DomainProperties = DomainProperties module AbstractionDomainProperties = AbstractionDomainProperties From b4d550fcd4ad34ce5b0840d04f7cbafc38caa7f8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 14:48:14 +0300 Subject: [PATCH 225/518] Add incremental synopses --- src/goblint_lib.ml | 4 +++- src/incremental/compareAST.ml | 2 ++ src/incremental/compareCFG.ml | 2 ++ src/incremental/compareCIL.ml | 2 ++ src/incremental/maxIdUtil.ml | 2 ++ src/incremental/serialize.ml | 2 ++ src/incremental/updateCil.ml | 2 ++ src/util/cilMaps.ml | 2 ++ 8 files changed, 17 insertions(+), 1 deletion(-) diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 273264927b..3bd553c91a 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -248,7 +248,9 @@ module AbstractionDomainProperties = AbstractionDomainProperties module IntDomainProperties = IntDomainProperties -(** {1 Incremental} *) +(** {1 Incremental} + + Incremental analysis is for analyzing multiple versions of the same program and reusing as many results as possible. *) module CompareCIL = CompareCIL module CompareAST = CompareAST diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index ce71b43392..28dce7a8c6 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -1,3 +1,5 @@ +(** Comparison of CIL ASTs. *) + open GoblintCil open CilMaps diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 93bb855606..e822166d38 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -1,3 +1,5 @@ +(** Comparison of CFGs. *) + open MyCFG open Queue open GoblintCil diff --git a/src/incremental/compareCIL.ml b/src/incremental/compareCIL.ml index b218cb18e0..1a83048b6c 100644 --- a/src/incremental/compareCIL.ml +++ b/src/incremental/compareCIL.ml @@ -1,3 +1,5 @@ +(** Comparison of CIL files. *) + open GoblintCil open MyCFG open CilMaps diff --git a/src/incremental/maxIdUtil.ml b/src/incremental/maxIdUtil.ml index 7854fd8a59..a5c4fdda61 100644 --- a/src/incremental/maxIdUtil.ml +++ b/src/incremental/maxIdUtil.ml @@ -1,3 +1,5 @@ +(** Tracking of maximum CIL IDs in use. *) + open GoblintCil type max_ids = { diff --git a/src/incremental/serialize.ml b/src/incremental/serialize.ml index 63e94e730d..bddf3aa383 100644 --- a/src/incremental/serialize.ml +++ b/src/incremental/serialize.ml @@ -1,3 +1,5 @@ +(** Serialization/deserialization of incremental analysis data. *) + open Batteries (* TODO: GoblintDir *) diff --git a/src/incremental/updateCil.ml b/src/incremental/updateCil.ml index 2f9628b4c1..60a3379ec1 100644 --- a/src/incremental/updateCil.ml +++ b/src/incremental/updateCil.ml @@ -1,3 +1,5 @@ +(** Combination of CIL files using comparison results. *) + open GoblintCil open CompareCIL open MaxIdUtil diff --git a/src/util/cilMaps.ml b/src/util/cilMaps.ml index 9b3b91f5c6..8f961a09e0 100644 --- a/src/util/cilMaps.ml +++ b/src/util/cilMaps.ml @@ -1,3 +1,5 @@ +(** Special maps used for incremental comparison. *) + open GoblintCil module VarinfoOrdered = struct From 118cd38c790798aa4c50ea6ee05e0bd37997656b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 15:15:59 +0300 Subject: [PATCH 226/518] Add solver synopses --- src/goblint_lib.ml | 16 +++++++++++----- src/solvers/effectWConEq.ml | 2 ++ src/solvers/generic.ml | 2 ++ src/solvers/postSolver.ml | 2 ++ src/solvers/sLR.ml | 4 +++- src/solvers/sLRphased.ml | 2 ++ src/solvers/sLRterm.ml | 3 +++ src/solvers/selector.ml | 2 ++ src/solvers/solverBox.ml | 2 ++ src/solvers/td3.ml | 5 +++++ src/solvers/topDown.ml | 3 ++- src/solvers/topDown_deprecated.ml | 2 ++ src/solvers/topDown_space_cache_term.ml | 4 ++-- src/solvers/topDown_term.ml | 3 ++- src/solvers/worklist.ml | 2 ++ 15 files changed, 44 insertions(+), 10 deletions(-) diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 3bd553c91a..aea839ec58 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -261,9 +261,13 @@ module Serialize = Serialize module CilMaps = CilMaps -(** {1 Solvers} *) +(** {1 Solvers} -(** {2 Top-down} *) + Generic solvers are used to solve {{!Analyses.MonSystem} (side-effecting) constraint systems}. *) + +(** {2 Top-down} + + The top-down solver family. *) module Td3 = Td3 module TopDown = TopDown @@ -271,11 +275,13 @@ module TopDown_term = TopDown_term module TopDown_space_cache_term = TopDown_space_cache_term module TopDown_deprecated = TopDown_deprecated -(** {2 SLR} *) +(** {2 SLR} + + The SLR solver family. *) -module SLR = SLR -module SLRterm = SLRterm module SLRphased = SLRphased +module SLRterm = SLRterm +module SLR = SLR (** {2 Other} *) diff --git a/src/solvers/effectWConEq.ml b/src/solvers/effectWConEq.ml index f0bea7ba11..c6dcf8f0e9 100644 --- a/src/solvers/effectWConEq.ml +++ b/src/solvers/effectWConEq.ml @@ -1,3 +1,5 @@ +(** ([effectWConEq]). *) + open Batteries open Analyses open Constraints diff --git a/src/solvers/generic.ml b/src/solvers/generic.ml index bf6413ae68..88c5ac699f 100644 --- a/src/solvers/generic.ml +++ b/src/solvers/generic.ml @@ -1,3 +1,5 @@ +(** Various old solvers. *) + open Batteries open GobConfig open Analyses diff --git a/src/solvers/postSolver.ml b/src/solvers/postSolver.ml index faa5f28083..a6490f182d 100644 --- a/src/solvers/postSolver.ml +++ b/src/solvers/postSolver.ml @@ -1,3 +1,5 @@ +(** Extra constraint system evaluation pass for warning generation, verification, pruning, etc. *) + open Batteries open Analyses open GobConfig diff --git a/src/solvers/sLR.ml b/src/solvers/sLR.ml index 4f0b6c60af..3e5730da04 100644 --- a/src/solvers/sLR.ml +++ b/src/solvers/sLR.ml @@ -1,4 +1,6 @@ -(** The 'slr*' solvers. *) +(** Various SLR solvers. + + @see Apinis, K. Frameworks for analyzing multi-threaded C. *) open Batteries open Analyses diff --git a/src/solvers/sLRphased.ml b/src/solvers/sLRphased.ml index e3803c1764..f4c3389f1d 100644 --- a/src/solvers/sLRphased.ml +++ b/src/solvers/sLRphased.ml @@ -1,3 +1,5 @@ +(** Two-phased terminating SLR3 solver ([slr3tp]). *) + open Batteries open Analyses open Constraints diff --git a/src/solvers/sLRterm.ml b/src/solvers/sLRterm.ml index deb18ccd73..d4f4671c46 100644 --- a/src/solvers/sLRterm.ml +++ b/src/solvers/sLRterm.ml @@ -1,3 +1,6 @@ +(** Terminating SLR3 solver ([slr3t]). + Simpler version of {!SLRphased} without phases. *) + open Batteries open Analyses open Constraints diff --git a/src/solvers/selector.ml b/src/solvers/selector.ml index 5d15c5d9f9..664cbe0513 100644 --- a/src/solvers/selector.ml +++ b/src/solvers/selector.ml @@ -1,3 +1,5 @@ +(** Solver, which delegates at runtime to the configured solver. *) + open Batteries open Analyses open GobConfig diff --git a/src/solvers/solverBox.ml b/src/solvers/solverBox.ml index a261570e74..6472dd7870 100644 --- a/src/solvers/solverBox.ml +++ b/src/solvers/solverBox.ml @@ -1,3 +1,5 @@ +(** Box operator for warrowing solvers. *) + module type S = functor (D: Lattice.S) -> sig diff --git a/src/solvers/td3.ml b/src/solvers/td3.ml index ea5bbfb7ed..b59361fbef 100644 --- a/src/solvers/td3.ml +++ b/src/solvers/td3.ml @@ -1,3 +1,8 @@ +(** Incremental/interactive terminating top-down solver, which supports space-efficiency and caching ([td3]). + + @see Seidl, H., Vogler, R. Three improvements to the top-down solver. + @see Interactive Abstract Interpretation: Reanalyzing Whole Programs for Cheap. *) + (** Incremental terminating top down solver that optionally only keeps values at widening points and restores other values afterwards. *) (* Incremental: see paper 'Incremental Abstract Interpretation' https://link.springer.com/chapter/10.1007/978-3-030-41103-9_5 *) (* TD3: see paper 'Three Improvements to the Top-Down Solver' https://dl.acm.org/doi/10.1145/3236950.3236967 diff --git a/src/solvers/topDown.ml b/src/solvers/topDown.ml index d1cf99199d..c6b20d28db 100644 --- a/src/solvers/topDown.ml +++ b/src/solvers/topDown.ml @@ -1,4 +1,5 @@ -(** Top down solver using box/warrow. This is superseded by td3 but kept as a simple version without term & space (& incremental). *) +(** Warrowing top-down solver ([topdown]). + Simpler version of {!Td3} without terminating, space-efficiency and incremental. *) open Batteries open Analyses diff --git a/src/solvers/topDown_deprecated.ml b/src/solvers/topDown_deprecated.ml index f8276c8dc1..02a6b29c6b 100644 --- a/src/solvers/topDown_deprecated.ml +++ b/src/solvers/topDown_deprecated.ml @@ -1,3 +1,5 @@ +(** Deprecated top-down solver ([topdown_deprecated]). *) + open Batteries open Analyses open Constraints diff --git a/src/solvers/topDown_space_cache_term.ml b/src/solvers/topDown_space_cache_term.ml index 42ba33b4fb..c99492ca33 100644 --- a/src/solvers/topDown_space_cache_term.ml +++ b/src/solvers/topDown_space_cache_term.ml @@ -1,5 +1,5 @@ -(** Terminating top down solver that only keeps values at widening points and restores other values afterwards. *) -(* This is superseded by td3 but kept as a simpler version without the incremental parts. *) +(** Terminating top-down solver, which supports space-efficiency and caching ([topdown_space_cache_term]). + Simpler version of {!Td3} without incremental. *) open Batteries open Analyses diff --git a/src/solvers/topDown_term.ml b/src/solvers/topDown_term.ml index 577e7ea814..ec07995586 100644 --- a/src/solvers/topDown_term.ml +++ b/src/solvers/topDown_term.ml @@ -1,4 +1,5 @@ -(** Top down solver. *) +(** Terminating top-down solver ([topdown_term]). + Simpler version of {!Td3} without space-efficiency and incremental. *) open Batteries open Analyses diff --git a/src/solvers/worklist.ml b/src/solvers/worklist.ml index 138024f137..b525764c74 100644 --- a/src/solvers/worklist.ml +++ b/src/solvers/worklist.ml @@ -1,3 +1,5 @@ +(** Worklist solver ([WL]). *) + open Batteries open Analyses open Constraints From a9e177a7b378082a18bb9571b59f6e4adb836698 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 15:52:24 +0300 Subject: [PATCH 227/518] Add I/O synopses --- src/domains/invariant.ml | 2 ++ src/domains/invariantCil.ml | 2 ++ src/framework/refinement.ml | 2 ++ src/goblint_lib.ml | 24 ++++++++++++++++++------ src/incremental/makefileUtil.ml | 2 ++ src/util/compilationDatabase.ml | 2 ++ src/util/messages.ml | 2 ++ src/util/preprocessor.ml | 2 ++ src/util/sarif.ml | 2 ++ src/util/sarifRules.ml | 1 + src/util/sarifType.ml | 1 + src/util/tracing.ml | 2 ++ src/util/wideningTokens.ml | 1 + src/witness/argTools.ml | 2 ++ src/witness/graphml.ml | 2 ++ src/witness/myARG.ml | 2 ++ src/witness/observerAnalysis.ml | 2 ++ src/witness/observerAutomaton.ml | 2 ++ src/witness/svcomp.ml | 2 ++ src/witness/svcompSpec.ml | 2 ++ src/witness/violation.ml | 2 ++ src/witness/witness.ml | 2 ++ src/witness/witnessConstraints.ml | 2 +- src/witness/witnessUtil.ml | 2 ++ src/witness/yamlWitness.ml | 2 ++ src/witness/yamlWitnessType.ml | 2 ++ src/witness/z3/violationZ3.no-z3.ml | 2 ++ src/witness/z3/violationZ3.z3.ml | 2 ++ 28 files changed, 68 insertions(+), 7 deletions(-) diff --git a/src/domains/invariant.ml b/src/domains/invariant.ml index ff50aa801e..042554c4e3 100644 --- a/src/domains/invariant.ml +++ b/src/domains/invariant.ml @@ -1,3 +1,5 @@ +(** Invariants for witnesses. *) + open GoblintCil (** Symbolic (and fully syntactic) expression "lattice". *) diff --git a/src/domains/invariantCil.ml b/src/domains/invariantCil.ml index 2e647f6920..8a1d8f0745 100644 --- a/src/domains/invariantCil.ml +++ b/src/domains/invariantCil.ml @@ -1,3 +1,5 @@ +(** Invariant manipulation related to CIL transformations. *) + open GoblintCil diff --git a/src/framework/refinement.ml b/src/framework/refinement.ml index e23aea0095..8c6181b9d6 100644 --- a/src/framework/refinement.ml +++ b/src/framework/refinement.ml @@ -1,3 +1,5 @@ +(** Experimental analysis refinement. *) + (** Restarts the analysis from scratch in Control. Its raiser is expected to have modified modified some global state to do a more precise analysis next time. diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index aea839ec58..1d820b25e9 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -295,18 +295,24 @@ module LocalFixpoint = LocalFixpoint module SolverBox = SolverBox -(** {1 I/O} *) +(** {1 I/O} + + Various input/output interfaces and formats. *) module Messages = Messages module Tracing = Tracing -(** {2 Front-end} *) +(** {2 Front-end} + + The following modules handle program input. *) module Preprocessor = Preprocessor module CompilationDatabase = CompilationDatabase module MakefileUtil = MakefileUtil -(** {2 Witnesses} *) +(** {2 Witnesses} + + Witnesses are an exchangeable format for analysis results. *) module Svcomp = Svcomp module SvcompSpec = SvcompSpec @@ -315,7 +321,9 @@ module Invariant = Invariant module InvariantCil = InvariantCil module WitnessUtil = WitnessUtil -(** {3 GraphML} *) +(** {3 GraphML} + + Automaton-based GraphML witnesses used in SV-COMP. *) module MyARG = MyARG module WitnessConstraints = WitnessConstraints @@ -323,13 +331,17 @@ module ArgTools = ArgTools module Witness = Witness module Graphml = Graphml -(** {3 YAML}*) +(** {3 YAML} + + Entry-based YAML witnesses to be used in SV-COMP. *) module YamlWitness = YamlWitness module YamlWitnessType = YamlWitnessType module WideningTokens = WideningTokens -(** {3 Violation} *) +(** {3 Violation} + + Experimental generation of violation witness automata or refinement with observer automata. *) module Violation = Violation module ViolationZ3 = ViolationZ3 diff --git a/src/incremental/makefileUtil.ml b/src/incremental/makefileUtil.ml index 6893b8aecf..843981ee38 100644 --- a/src/incremental/makefileUtil.ml +++ b/src/incremental/makefileUtil.ml @@ -1,3 +1,5 @@ +(** Input program from a real-world project using a Makefile. *) + open Unix let buff_size = 1024 diff --git a/src/util/compilationDatabase.ml b/src/util/compilationDatabase.ml index 2c84e4c168..2443b8d3ab 100644 --- a/src/util/compilationDatabase.ml +++ b/src/util/compilationDatabase.ml @@ -1,3 +1,5 @@ +(** Input program from a real-world project using a compilation database. *) + open Batteries let basename = "compile_commands.json" diff --git a/src/util/messages.ml b/src/util/messages.ml index 3996d6167a..2b1b42a4cf 100644 --- a/src/util/messages.ml +++ b/src/util/messages.ml @@ -1,3 +1,5 @@ +(** Messages (e.g. warnings) from the analysis. *) + module Pretty = GoblintCil.Pretty open GobConfig diff --git a/src/util/preprocessor.ml b/src/util/preprocessor.ml index 0b54fb88e8..1da3aa25ce 100644 --- a/src/util/preprocessor.ml +++ b/src/util/preprocessor.ml @@ -1,3 +1,5 @@ +(** Detection of suitable C preprocessor. *) + open Batteries let bad_cpp_version_regexp = Str.regexp_case_fold "clang\\|apple\\|darwin" diff --git a/src/util/sarif.ml b/src/util/sarif.ml index 7877dd343f..aac8fcce5d 100644 --- a/src/util/sarif.ml +++ b/src/util/sarif.ml @@ -1,3 +1,5 @@ +(** SARIF output of {!Messages}. *) + (** The Sarif format is a standardised output format for static analysis tools. https://docs.oasis-open.org/sarif/sarif/v2.1.0/sarif-v2.1.0.html *) open Batteries diff --git a/src/util/sarifRules.ml b/src/util/sarifRules.ml index 17f4f5f263..feeeae10bc 100644 --- a/src/util/sarifRules.ml +++ b/src/util/sarifRules.ml @@ -1,3 +1,4 @@ +(** SARIF rule definitions for Goblint. *) type categoryInformation = { name:string; diff --git a/src/util/sarifType.ml b/src/util/sarifType.ml index 47b7261e7d..793ba24d01 100644 --- a/src/util/sarifType.ml +++ b/src/util/sarifType.ml @@ -1,3 +1,4 @@ +(** SARIF format types. *) module Invocation = struct diff --git a/src/util/tracing.ml b/src/util/tracing.ml index e3bcdc6126..f9dff2c2cf 100644 --- a/src/util/tracing.ml +++ b/src/util/tracing.ml @@ -1,3 +1,5 @@ +(** Nested tracing system for debugging. *) + (* TRACING STUFF. A rewrite of Cil's tracing framework which is too slow for the * large domains we output. The original code generated the document object * even when the subsystem is not activated. *) diff --git a/src/util/wideningTokens.ml b/src/util/wideningTokens.ml index a563d3cc79..fa0f1a33d4 100644 --- a/src/util/wideningTokens.ml +++ b/src/util/wideningTokens.ml @@ -1,4 +1,5 @@ (** Widening tokens are a generic and dynamic mechanism for delaying widening. + All abstract elements carry a set of tokens, which analyses can add into. Lifted abstract elements are only widened if the token set does not increase, i.e. adding a widening token delays a widening. diff --git a/src/witness/argTools.ml b/src/witness/argTools.ml index d323b938b1..5ef3cb1b17 100644 --- a/src/witness/argTools.ml +++ b/src/witness/argTools.ml @@ -1,3 +1,5 @@ +(** Construction of ARGs from constraint system solutions. *) + open MyCFG module M = Messages diff --git a/src/witness/graphml.ml b/src/witness/graphml.ml index f23daf57fd..93b67efc96 100644 --- a/src/witness/graphml.ml +++ b/src/witness/graphml.ml @@ -1,3 +1,5 @@ +(** Streaming GraphML output. *) + module type GraphMlWriter = sig type t diff --git a/src/witness/myARG.ml b/src/witness/myARG.ml index 8a848898a1..1395e2ed2a 100644 --- a/src/witness/myARG.ml +++ b/src/witness/myARG.ml @@ -1,3 +1,5 @@ +(** Abstract reachibility graph. *) + open MyCFG open GoblintCil diff --git a/src/witness/observerAnalysis.ml b/src/witness/observerAnalysis.ml index 62bfd1fcc6..ec2ad670f8 100644 --- a/src/witness/observerAnalysis.ml +++ b/src/witness/observerAnalysis.ml @@ -1,3 +1,5 @@ +(** Path-sensitive analysis using an {!ObserverAutomaton}. *) + open GoblintCil open Analyses open MyCFG diff --git a/src/witness/observerAutomaton.ml b/src/witness/observerAutomaton.ml index 9b16cd511a..a5205b2b98 100644 --- a/src/witness/observerAutomaton.ml +++ b/src/witness/observerAutomaton.ml @@ -1,3 +1,5 @@ +(** Finite automaton for matching an infeasible ARG path. *) + module type S = sig type q diff --git a/src/witness/svcomp.ml b/src/witness/svcomp.ml index d5fdac4859..a5a572d1c2 100644 --- a/src/witness/svcomp.ml +++ b/src/witness/svcomp.ml @@ -1,3 +1,5 @@ +(** SV-COMP tasks and results. *) + open GoblintCil open Batteries diff --git a/src/witness/svcompSpec.ml b/src/witness/svcompSpec.ml index 4f846f282d..464c170251 100644 --- a/src/witness/svcompSpec.ml +++ b/src/witness/svcompSpec.ml @@ -1,3 +1,5 @@ +(** SV-COMP specification strings and files. *) + open Batteries type t = diff --git a/src/witness/violation.ml b/src/witness/violation.ml index 9b85f854ff..d48005a988 100644 --- a/src/witness/violation.ml +++ b/src/witness/violation.ml @@ -1,3 +1,5 @@ +(** Violation checking in an ARG. *) + module type ViolationArg = sig include MyARG.S with module Edge = MyARG.InlineEdge diff --git a/src/witness/witness.ml b/src/witness/witness.ml index 4a44e89265..4e2815b6fc 100644 --- a/src/witness/witness.ml +++ b/src/witness/witness.ml @@ -1,3 +1,5 @@ +(** Output of ARG as GraphML. *) + open MyCFG open Graphml open Svcomp diff --git a/src/witness/witnessConstraints.ml b/src/witness/witnessConstraints.ml index 7849718be9..66136f07b6 100644 --- a/src/witness/witnessConstraints.ml +++ b/src/witness/witnessConstraints.ml @@ -1,4 +1,4 @@ -(** An analysis specification for witnesses. *) +(** Analysis specification transformation for ARG construction. *) open Batteries open Analyses diff --git a/src/witness/witnessUtil.ml b/src/witness/witnessUtil.ml index 91a021c32b..12bc598be5 100644 --- a/src/witness/witnessUtil.ml +++ b/src/witness/witnessUtil.ml @@ -1,3 +1,5 @@ +(** Utilities for witness generation and witness invariants. *) + open MyCFG open GoblintCil diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index ddea3d652b..856ed9410b 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -1,3 +1,5 @@ +(** YAML witness generation and validation. *) + open Analyses open GoblintCil diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index ae30828a55..3390c1e3ab 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -1,3 +1,5 @@ +(** YAML witness format types. *) + module Producer = struct type t = { diff --git a/src/witness/z3/violationZ3.no-z3.ml b/src/witness/z3/violationZ3.no-z3.ml index 0c61eb3b29..0771f6862d 100644 --- a/src/witness/z3/violationZ3.no-z3.ml +++ b/src/witness/z3/violationZ3.no-z3.ml @@ -1 +1,3 @@ +(** ARG path feasibility checking using weakest precondition and {!Z3} ({b not installed!}). *) + module WP = Violation.UnknownFeasibility (* default to always unknown if no Z3 installed *) diff --git a/src/witness/z3/violationZ3.z3.ml b/src/witness/z3/violationZ3.z3.ml index 6b3690cb14..d70dfacc2e 100644 --- a/src/witness/z3/violationZ3.z3.ml +++ b/src/witness/z3/violationZ3.z3.ml @@ -1,3 +1,5 @@ +(** ARG path feasibility checking using weakest precondition and {!Z3}. *) + open Violation module WP (Node: MyARG.Node): Feasibility with module Node = Node = From 87a3f9e53b663c3c11b12aee72a4a4dc818485fd Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 15:58:28 +0300 Subject: [PATCH 228/518] Add transformation synopses --- src/goblint_lib.ml | 4 +++- src/transform/deadCode.ml | 2 ++ src/transform/evalAssert.ml | 2 ++ src/transform/expressionEvaluation.ml | 3 +++ src/transform/transform.ml | 2 ++ 5 files changed, 12 insertions(+), 1 deletion(-) diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 1d820b25e9..bdda636727 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -356,7 +356,9 @@ module SarifType = SarifType module SarifRules = SarifRules -(** {1 Transformations} *) +(** {1 Transformations} + + Transformations can be activated to transform the program using analysis results. *) module Transform = Transform module DeadCode = DeadCode diff --git a/src/transform/deadCode.ml b/src/transform/deadCode.ml index 1491142fc3..e30b398923 100644 --- a/src/transform/deadCode.ml +++ b/src/transform/deadCode.ml @@ -1,3 +1,5 @@ +(** Dead code elimination transformation ([remove_dead_code]). *) + open Batteries open GoblintCil open GobConfig diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index 4ebb4190bf..fbfbce68d9 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -1,3 +1,5 @@ +(** Transformation for instrumenting the program with computed invariants as assertions ([assert]). *) + open GoblintCil open Formatcil diff --git a/src/transform/expressionEvaluation.ml b/src/transform/expressionEvaluation.ml index 397206a873..815e5742f6 100644 --- a/src/transform/expressionEvaluation.ml +++ b/src/transform/expressionEvaluation.ml @@ -1,3 +1,6 @@ +(** Transformation for evaluating expressions on the analysis results ([expeval]). + {e Hack for Gobview}. *) + open Batteries open GoblintCil open Syntacticsearch diff --git a/src/transform/transform.ml b/src/transform/transform.ml index e6089e533b..93085ff865 100644 --- a/src/transform/transform.ml +++ b/src/transform/transform.ml @@ -1,3 +1,5 @@ +(** Signatures and registry for transformations. *) + open GoblintCil module M = Messages From b51e5164425addf9842ce12b58407d574d816605 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 16:25:40 +0300 Subject: [PATCH 229/518] Add utilities synopses --- src/analyses/baseInvariant.ml | 2 ++ src/analyses/baseUtil.mli | 2 ++ src/analyses/commonPriv.ml | 2 ++ src/analyses/libraryDesc.ml | 1 + src/analyses/libraryFunctions.mli | 3 ++- src/cdomains/apron/sharedFunctions.apron.ml | 2 +- src/cdomains/floatOps/floatOps.mli | 2 ++ src/cdomains/vectorMatrix.ml | 2 ++ src/domains/accessKind.ml | 2 ++ src/goblint_lib.ml | 11 ++++++++++- src/util/apron/apronPrecCompareUtil.apron.ml | 2 ++ src/util/apron/relationPrecCompareUtil.apron.ml | 2 ++ src/util/cilCfg.ml | 6 ++++-- src/util/cilType.ml | 2 ++ src/util/cilfacade.ml | 2 +- src/util/contextUtil.ml | 2 ++ src/util/goblintDir.ml | 2 ++ src/util/intOps.ml | 4 +--- src/util/lazyEval.ml | 3 +++ src/util/loopUnrolling.ml | 2 ++ src/util/messageUtil.ml | 2 ++ src/util/precCompare.ml | 2 ++ src/util/precCompareUtil.ml | 2 ++ src/util/precisionUtil.ml | 2 ++ src/util/privPrecCompareUtil.ml | 2 ++ src/util/processPool.ml | 2 ++ src/util/resettableLazy.mli | 2 ++ src/util/richVarinfo.mli | 2 ++ src/util/timeout.ml | 2 ++ src/util/timing.ml | 2 ++ src/util/wideningThresholds.mli | 2 ++ src/util/xmlUtil.ml | 2 ++ src/witness/timeUtil.ml | 2 ++ 33 files changed, 73 insertions(+), 9 deletions(-) diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index af06d64435..fe7a1069ff 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -1,3 +1,5 @@ +(** {!Analyses.Spec.branch} refinement for {!Base} analysis. *) + open GoblintCil module M = Messages diff --git a/src/analyses/baseUtil.mli b/src/analyses/baseUtil.mli index d01d57b146..7054cd57fc 100644 --- a/src/analyses/baseUtil.mli +++ b/src/analyses/baseUtil.mli @@ -1,3 +1,5 @@ +(** Basic analysis utilities. *) + open GoblintCil val is_global: Queries.ask -> varinfo -> bool diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 2e437321b4..14e3d86dc6 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -1,3 +1,5 @@ +(** Thread-modular value analysis utilities. *) + open Batteries open GoblintCil open Analyses diff --git a/src/analyses/libraryDesc.ml b/src/analyses/libraryDesc.ml index a477fc1809..e3d52a9cc3 100644 --- a/src/analyses/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -1,4 +1,5 @@ (** Library function descriptor (specification). *) + module Cil = GoblintCil (** Pointer argument access specification. *) diff --git a/src/analyses/libraryFunctions.mli b/src/analyses/libraryFunctions.mli index cd024b6c94..9a8e55a48a 100644 --- a/src/analyses/libraryFunctions.mli +++ b/src/analyses/libraryFunctions.mli @@ -1,4 +1,5 @@ -(** This allows us to query information about library functions. *) +(** Hard-coded database of library function specifications. *) + open GoblintCil val add_lib_funs : string list -> unit diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 9545c51a12..059a7f8264 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -1,4 +1,4 @@ -(** Functions and modules that are shared among the original apronDomain and the new affineEqualityDomain. *) +(** Relational value domain utilities. *) open GoblintCil open Batteries diff --git a/src/cdomains/floatOps/floatOps.mli b/src/cdomains/floatOps/floatOps.mli index 1bfd04fca3..05bf363872 100644 --- a/src/cdomains/floatOps/floatOps.mli +++ b/src/cdomains/floatOps/floatOps.mli @@ -1,3 +1,5 @@ +(** Unified interface for floating-point types. *) + type round_mode = | Nearest | ToZero diff --git a/src/cdomains/vectorMatrix.ml b/src/cdomains/vectorMatrix.ml index a1e554d131..d652145032 100644 --- a/src/cdomains/vectorMatrix.ml +++ b/src/cdomains/vectorMatrix.ml @@ -1,3 +1,5 @@ +(** OCaml implementations of vectors and matrices. *) + open Batteries module Array = Batteries.Array module M = Messages diff --git a/src/domains/accessKind.ml b/src/domains/accessKind.ml index dbaeec0f2f..576581af02 100644 --- a/src/domains/accessKind.ml +++ b/src/domains/accessKind.ml @@ -1,3 +1,5 @@ +(** Kinds of memory accesses. *) + type t = | Write (** argument may be read or written to *) | Read (** argument may be read *) diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index bdda636727..6f8d4d36c3 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -397,7 +397,9 @@ module RichVarinfo = RichVarinfo module CilCfg = CilCfg module LoopUnrolling = LoopUnrolling -(** {2 Library specification} *) +(** {2 Library specification} + + For more precise analysis of C standard library, etc functions, whose definitions are not available, custom specifications can be added. *) module AccessKind = AccessKind module LibraryDesc = LibraryDesc @@ -426,9 +428,16 @@ module ApronPrecCompareUtil = ApronPrecCompareUtil (** {2 Build info} *) +(** OCaml compiler info. *) module ConfigOcaml = ConfigOcaml + +(** Dune profile info. *) module ConfigProfile = ConfigProfile + +(** Goblint version info. *) module Version = Version + +(** Goblint git version info. *) module ConfigVersion = ConfigVersion diff --git a/src/util/apron/apronPrecCompareUtil.apron.ml b/src/util/apron/apronPrecCompareUtil.apron.ml index 046b9126ff..b276e0953b 100644 --- a/src/util/apron/apronPrecCompareUtil.apron.ml +++ b/src/util/apron/apronPrecCompareUtil.apron.ml @@ -1,3 +1,5 @@ +(** {!ApronDomain} precision comparison. *) + open PrecCompareUtil open ApronDomain diff --git a/src/util/apron/relationPrecCompareUtil.apron.ml b/src/util/apron/relationPrecCompareUtil.apron.ml index 7e4c60f4d3..15b59c2e22 100644 --- a/src/util/apron/relationPrecCompareUtil.apron.ml +++ b/src/util/apron/relationPrecCompareUtil.apron.ml @@ -1,3 +1,5 @@ +(** {!RelationPriv} precison comparison. *) + open PrecCompareUtil module MyNode = diff --git a/src/util/cilCfg.ml b/src/util/cilCfg.ml index 84b4797c53..2c8ec646c3 100644 --- a/src/util/cilCfg.ml +++ b/src/util/cilCfg.ml @@ -1,3 +1,5 @@ +(** Creation of CIL CFGs. *) + open GobConfig open GoblintCil @@ -30,9 +32,9 @@ class countLoopsVisitor(count) = object | Loop _ -> count := !count + 1; DoChildren | _ -> DoChildren -end +end -let loopCount file = +let loopCount file = let count = ref 0 in let visitor = new countLoopsVisitor(count) in ignore (visitCilFileSameGlobals visitor file); diff --git a/src/util/cilType.ml b/src/util/cilType.ml index 547188c72c..87b78e60e9 100644 --- a/src/util/cilType.ml +++ b/src/util/cilType.ml @@ -1,3 +1,5 @@ +(** Printables for CIL types. *) + open GoblintCil open Pretty diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml index 50906ae503..b77295d4c7 100644 --- a/src/util/cilfacade.ml +++ b/src/util/cilfacade.ml @@ -1,4 +1,4 @@ -(** Helpful functions for dealing with [Cil]. *) +(** {!GoblintCil} utilities. *) open GobConfig open GoblintCil diff --git a/src/util/contextUtil.ml b/src/util/contextUtil.ml index e079835da6..fc70e50dda 100644 --- a/src/util/contextUtil.ml +++ b/src/util/contextUtil.ml @@ -1,3 +1,5 @@ +(** Goblint-specific C attribute handling. *) + open GoblintCil (** Definition of Goblint specific user defined C attributes and their alternatives via options **) diff --git a/src/util/goblintDir.ml b/src/util/goblintDir.ml index 0b8bf04e7a..ceab087fac 100644 --- a/src/util/goblintDir.ml +++ b/src/util/goblintDir.ml @@ -1,3 +1,5 @@ +(** Intermediate data directory. *) + open GobConfig let root () = Fpath.v (get_string "goblint-dir") diff --git a/src/util/intOps.ml b/src/util/intOps.ml index 153bb0a251..7c8e5d31e1 100644 --- a/src/util/intOps.ml +++ b/src/util/intOps.ml @@ -1,6 +1,4 @@ -(* -------------------------------------------------------------- - * IntOps Basics - * -------------------------------------------------------------- *) +(** Unified interface for integer types. *) open Batteries diff --git a/src/util/lazyEval.ml b/src/util/lazyEval.ml index e6c85cf9b2..e49a5f4693 100644 --- a/src/util/lazyEval.ml +++ b/src/util/lazyEval.ml @@ -1,3 +1,6 @@ +(** Lazy evaluation with a fixed function. + Allows marshaling. *) + (* Lazy eval extracted here to avoid dependency cycle: Node -> CilType -> Printable -> Goblintutil -> GobConfig -> Tracing -> Node *) diff --git a/src/util/loopUnrolling.ml b/src/util/loopUnrolling.ml index b62dec9440..62d0f662f3 100644 --- a/src/util/loopUnrolling.ml +++ b/src/util/loopUnrolling.ml @@ -1,3 +1,5 @@ +(** Syntactic loop unrolling. *) + open GobConfig open GoblintCil diff --git a/src/util/messageUtil.ml b/src/util/messageUtil.ml index e1edc2d5be..17651fb05f 100644 --- a/src/util/messageUtil.ml +++ b/src/util/messageUtil.ml @@ -1,3 +1,5 @@ +(** Terminal color utilities. *) + open GobConfig let ansi_color_table = diff --git a/src/util/precCompare.ml b/src/util/precCompare.ml index 15543d80ab..45b3e32ed8 100644 --- a/src/util/precCompare.ml +++ b/src/util/precCompare.ml @@ -1,3 +1,5 @@ +(** Precison comparison. *) + open Batteries module Pretty = GoblintCil.Pretty open Pretty diff --git a/src/util/precCompareUtil.ml b/src/util/precCompareUtil.ml index d8ea4842e9..e00447fd60 100644 --- a/src/util/precCompareUtil.ml +++ b/src/util/precCompareUtil.ml @@ -1,3 +1,5 @@ +(** Signatures for precision comparison. *) + open Batteries (** A printable, where each element is related to one location. diff --git a/src/util/precisionUtil.ml b/src/util/precisionUtil.ml index 06bf08aa3c..047043b4aa 100644 --- a/src/util/precisionUtil.ml +++ b/src/util/precisionUtil.ml @@ -1,3 +1,5 @@ +(** Integer and floating-point option and attribute handling. *) + (* We define precision by the number of IntDomains activated. * We currently have 5 types: DefExc, Interval, Enums, Congruence, IntervalSet *) type int_precision = (bool * bool * bool * bool * bool) diff --git a/src/util/privPrecCompareUtil.ml b/src/util/privPrecCompareUtil.ml index 367f01e8a7..8f0a24db3b 100644 --- a/src/util/privPrecCompareUtil.ml +++ b/src/util/privPrecCompareUtil.ml @@ -1,3 +1,5 @@ +(** {!BasePriv} precison comparison. *) + open GoblintCil open PrecCompareUtil diff --git a/src/util/processPool.ml b/src/util/processPool.ml index e93aa10548..89228fd6ac 100644 --- a/src/util/processPool.ml +++ b/src/util/processPool.ml @@ -1,3 +1,5 @@ +(** Process pool for running processes in parallel. *) + type task = { command: string; cwd: Fpath.t option; diff --git a/src/util/resettableLazy.mli b/src/util/resettableLazy.mli index f4103a86dd..5b0db478bb 100644 --- a/src/util/resettableLazy.mli +++ b/src/util/resettableLazy.mli @@ -1,3 +1,5 @@ +(** Lazy type which can be reset to a closure. *) + type 'a t val from_fun: (unit -> 'a) -> 'a t diff --git a/src/util/richVarinfo.mli b/src/util/richVarinfo.mli index fffccf8c5d..4e682734ee 100644 --- a/src/util/richVarinfo.mli +++ b/src/util/richVarinfo.mli @@ -1,3 +1,5 @@ +(** Custom {!GoblintCil.varinfo} management. *) + open GoblintCil val single: name:string -> (unit -> varinfo) diff --git a/src/util/timeout.ml b/src/util/timeout.ml index 908fbb9b8e..cd3121018e 100644 --- a/src/util/timeout.ml +++ b/src/util/timeout.ml @@ -1,3 +1,5 @@ +(** Timeout utilities. *) + module Unix = struct let timeout f arg tsecs timeout_fn = let oldsig = Sys.signal Sys.sigprof (Sys.Signal_handle (fun _ -> timeout_fn ())) in diff --git a/src/util/timing.ml b/src/util/timing.ml index d276a6f2f0..d5db4664aa 100644 --- a/src/util/timing.ml +++ b/src/util/timing.ml @@ -1,3 +1,5 @@ +(** Time measurement of computations. *) + module Default = Goblint_timing.Make (struct let name = "Default" end) module Program = Goblint_timing.Make (struct let name = "Program" end) diff --git a/src/util/wideningThresholds.mli b/src/util/wideningThresholds.mli index df58fed65b..69e48695dd 100644 --- a/src/util/wideningThresholds.mli +++ b/src/util/wideningThresholds.mli @@ -1,3 +1,5 @@ +(** Widening threshold utilities. *) + val thresholds : unit -> Z.t list val thresholds_incl_mul2 : unit -> Z.t list val exps: GoblintCil.exp list ResettableLazy.t diff --git a/src/util/xmlUtil.ml b/src/util/xmlUtil.ml index a0cc4bc982..e33be1b215 100644 --- a/src/util/xmlUtil.ml +++ b/src/util/xmlUtil.ml @@ -1,3 +1,5 @@ +(** XML utilities. *) + (* XML escape extracted here to avoid dependency cycle: CilType -> Goblintutil -> GobConfig -> Tracing -> Node -> CilType *) diff --git a/src/witness/timeUtil.ml b/src/witness/timeUtil.ml index d3d779dc92..f14dfe29f0 100644 --- a/src/witness/timeUtil.ml +++ b/src/witness/timeUtil.ml @@ -1,3 +1,5 @@ +(** Date and time utilities. *) + open Unix let iso8601_of_tm {tm_year; tm_mon; tm_mday; tm_hour; tm_min; tm_sec; _} = From 9c868370c552268b574fb60a7a242552e8fbfb67 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 16:28:44 +0300 Subject: [PATCH 230/518] Add library extensions synopses --- src/domains/myCheck.ml | 2 ++ src/goblint_lib.ml | 12 +++++++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/domains/myCheck.ml b/src/domains/myCheck.ml index cc5782997e..98583cd2c3 100644 --- a/src/domains/myCheck.ml +++ b/src/domains/myCheck.ml @@ -1,3 +1,5 @@ +(** {!QCheck} extensions. *) + open QCheck let shrink arb = BatOption.default Shrink.nil arb.shrink diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 6f8d4d36c3..a93f2fbfc9 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -441,9 +441,13 @@ module Version = Version module ConfigVersion = ConfigVersion -(** {1 Library extensions} *) +(** {1 Library extensions} -(** {2 Standard library} *) + OCaml library extensions which are completely independent of Goblint. *) + +(** {2 Standard library} + + OCaml standard library extensions which are not provided by {!Batteries}. *) module GobFormat = GobFormat module GobHashtbl = GobHashtbl @@ -453,7 +457,9 @@ module GobOption = GobOption module GobSys = GobSys module GobUnix = GobUnix -(** {2 Other libraries} *) +(** {2 Other libraries} + + External library extensions. *) module GobFpath = GobFpath module GobPretty = GobPretty From 0c18a501ffda638154a3c09ff96d69e96c3b18e8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 16:35:57 +0300 Subject: [PATCH 231/518] Add framework functionality synopses --- src/framework/control.ml | 2 ++ src/maingoblint.ml | 2 +- src/util/server.ml | 2 ++ 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/framework/control.ml b/src/framework/control.ml index 823f3eb375..a7e4eee1ef 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -1,3 +1,5 @@ +(** Main internal functionality: analysis of the program by constraint solving. *) + (** An analyzer that takes the CFG from [MyCFG], a solver from [Selector], constraints from [Constraints] (using the specification from [MCP]) *) open Batteries diff --git a/src/maingoblint.ml b/src/maingoblint.ml index 51f4a9400f..65ce859329 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -1,4 +1,4 @@ -(** This is the main program! *) +(** Main external executable functionality: command-line, front-end and analysis execution. *) open Batteries open GobConfig diff --git a/src/util/server.ml b/src/util/server.ml index ba58fbd032..5632af1472 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -1,3 +1,5 @@ +(** Interactive server mode using JSON-RPC. *) + open Batteries open Jsonrpc open GoblintCil From 07dbdcb31edc3288c7d635e04e0d54292af6b8b7 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 23 May 2023 16:54:49 +0200 Subject: [PATCH 232/518] Fix example where intermediate bot caused an exception. --- src/analyses/base.ml | 1 + .../58-base-mm-tid/30-create-lock.c | 4 +- .../58-base-mm-tid/31-create-lock-assert.c | 38 +++++++++++++++++++ 3 files changed, 40 insertions(+), 3 deletions(-) create mode 100644 tests/regression/58-base-mm-tid/31-create-lock-assert.c diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 06885f7b35..73ff072567 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1129,6 +1129,7 @@ struct | `Bot -> Queries.ID.top () (* out-of-scope variables cause bot, but query result should then be unknown *) | `Top -> Queries.ID.top () (* some float computations cause top (57-float/01-base), but query result should then be unknown *) | v -> M.debug ~category:Analyzer "Base EvalInt %a query answering bot instead of %a" d_exp e VD.pretty v; Queries.ID.bot () + | exception (IntDomain.ArithmeticOnIntegerBot _) when not !Goblintutil.should_warn -> Queries.ID.top () (* for some privatizations, values can intermediately be bot because side-effects have not happened yet *) in if M.tracing then M.traceu "evalint" "base query_evalint %a -> %a\n" d_exp e Queries.ID.pretty r; r diff --git a/tests/regression/58-base-mm-tid/30-create-lock.c b/tests/regression/58-base-mm-tid/30-create-lock.c index 56462681da..635298fc71 100644 --- a/tests/regression/58-base-mm-tid/30-create-lock.c +++ b/tests/regression/58-base-mm-tid/30-create-lock.c @@ -13,9 +13,7 @@ void *t_benign(void *arg) { void *t_benign2(void *arg) { pthread_mutex_lock(&A); - int x = g == 40; - // Adding this back leads to ArithmeticOnBottom errors ?!?! - // __goblint_check(g == 40); //UNKNOWN! + int x = g == 40; // For evaluations that happen before the side-effect of the unlock of A, g is bot and the exception is caught by eval_rv __goblint_check(x); //UNKNOWN! return NULL; } diff --git a/tests/regression/58-base-mm-tid/31-create-lock-assert.c b/tests/regression/58-base-mm-tid/31-create-lock-assert.c new file mode 100644 index 0000000000..02f4a15c6f --- /dev/null +++ b/tests/regression/58-base-mm-tid/31-create-lock-assert.c @@ -0,0 +1,38 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + + +void *t_benign(void *arg) { + return NULL; +} + +void *t_benign2(void *arg) { + pthread_mutex_lock(&A); + // For evaluations that happen before the side-effect of the unlock of A, g is bot. + // This caused an excpetion in query_evalint which we now catch when we are not in verify mode. + __goblint_check(g == 40); //UNKNOWN! + __goblint_check(g == 30); //UNKNOWN! + __goblint_check(g == 10); //FAIL + pthread_mutex_unlock(&A); + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + pthread_mutex_lock(&A); + g = 30; + pthread_create(&id2, NULL, t_benign2, NULL); + g = 40; + pthread_mutex_unlock(&A); + + return 0; +} From a4d10253ea364af4a8d2f050110a0f1066c639f6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 19:27:52 +0300 Subject: [PATCH 233/518] Use setup-ocaml@v2 for indentation workflow --- .github/workflows/indentation.yml | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/.github/workflows/indentation.yml b/.github/workflows/indentation.yml index c6ddca971f..bc21c4fbc9 100644 --- a/.github/workflows/indentation.yml +++ b/.github/workflows/indentation.yml @@ -1,15 +1,17 @@ name: indentation -on: [ push, pull_request] +on: + push: + pull_request: jobs: indentation: - strategy: # remove? + strategy: matrix: os: - ubuntu-latest ocaml-compiler: - - 4.14.0 # setup-ocaml@v1 does not support 4.14.x for ocaml-version + - 4.14.x runs-on: ${{ matrix.os }} @@ -21,23 +23,10 @@ jobs: with: fetch-depth: 0 - # reuse tests.yml or depend on it to not have to setup OCaml? https://docs.github.com/en/actions/reference/workflow-syntax-for-github-actions#example-using-an-action-in-the-same-repository-as-the-workflow - - # rely on cache for now - - name: Cache opam switch # https://github.com/marketplace/actions/cache - uses: actions/cache@v3 - with: - # A list of files, directories, and wildcard patterns to cache and restore - path: | - ~/.opam - _opam - # Key for restoring and saving the cache - key: opam-ocp-indent-${{ runner.os }}-${{ matrix.ocaml-compiler }} - - name: Set up OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v1 # intentionally use v1 instead of v2 because it's faster with manual caching: https://github.com/goblint/analyzer/pull/308#issuecomment-887805857 + uses: ocaml/setup-ocaml@v2 with: - ocaml-version: ${{ matrix.ocaml-compiler }} + ocaml-compiler: ${{ matrix.ocaml-compiler }} - name: Install ocp-indent run: opam install -y ocp-indent From 16b238ad01d6b4bdb392535222cdb0fa55f40266 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 19:35:37 +0300 Subject: [PATCH 234/518] Skip indentation workflow on force push Fails anyway. --- .github/workflows/indentation.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/indentation.yml b/.github/workflows/indentation.yml index bc21c4fbc9..aa693233fa 100644 --- a/.github/workflows/indentation.yml +++ b/.github/workflows/indentation.yml @@ -15,7 +15,7 @@ jobs: runs-on: ${{ matrix.os }} - if: ${{ github.event.before != '0000000000000000000000000000000000000000' }} + if: ${{ !github.event.forced && github.event.before != '0000000000000000000000000000000000000000' }} steps: - name: Checkout code From 283c3eff29e53b797a242fc38ea60826b03fc0ea Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 23 May 2023 19:37:19 +0300 Subject: [PATCH 235/518] Allow workflow_dispatch in indentation workflow --- .github/workflows/indentation.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/indentation.yml b/.github/workflows/indentation.yml index aa693233fa..14db288d60 100644 --- a/.github/workflows/indentation.yml +++ b/.github/workflows/indentation.yml @@ -3,6 +3,7 @@ name: indentation on: push: pull_request: + workflow_dispatch: jobs: indentation: From 01fb38a5022bd20157e2fa085b900b2d95fb9a1a Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 24 May 2023 08:33:17 +0200 Subject: [PATCH 236/518] Warning for unlocking definitely not-held mutex --- src/analyses/mayLocks.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index fd7b844b4d..32dca2f804 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -19,7 +19,11 @@ struct else D.add l ctx.local - let remove ctx l = D.remove l ctx.local + let remove ctx l = + if D.mem l ctx.local then + D.remove l ctx.local + else + (M.warn "Releasing a mutex that is definitely not held"; ctx.local) end module Spec = From 282b6715192e6885d1778cc37d1010a81422593e Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 24 May 2023 08:49:12 +0200 Subject: [PATCH 237/518] Add comments about other types of mutexes --- src/cdomains/mutexAttrDomain.ml | 2 + .../71-doublelocking/08-other-type.c | 63 +++++++++++++++++++ 2 files changed, 65 insertions(+) create mode 100644 tests/regression/71-doublelocking/08-other-type.c diff --git a/src/cdomains/mutexAttrDomain.ml b/src/cdomains/mutexAttrDomain.ml index 4705a9e8ca..8d8378cfcb 100644 --- a/src/cdomains/mutexAttrDomain.ml +++ b/src/cdomains/mutexAttrDomain.ml @@ -2,6 +2,8 @@ module MutexKind = struct include Printable.StdLeaf + (* NonRec represents any of PTHREAD_MUTEX_ERRORCHECK / PTHREAD_MUTEX_NORMAL / PTHREAD_MUTEX_DEFAULT *) + (* Once Goblint supports the notion of failing lock operations, this should be replaced with more precise definitions *) type t = NonRec | Recursive [@@deriving eq, ord, hash, to_yojson] let name () = "mutexKind" let show x = match x with diff --git a/tests/regression/71-doublelocking/08-other-type.c b/tests/regression/71-doublelocking/08-other-type.c new file mode 100644 index 0000000000..16d4db522d --- /dev/null +++ b/tests/regression/71-doublelocking/08-other-type.c @@ -0,0 +1,63 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +#define _GNU_SOURCE +#include +#include +#include +#include + + +int g; + +pthread_mutex_t mut = PTHREAD_MUTEX_INITIALIZER; + +#ifndef __APPLE__ +pthread_mutex_t mut2 = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP; +#endif + +pthread_mutex_t mut3 = PTHREAD_ERRORCHECK_MUTEX_INITIALIZER_NP; + + +void* f1(void* ptr) { + int top; + + g = 1; + if(top) { + pthread_mutex_lock(&mut); + } + pthread_mutex_lock(&mut); //WARN + pthread_mutex_unlock(&mut); + return NULL; +} + +void* f2(void* ptr) { + int top; + + g = 1; + if(top) { + pthread_mutex_lock(&mut3); + } + pthread_mutex_lock(&mut3); //WARN + pthread_mutex_unlock(&mut3); + return NULL; +} + + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_t t2; + + pthread_create(&t1,NULL,f1,NULL); + pthread_create(&t2,NULL,f2,NULL); + pthread_join(t1, NULL); + +#ifndef __APPLE__ + pthread_mutex_lock(&mut2); //NOWARN + pthread_mutex_lock(&mut2); //NOWARN + pthread_mutex_unlock(&mut2); + pthread_mutex_unlock(&mut2); +#endif + + return 0; +} From 97713d31b24f9ab1ec78e911e00632a3349a4aca Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 24 May 2023 08:54:14 +0200 Subject: [PATCH 238/518] Add further dynamic mutex --- .../71-doublelocking/09-other-dyn.c | 43 +++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 tests/regression/71-doublelocking/09-other-dyn.c diff --git a/tests/regression/71-doublelocking/09-other-dyn.c b/tests/regression/71-doublelocking/09-other-dyn.c new file mode 100644 index 0000000000..995337e646 --- /dev/null +++ b/tests/regression/71-doublelocking/09-other-dyn.c @@ -0,0 +1,43 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; + +void* f1(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + + pthread_mutex_lock(mut); //WARN + pthread_mutex_lock(mut); //WARN + pthread_mutex_unlock(mut); + pthread_mutex_unlock(mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_mutex_t mut; + + pthread_mutexattr_t attr; + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_NORMAL); + pthread_mutex_init(&mut, &attr); + + + pthread_create(&t1,NULL,f1,&mut); + + + pthread_mutex_lock(&mut); //WARN + pthread_mutex_lock(&mut); //WARN + pthread_mutex_unlock(&mut); + pthread_mutex_unlock(&mut); + + pthread_join(t1, NULL); + + + return 0; +} From 3a813deab98429626f7ce21e82ff44c1b8e7bc73 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 24 May 2023 09:31:03 +0200 Subject: [PATCH 239/518] Change queries, fix unlock for recursive mutexes --- src/analyses/mayLocks.ml | 25 +++++++++++++------ src/analyses/mutexTypeAnalysis.ml | 2 +- src/domains/queries.ml | 14 +++++------ .../71-doublelocking/08-other-type.c | 2 +- 4 files changed, 26 insertions(+), 17 deletions(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 32dca2f804..5f9055c4ec 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -11,19 +11,28 @@ struct let add ctx (l,r) = if D.mem l ctx.local then + let default () = (M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a (possibly non-recursive) mutex that may be already held"; ctx.local) in match D.Addr.to_var_must l with - | Some v when ctx.ask (Queries.IsRecursiveMutex v)-> - ctx.local - | _ -> - (M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a (possibly non-recursive) mutex that may be already held"; ctx.local) + | Some v -> + (let mtype = ctx.ask (Queries.MutexType v) in + match mtype with + | `Lifted MutexAttrDomain.MutexKind.Recursive -> ctx.local + | `Lifted MutexAttrDomain.MutexKind.NonRec -> (M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a non-recursive mutex that may be already held"; ctx.local) + | _ -> default ()) + | _ -> default () + else D.add l ctx.local let remove ctx l = - if D.mem l ctx.local then - D.remove l ctx.local - else - (M.warn "Releasing a mutex that is definitely not held"; ctx.local) + if not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; + match D.Addr.to_var_must l with + | Some v -> + (let mtype = ctx.ask (Queries.MutexType v) in + match mtype with + | `Lifted MutexAttrDomain.MutexKind.NonRec -> D.remove l ctx.local + | _ -> ctx.local (* we cannot remove them here *)) + | None -> ctx.local (* we cannot remove them here *) end module Spec = diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 9577f06a3b..9581819d40 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -64,7 +64,7 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = match q with - | Queries.IsRecursiveMutex v -> ctx.global v = `Lifted (MAttr.MutexKind.Recursive) + | Queries.MutexType v -> (ctx.global v:MutexAttrDomain.t) | _ -> Queries.Result.top q end diff --git a/src/domains/queries.ml b/src/domains/queries.ml index b48d8b1c07..448c642aa4 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -83,7 +83,7 @@ type _ t = | HeapVar: VI.t t | IsHeapVar: varinfo -> MayBool.t t (* TODO: is may or must? *) | IsMultiple: varinfo -> MustBool.t t (* Is no other copy of this local variable reachable via pointers? *) - | IsRecursiveMutex: varinfo -> MustBool.t t + | MutexType: varinfo -> MutexAttrDomain.t t | EvalThread: exp -> ConcDomain.ThreadSet.t t | EvalMutexAttr: exp -> MutexAttrDomain.t t | EvalJumpBuf: exp -> JmpBufDomain.JmpBufSet.t t @@ -146,7 +146,7 @@ struct | DYojson -> (module FlatYojson) | PartAccess _ -> Obj.magic (module Unit: Lattice.S) (* Never used, MCP handles PartAccess specially. Must still return module (instead of failwith) here, but the module is never used. *) | IsMultiple _ -> (module MustBool) (* see https://github.com/goblint/analyzer/pull/310#discussion_r700056687 on why this needs to be MustBool *) - | IsRecursiveMutex _ -> (module MustBool) + | MutexType _ -> (module MutexAttrDomain) | EvalThread _ -> (module ConcDomain.ThreadSet) | EvalJumpBuf _ -> (module JmpBufDomain.JmpBufSet) | ActiveJumpBuf -> (module JmpBufDomain.ActiveLongjmps) @@ -189,7 +189,7 @@ struct | MayBePublicWithout _ -> MayBool.top () | MayBeThreadReturn -> MayBool.top () | IsHeapVar _ -> MayBool.top () - | IsRecursiveMutex _ -> MustBool.top () + | MutexType _ -> MutexAttrDomain.top () | MustBeProtectedBy _ -> MustBool.top () | MustBeAtomic -> MustBool.top () | MustBeSingleThreaded _ -> MustBool.top () @@ -278,7 +278,7 @@ struct | Any ActiveJumpBuf -> 46 | Any ValidLongJmp -> 47 | Any (MayBeModifiedSinceSetjmp _) -> 48 - | Any (IsRecursiveMutex _) -> 49 + | Any (MutexType _) -> 49 | Any (EvalMutexAttr _ ) -> 50 let rec compare a b = @@ -321,7 +321,7 @@ struct | Any (Invariant i1), Any (Invariant i2) -> compare_invariant_context i1 i2 | Any (InvariantGlobal vi1), Any (InvariantGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) - | Any (IsRecursiveMutex v1), Any (IsRecursiveMutex v2) -> CilType.Varinfo.compare v1 v2 + | Any (MutexType v1), Any (MutexType v2) -> CilType.Varinfo.compare v1 v2 | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 @@ -358,7 +358,7 @@ struct | Any (EvalJumpBuf e) -> CilType.Exp.hash e | Any (WarnGlobal vi) -> Hashtbl.hash vi | Any (Invariant i) -> hash_invariant_context i - | Any (IsRecursiveMutex v) -> CilType.Varinfo.hash v + | Any (MutexType v) -> CilType.Varinfo.hash v | Any (InvariantGlobal vi) -> Hashtbl.hash vi | Any (MustProtectedVars m) -> hash_mustprotectedvars m | Any (MayBeModifiedSinceSetjmp e) -> JmpBufDomain.BufferEntry.hash e @@ -412,7 +412,7 @@ struct | Any (WarnGlobal vi) -> Pretty.dprintf "WarnGlobal _" | Any (IterSysVars _) -> Pretty.dprintf "IterSysVars _" | Any (InvariantGlobal i) -> Pretty.dprintf "InvariantGlobal _" - | Any (IsRecursiveMutex m) -> Pretty.dprintf "IsRecursiveMutex _" + | Any (MutexType m) -> Pretty.dprintf "MutexType _" | Any (EvalMutexAttr a) -> Pretty.dprintf "EvalMutexAttr _" | Any MayAccessed -> Pretty.dprintf "MayAccessed" | Any MayBeTainted -> Pretty.dprintf "MayBeTainted" diff --git a/tests/regression/71-doublelocking/08-other-type.c b/tests/regression/71-doublelocking/08-other-type.c index 16d4db522d..839284e7ce 100644 --- a/tests/regression/71-doublelocking/08-other-type.c +++ b/tests/regression/71-doublelocking/08-other-type.c @@ -55,7 +55,7 @@ int main(int argc, char const *argv[]) #ifndef __APPLE__ pthread_mutex_lock(&mut2); //NOWARN pthread_mutex_lock(&mut2); //NOWARN - pthread_mutex_unlock(&mut2); + pthread_mutex_unlock(&mut2); //NOWARN pthread_mutex_unlock(&mut2); #endif From b54842253689334c6f1ddb5bf2aa527297c83bc0 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 24 May 2023 09:46:17 +0200 Subject: [PATCH 240/518] Adapt tests to correct maylockset --- src/analyses/mayLocks.ml | 1 - .../03-thread-exit-with-mutex.c | 4 +-- .../10-thread-exit-recursive.c | 33 +++++++++++++++++++ 3 files changed, 35 insertions(+), 3 deletions(-) create mode 100644 tests/regression/71-doublelocking/10-thread-exit-recursive.c diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 5f9055c4ec..44cc4f32e4 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -20,7 +20,6 @@ struct | `Lifted MutexAttrDomain.MutexKind.NonRec -> (M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a non-recursive mutex that may be already held"; ctx.local) | _ -> default ()) | _ -> default () - else D.add l ctx.local diff --git a/tests/regression/71-doublelocking/03-thread-exit-with-mutex.c b/tests/regression/71-doublelocking/03-thread-exit-with-mutex.c index d78e87bc2e..d71f3fb616 100644 --- a/tests/regression/71-doublelocking/03-thread-exit-with-mutex.c +++ b/tests/regression/71-doublelocking/03-thread-exit-with-mutex.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] 'maylocks' +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' #include #include #include @@ -35,5 +35,5 @@ int main(int argc, char const *argv[]) pthread_mutex_lock(&mut[0]); //NOWARN pthread_mutex_unlock(&mut[0]); - return 0; //NOWARN + return 0; // We would actually want to not warn here, but the mutex type analysis is currently too imprecise } diff --git a/tests/regression/71-doublelocking/10-thread-exit-recursive.c b/tests/regression/71-doublelocking/10-thread-exit-recursive.c new file mode 100644 index 0000000000..f360a98e48 --- /dev/null +++ b/tests/regression/71-doublelocking/10-thread-exit-recursive.c @@ -0,0 +1,33 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; + +void* f1(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_unlock(mut); + return NULL; //WARN +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_mutex_t mut; + + pthread_mutexattr_t attr; + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + pthread_mutex_init(&mut, &attr); + + + pthread_create(&t1,NULL,f1,&mut); + + return 0; +} From cc9586921e2fa65d94d85906ebad381c2ba2e3b7 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 24 May 2023 09:46:33 +0200 Subject: [PATCH 241/518] Fix test 09 --- tests/regression/71-doublelocking/09-other-dyn.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/71-doublelocking/09-other-dyn.c b/tests/regression/71-doublelocking/09-other-dyn.c index 995337e646..71cd8aca21 100644 --- a/tests/regression/71-doublelocking/09-other-dyn.c +++ b/tests/regression/71-doublelocking/09-other-dyn.c @@ -10,7 +10,7 @@ int g; void* f1(void* ptr) { pthread_mutex_t* mut = (pthread_mutex_t*) ptr; - pthread_mutex_lock(mut); //WARN + pthread_mutex_lock(mut); pthread_mutex_lock(mut); //WARN pthread_mutex_unlock(mut); pthread_mutex_unlock(mut); @@ -31,7 +31,7 @@ int main(int argc, char const *argv[]) pthread_create(&t1,NULL,f1,&mut); - pthread_mutex_lock(&mut); //WARN + pthread_mutex_lock(&mut); pthread_mutex_lock(&mut); //WARN pthread_mutex_unlock(&mut); pthread_mutex_unlock(&mut); From 3d064ced25d178f1761a7f1b4f5b1de538d9075e Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 24 May 2023 09:53:08 +0200 Subject: [PATCH 242/518] Make example smaller --- .../71-doublelocking/09-other-dyn.c | 20 +++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/tests/regression/71-doublelocking/09-other-dyn.c b/tests/regression/71-doublelocking/09-other-dyn.c index 71cd8aca21..a9d50895b8 100644 --- a/tests/regression/71-doublelocking/09-other-dyn.c +++ b/tests/regression/71-doublelocking/09-other-dyn.c @@ -12,15 +12,27 @@ void* f1(void* ptr) { pthread_mutex_lock(mut); pthread_mutex_lock(mut); //WARN - pthread_mutex_unlock(mut); - pthread_mutex_unlock(mut); + return NULL; } +void* f2(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + + pthread_mutex_lock(mut); + pthread_mutex_unlock(mut); + + // To check that this is now actually removed from the may lockset + return NULL; //WARN +} + + + int main(int argc, char const *argv[]) { pthread_t t1; + pthread_t t2; pthread_mutex_t mut; pthread_mutexattr_t attr; @@ -33,11 +45,11 @@ int main(int argc, char const *argv[]) pthread_mutex_lock(&mut); pthread_mutex_lock(&mut); //WARN - pthread_mutex_unlock(&mut); - pthread_mutex_unlock(&mut); + pthread_join(t1, NULL); + pthread_create(&t2,NULL,f2,&mut); return 0; } From 55362426da51e71229505bd9fb783e6e9bce34c7 Mon Sep 17 00:00:00 2001 From: Stanimir Bozhilov Date: Wed, 24 May 2023 12:04:08 +0300 Subject: [PATCH 243/518] Update docs/developer-guide/firstanalysis.md Co-authored-by: Simmo Saan --- 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 ea42ac8491..836b5fe2d7 100644 --- a/docs/developer-guide/firstanalysis.md +++ b/docs/developer-guide/firstanalysis.md @@ -69,7 +69,7 @@ There is no need to implement the transfer functions for branching for this exam The assignment relies on the function `eval`, which is almost there. It just needs you to fix the evaluation of constants! Unless you jumped straight to this line, it should not be too complicated to fix this. With this in place, we should have sufficient information to tell Goblint that the assertion does hold. -For more information on the signature of the individual transfer functions, please check out their documentation in the file which they're defined in: [src/framework/analyses.ml](https://github.com/goblint/analyzer/blob/master/src/framework/analyses.ml#LL355C1-L355C17). +For more information on the signature of the individual transfer functions, please check out `module type Spec` documentation in [`src/framework/analyses.ml`](https://github.com/goblint/analyzer/blob/master/src/framework/analyses.ml). ## Extending the domain From 3e2fcf9ab68697102976766da1116246af19dfd4 Mon Sep 17 00:00:00 2001 From: Stanimir Bozhilov Date: Wed, 24 May 2023 12:04:33 +0300 Subject: [PATCH 244/518] Update src/framework/analyses.ml Co-authored-by: Simmo Saan --- src/framework/analyses.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 0c2ee2a791..fc0ba7643a 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -389,7 +389,8 @@ sig it handles program points of the form "lval = rval;" *) val assign: (D.t, G.t, C.t, V.t) ctx -> lval -> exp -> D.t - (* A transfer function typically used for handling variable arguments (varargs) *) + (** A transfer function used for declaring local variables. + By default only for variable-length arrays (VLAs). *) val vdecl : (D.t, G.t, C.t, V.t) ctx -> varinfo -> D.t (** A transfer function which handles conditional branching yielding the From 35829cc3c27fed7458c60fed421bc2d5948b225e Mon Sep 17 00:00:00 2001 From: Stanimir Bozhilov Date: Wed, 24 May 2023 12:04:43 +0300 Subject: [PATCH 245/518] Update src/framework/analyses.ml Co-authored-by: Simmo Saan --- src/framework/analyses.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index fc0ba7643a..9851f89eb1 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -405,7 +405,7 @@ sig "return exp" or "return" in the passed function (fundec) *) val return: (D.t, G.t, C.t, V.t) ctx -> exp option -> fundec -> D.t - (* A transfer function meant to handle inline assembler program points *) + (** A transfer function meant to handle inline assembler program points *) val asm : (D.t, G.t, C.t, V.t) ctx -> D.t (* A transfer function which works as the identity function, i.e., it skips and does nothing *) From 2271e7da71c8e64f785b0bba2b9fac5931606927 Mon Sep 17 00:00:00 2001 From: Stanimir Bozhilov Date: Wed, 24 May 2023 12:04:56 +0300 Subject: [PATCH 246/518] Update src/framework/analyses.ml Co-authored-by: Simmo Saan --- src/framework/analyses.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 9851f89eb1..ebea401b1a 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -408,7 +408,8 @@ sig (** A transfer function meant to handle inline assembler program points *) val asm : (D.t, G.t, C.t, V.t) ctx -> D.t - (* A transfer function which works as the identity function, i.e., it skips and does nothing *) + (** A transfer function which works as the identity function, i.e., it skips and does nothing. + Used for empty loops. *) val skip : (D.t, G.t, C.t, V.t) ctx -> D.t (** A transfer function which, for a call to a _special_ function f "lval = f(args)" or "f(args)", From 2867348b88c8af4e0742d8cf634c7e687bf33327 Mon Sep 17 00:00:00 2001 From: Stanimir Bozhilov Date: Wed, 24 May 2023 12:05:07 +0300 Subject: [PATCH 247/518] Update src/framework/analyses.ml Co-authored-by: Simmo Saan --- src/framework/analyses.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index ebea401b1a..ab010864d2 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -412,7 +412,7 @@ sig Used for empty loops. *) val skip : (D.t, G.t, C.t, V.t) ctx -> D.t - (** A transfer function which, for a call to a _special_ function f "lval = f(args)" or "f(args)", + (** A transfer function which, for a call to a {e special} function f "lval = f(args)" or "f(args)", computes the caller state after the function call *) val special : (D.t, G.t, C.t, V.t) ctx -> lval option -> varinfo -> exp list -> D.t From 802a8cd6d9ed4126c015d0c3266ed83bdd7845ba Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 May 2023 12:52:30 +0300 Subject: [PATCH 248/518] Add API reference to Readthedocs --- mkdocs.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/mkdocs.yml b/mkdocs.yml index f1926e5cec..558c381e66 100644 --- a/mkdocs.yml +++ b/mkdocs.yml @@ -30,6 +30,7 @@ nav: - 👶 Your first analysis: developer-guide/firstanalysis.md - 🏫 Extending library: developer-guide/extending-library.md - 📢 Messaging: developer-guide/messaging.md + - 🗃️ API reference: https://goblint.github.io/analyzer/ - 🚨 Testing: developer-guide/testing.md - 🪲 Debugging: developer-guide/debugging.md - 📉 Profiling: developer-guide/profiling.md From 662841e42777d8c073838a075c7c6b021d849517 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 May 2023 15:39:20 +0300 Subject: [PATCH 249/518] Remove UniqueType --- src/analyses/base.ml | 44 ++++++++---------------------------- src/analyses/region.ml | 9 +------- src/cdomains/regionDomain.ml | 21 +++-------------- src/util/uniqueType.ml | 18 --------------- 4 files changed, 13 insertions(+), 79 deletions(-) delete mode 100644 src/util/uniqueType.ml diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 6014f9df3a..84cd0cbb24 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -761,15 +761,6 @@ struct and eval_rv_base (a: Q.ask) (gs:glob_fun) (st: store) (exp:exp): value = let eval_rv = eval_rv_back_up in if M.tracing then M.traceli "evalint" "base eval_rv_base %a\n" d_exp exp; - let rec do_offs def = function (* for types that only have one value *) - | Field (fd, offs) -> begin - match UniqueType.find (TComp (fd.fcomp, [])) with - | Some v -> do_offs (`Address (AD.singleton (Addr.from_var_offset (v,convert_offset a gs st (Field (fd, offs)))))) offs - | None -> do_offs def offs - end - | Index (_, offs) -> do_offs def offs - | NoOffset -> def - in let binop_remove_same_casts ~extra_is_safe ~e1 ~e2 ~t1 ~t2 ~c1 ~c2 = let te1 = Cilfacade.typeOf e1 in let te2 = Cilfacade.typeOf e2 in @@ -804,7 +795,7 @@ struct | Const _ -> VD.top () (* Variables and address expressions *) | Lval lv -> - eval_rv_base_lval ~eval_lv ~do_offs a gs st exp lv + eval_rv_base_lval ~eval_lv a gs st exp lv (* Binary operators *) (* Eq/Ne when both values are equal and casted to the same type *) | BinOp ((Eq | Ne) as op, (CastE (t1, e1) as c1), (CastE (t2, e2) as c2), typ) when typeSig t1 = typeSig t2 -> @@ -932,10 +923,10 @@ struct if M.tracing then M.traceu "evalint" "base eval_rv_base %a -> %a\n" d_exp exp VD.pretty r; r - and eval_rv_base_lval ~eval_lv ~do_offs (a: Q.ask) (gs:glob_fun) (st: store) (exp: exp) (lv: lval): value = + and eval_rv_base_lval ~eval_lv (a: Q.ask) (gs:glob_fun) (st: store) (exp: exp) (lv: lval): value = match lv with - | (Var v, ofs) -> do_offs (get a gs st (eval_lv a gs st (Var v, ofs)) (Some exp)) ofs - (*| Lval (Mem e, ofs) -> do_offs (get a gs st (eval_lv a gs st (Mem e, ofs))) ofs*) + | (Var v, ofs) -> get a gs st (eval_lv a gs st (Var v, ofs)) (Some exp) + (*| Lval (Mem e, ofs) -> get a gs st (eval_lv a gs st (Mem e, ofs)) *) | (Mem e, ofs) -> (*M.tracel "cast" "Deref: lval: %a\n" d_plainlval lv;*) let rec contains_vla (t:typ) = match t with @@ -986,7 +977,6 @@ struct let v' = VD.cast t v in (* cast to the expected type (the abstract type might be something other than t since we don't change addresses upon casts!) *) if M.tracing then M.tracel "cast" "Ptr-Deref: cast %a to %a = %a!\n" VD.pretty v d_type t VD.pretty v'; let v' = VD.eval_offset (Queries.to_value_domain_ask a) (fun x -> get a gs st x (Some exp)) v' (convert_offset a gs st ofs) (Some exp) None t in (* handle offset *) - let v' = do_offs v' ofs in (* handle blessed fields? *) v' in AD.fold (fun a acc -> VD.join acc (lookup_with_offs a)) p (VD.bot ()) @@ -1069,27 +1059,11 @@ struct (* Evaluation of lvalues to our abstract address domain. *) and eval_lv (a: Q.ask) (gs:glob_fun) st (lval:lval): AD.t = let eval_rv = eval_rv_back_up in - let rec do_offs def = function - | Field (fd, offs) -> begin - match UniqueType.find (TComp (fd.fcomp, [])) with - | Some v -> do_offs (AD.singleton (Addr.from_var_offset (v,convert_offset a gs st (Field (fd, offs))))) offs - | None -> do_offs def offs - end - | Index (_, offs) -> do_offs def offs - | NoOffset -> def - in match lval with - | Var x, NoOffset when (not x.vglob) && UniqueType.find x.vtype<> None -> - begin match UniqueType.find x.vtype with - | Some v -> AD.singleton (Addr.from_var v) - | _ -> AD.singleton (Addr.from_var_offset (x, convert_offset a gs st NoOffset)) - end (* The simpler case with an explicit variable, e.g. for [x.field] we just * create the address { (x,field) } *) | Var x, ofs -> - if x.vglob - then AD.singleton (Addr.from_var_offset (x, convert_offset a gs st ofs)) - else do_offs (AD.singleton (Addr.from_var_offset (x, convert_offset a gs st ofs))) ofs + AD.singleton (Addr.from_var_offset (x, convert_offset a gs st ofs)) (* The more complicated case when [exp = & x.field] and we are asked to * evaluate [(\*exp).subfield]. We first evaluate [exp] to { (x,field) } * and then add the subfield to it: { (x,field.subfield) }. *) @@ -1100,10 +1074,11 @@ struct then M.error ~category:M.Category.Behavior.Undefined.nullpointer_dereference ~tags:[CWE 476] "Must dereference NULL pointer" else if AD.may_be_null adr then M.warn ~category:M.Category.Behavior.Undefined.nullpointer_dereference ~tags:[CWE 476] "May dereference NULL pointer"); - do_offs (AD.map (add_offset_varinfo (convert_offset a gs st ofs)) adr) ofs + AD.map (add_offset_varinfo (convert_offset a gs st ofs)) adr | `Bot -> AD.bot () | _ -> - M.debug ~category:Analyzer "Failed evaluating %a to lvalue" d_lval lval; do_offs AD.unknown_ptr ofs + M.debug ~category:Analyzer "Failed evaluating %a to lvalue" d_lval lval; + AD.unknown_ptr end (* run eval_rv from above and keep a result that is bottom *) @@ -2527,8 +2502,7 @@ struct if VD.is_bot oldval then VD.top_value t_lval else oldval let eval_rv_lval_refine a gs st exp lv = (* new, use different ctx for eval_lv (for Mem): *) - let do_offs def o = def in (* HACK: no do_offs blessed here *) - eval_rv_base_lval ~eval_lv ~do_offs a gs st exp lv + eval_rv_base_lval ~eval_lv a gs st exp lv (* don't meet with current octx values when propagating inverse operands down *) let id_meet_down ~old ~c = c diff --git a/src/analyses/region.ml b/src/analyses/region.ml index 9736da9b3c..17389b2184 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -172,14 +172,7 @@ struct | _ -> ctx.local end | _ -> - let t, _, _, _ = splitFunctionTypeVI f in - match unrollType t with - | TPtr (t,_) -> - begin match UniqueType.find t, lval with - | Some rv, Some lv -> assign ctx lv (AddrOf (Var rv, NoOffset)) - | _ -> ctx.local - end - | _ -> ctx.local + ctx.local let startstate v = `Lifted (RegMap.bot ()) diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index 51581c4ea0..672aa90c82 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -141,15 +141,6 @@ struct type eval_t = (bool * elt * F.t) option let eval_exp exp: eval_t = let offsornot offs = if (get_bool "exp.region-offsets") then F.listify offs else [] in - let rec do_offs deref def = function - | Field (fd, offs) -> begin - match UniqueType.find (TComp (fd.fcomp, [])) with - | Some v -> do_offs deref (Some (deref, (v, offsornot (Field (fd, offs))), [])) offs - | None -> do_offs deref def offs - end - | Index (_, offs) -> do_offs deref def offs - | NoOffset -> def - in (* The intuition for the offset computations is that we keep the static _suffix_ of an * access path. These can be used to partition accesses when fields do not overlap. * This means that for pointer dereferences and when obtaining the value from an lval @@ -166,17 +157,11 @@ struct | _ -> None and eval_lval deref lval = match lval with - | (Var x, NoOffset) when UniqueType.find x.vtype <> None -> - begin match UniqueType.find x.vtype with - | Some v -> Some (deref, (v,[]), []) - | _ when x.vglob -> Some (deref, (x, []), []) - | _ -> None - end - | (Var x, offs) -> do_offs deref (Some (deref, (x, offsornot offs), [])) offs + | (Var x, offs) -> Some (deref, (x, offsornot offs), []) | (Mem exp,offs) -> match eval_rval true exp with - | Some (deref, v, _) -> do_offs deref (Some (deref, v, offsornot offs)) offs - | x -> do_offs deref x offs + | Some (deref, v, _) -> Some (deref, v, offsornot offs) + | x -> x in eval_rval false exp diff --git a/src/util/uniqueType.ml b/src/util/uniqueType.ml deleted file mode 100644 index 6df408fcc6..0000000000 --- a/src/util/uniqueType.ml +++ /dev/null @@ -1,18 +0,0 @@ -open GoblintCil - -(* Type invariant variables. *) -let type_inv_tbl = Hashtbl.create 13 -(* TODO: This should probably be marshaled (for incremental mode) or even use RichVarinfo mapping. *) - -let type_inv (c:compinfo) : varinfo = - try Hashtbl.find type_inv_tbl c.ckey - with Not_found -> - let i = Cilfacade.create_var (makeGlobalVar ("{struct "^c.cname^"}") (TComp (c,[]))) in - Hashtbl.add type_inv_tbl c.ckey i; - i - -let find (t:typ): varinfo option = - let me_gusta x = List.mem x (GobConfig.get_string_list "exp.unique") in - match unrollType t with - | TComp (ci,_) when me_gusta ci.cname -> Some (type_inv ci) - | _ -> (None : varinfo option) From e2380083c52a01ec4882d354c57db1d0ef380fac Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 May 2023 17:09:24 +0300 Subject: [PATCH 250/518] Add signs tutorial link to ocamldoc --- src/analyses/tutorials/signs.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/analyses/tutorials/signs.ml b/src/analyses/tutorials/signs.ml index dec69d03f7..31168df86a 100644 --- a/src/analyses/tutorials/signs.ml +++ b/src/analyses/tutorials/signs.ml @@ -1,4 +1,6 @@ -(** Simple intraprocedural integer signs analysis template ([signs]). *) +(** Simple intraprocedural integer signs analysis template ([signs]). + + @see *) open GoblintCil open Analyses From cdd47e03eb3735fbaf0fbbbb1bbe0a1044eee89b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 May 2023 17:24:08 +0300 Subject: [PATCH 251/518] Fix some ocamldoc typos Co-authored-by: Michael Schwarz --- src/analyses/abortUnless.ml | 2 +- src/analyses/expRelation.ml | 2 +- src/witness/myARG.ml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/analyses/abortUnless.ml b/src/analyses/abortUnless.ml index ebff78f578..813d999ac3 100644 --- a/src/analyses/abortUnless.ml +++ b/src/analyses/abortUnless.ml @@ -1,6 +1,6 @@ (** Analysis of [assume_abort_if_not]-style functions ([abortUnless]). - Such function only returns if its only argument has a non-zero value. *) + Such a function only returns if its only argument has a non-zero value. *) open GoblintCil open Analyses diff --git a/src/analyses/expRelation.ml b/src/analyses/expRelation.ml index ad44cfcaab..f63099b966 100644 --- a/src/analyses/expRelation.ml +++ b/src/analyses/expRelation.ml @@ -2,7 +2,7 @@ (** An analysis specification to answer questions about how two expressions relate to each other. *) (** Currently this works purely syntactically on the expressions, and only for =_{must}. *) -(** Does not keep state, this is only formulated as an analysis to integrate well into framework *) +(** Does not keep state, this is only formulated as an analysis to integrate well into the framework. *) open GoblintCil open Analyses diff --git a/src/witness/myARG.ml b/src/witness/myARG.ml index 1395e2ed2a..62c705f5b1 100644 --- a/src/witness/myARG.ml +++ b/src/witness/myARG.ml @@ -1,4 +1,4 @@ -(** Abstract reachibility graph. *) +(** Abstract reachability graph. *) open MyCFG open GoblintCil From c3444aca2f1f05ccf8173bfe9e9dcb042a83e52f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 May 2023 17:25:52 +0300 Subject: [PATCH 252/518] Add some ocamldoc references Co-authored-by: Michael Schwarz --- src/analyses/commonPriv.ml | 2 +- src/witness/argTools.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index c24d1afaaf..fa639295b3 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -1,4 +1,4 @@ -(** Thread-modular value analysis utilities. *) +(** Thread-modular value analysis utilities for {!BasePriv} and {!RelationPriv}. *) open Batteries open GoblintCil diff --git a/src/witness/argTools.ml b/src/witness/argTools.ml index 5ef3cb1b17..41a0820aab 100644 --- a/src/witness/argTools.ml +++ b/src/witness/argTools.ml @@ -1,4 +1,4 @@ -(** Construction of ARGs from constraint system solutions. *) +(** Construction of {{!MyArg} ARGs} from constraint system solutions. *) open MyCFG From 65f12bb6d64a1e6af34317be3c8fce958fe1aff0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 May 2023 17:35:46 +0300 Subject: [PATCH 253/518] Fix some ocamldoc syntax --- src/analyses/expRelation.ml | 2 +- src/analyses/libraryDsl.mli | 6 ++--- src/cdomains/floatDomain.mli | 45 ++++++++++++++++++++++++++++-------- src/witness/argTools.ml | 2 +- 4 files changed, 41 insertions(+), 14 deletions(-) diff --git a/src/analyses/expRelation.ml b/src/analyses/expRelation.ml index f63099b966..39df650bc0 100644 --- a/src/analyses/expRelation.ml +++ b/src/analyses/expRelation.ml @@ -1,7 +1,7 @@ (** Stateless symbolic comparison expression analysis ([expRelation]). *) (** An analysis specification to answer questions about how two expressions relate to each other. *) -(** Currently this works purely syntactically on the expressions, and only for =_{must}. *) +(** Currently this works purely syntactically on the expressions, and only for {m =_{must}}. *) (** Does not keep state, this is only formulated as an analysis to integrate well into the framework. *) open GoblintCil diff --git a/src/analyses/libraryDsl.mli b/src/analyses/libraryDsl.mli index e134ad68d7..fd0bc45c26 100644 --- a/src/analyses/libraryDsl.mli +++ b/src/analyses/libraryDsl.mli @@ -18,11 +18,11 @@ type ('k, 'r) args_desc = | (::): ('k, _, 'm) arg_desc * ('m, 'r) args_desc -> ('k, 'r) args_desc (** Cons one argument descriptor. Argument must occur. *) -(** Create library function descriptor from arguments descriptor and continuation function, which takes as many arguments as are captured using {!__} and returns the corresponding {!LibraryDesc.special}. *) +(** Create library function descriptor from arguments descriptor and continuation function, which takes as many arguments as are captured using {!__} and returns the corresponding {!LibraryDesc.type-special}. *) val special: ?attrs:LibraryDesc.attr list -> ('k, LibraryDesc.special) args_desc -> 'k -> LibraryDesc.t -(** Create library function descriptor from arguments descriptor, which must {!drop} all arguments, and continuation function, which takes as an {!unit} argument and returns the corresponding {!LibraryDesc.special}. - Unlike {!special}, this allows the {!LibraryDesc.special} of an argumentless function to depend on options, such that they aren't evaluated at initialization time in {!LibraryFunctions}. *) +(** Create library function descriptor from arguments descriptor, which must {!drop} all arguments, and continuation function, which takes as an {!unit} argument and returns the corresponding {!LibraryDesc.type-special}. + Unlike {!special}, this allows the {!LibraryDesc.type-special} of an argumentless function to depend on options, such that they aren't evaluated at initialization time in {!LibraryFunctions}. *) val special': ?attrs:LibraryDesc.attr list -> (LibraryDesc.special, LibraryDesc.special) args_desc -> (unit -> LibraryDesc.special) -> LibraryDesc.t (** Create unknown library function descriptor from arguments descriptor, which must {!drop} all arguments. *) diff --git a/src/cdomains/floatDomain.mli b/src/cdomains/floatDomain.mli index 06dbf644f8..13df16aba6 100644 --- a/src/cdomains/floatDomain.mli +++ b/src/cdomains/floatDomain.mli @@ -9,67 +9,94 @@ module type FloatArith = sig val neg : t -> t (** Negating a float value: [-x] *) + val add : t -> t -> t (** Addition: [x + y] *) + val sub : t -> t -> t (** Subtraction: [x - y] *) + val mul : t -> t -> t (** Multiplication: [x * y] *) + val div : t -> t -> t (** Division: [x / y] *) + val fmax : t -> t -> t (** Maximum *) + val fmin : t -> t -> t (** Minimum *) - (** {unary functions} *) + (** {b Unary functions} *) + val ceil: t -> t - (* ceil(x) *) + (** ceil(x) *) + val floor: t -> t - (* floor(x) *) + (** floor(x) *) + val fabs : t -> t (** fabs(x) *) + val acos : t -> t (** acos(x) *) + val asin : t -> t (** asin(x) *) + val atan : t -> t (** atan(x) *) + val cos : t -> t (** cos(x) *) + val sin : t -> t (** sin(x) *) + val tan : t -> t (** tan(x) *) (** {b Comparison operators} *) + val lt : t -> t -> IntDomain.IntDomTuple.t (** Less than: [x < y] *) + val gt : t -> t -> IntDomain.IntDomTuple.t (** Greater than: [x > y] *) + val le : t -> t -> IntDomain.IntDomTuple.t (** Less than or equal: [x <= y] *) + val ge : t -> t -> IntDomain.IntDomTuple.t (** Greater than or equal: [x >= y] *) + val eq : t -> t -> IntDomain.IntDomTuple.t (** Equal to: [x == y] *) + val ne : t -> t -> IntDomain.IntDomTuple.t (** Not equal to: [x != y] *) + val unordered: t -> t -> IntDomain.IntDomTuple.t (** Unordered *) - (** {unary functions returning int} *) + (** {b Unary functions returning [int]} *) + val isfinite : t -> IntDomain.IntDomTuple.t - (** __builtin_isfinite(x) *) + (** [__builtin_isfinite(x)] *) + val isinf : t -> IntDomain.IntDomTuple.t - (** __builtin_isinf(x) *) + (** [__builtin_isinf(x)] *) + val isnan : t -> IntDomain.IntDomTuple.t - (** __builtin_isnan(x) *) + (** [__builtin_isnan(x)] *) + val isnormal : t -> IntDomain.IntDomTuple.t - (** __builtin_isnormal(x) *) + (** [__builtin_isnormal(x)] *) + val signbit : t -> IntDomain.IntDomTuple.t - (** __builtin_signbit(x) *) + (** [__builtin_signbit(x)] *) end module type FloatDomainBase = sig diff --git a/src/witness/argTools.ml b/src/witness/argTools.ml index 41a0820aab..2d65911a5f 100644 --- a/src/witness/argTools.ml +++ b/src/witness/argTools.ml @@ -1,4 +1,4 @@ -(** Construction of {{!MyArg} ARGs} from constraint system solutions. *) +(** Construction of {{!MyARG} ARGs} from constraint system solutions. *) open MyCFG From d2941b91d60270647a42866aee48a172f162d43b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 May 2023 17:49:44 +0300 Subject: [PATCH 254/518] Add threadJoins arXiv reference --- src/analyses/threadJoins.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/analyses/threadJoins.ml b/src/analyses/threadJoins.ml index c4cc38ee3d..19433aae9f 100644 --- a/src/analyses/threadJoins.ml +++ b/src/analyses/threadJoins.ml @@ -1,4 +1,6 @@ -(** Joined threads analysis ([threadJoins]). *) +(** Joined threads analysis ([threadJoins]). + + @see Schwarz, M., Saan, S., Seidl, H., Erhard, J., Vojdani, V. Clustered Relational Thread-Modular Abstract Interpretation with Local Traces. Appendix F. *) open GoblintCil open Analyses From 2a64cebd375adf18b296a67a1aae45f0a2f43b6e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 May 2023 17:56:02 +0300 Subject: [PATCH 255/518] Improve some ocamldoc synopses Co-authored-by: Michael Schwarz --- src/analyses/expsplit.ml | 2 +- src/analyses/poisonVariables.ml | 2 +- src/framework/control.ml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/analyses/expsplit.ml b/src/analyses/expsplit.ml index ec62e2a7c6..f702953598 100644 --- a/src/analyses/expsplit.ml +++ b/src/analyses/expsplit.ml @@ -1,4 +1,4 @@ -(** Path-sensitive analysis according to arbitrary given expressions ([expsplit]). *) +(** Path-sensitive analysis according to values of arbitrary given expressions ([expsplit]). *) open Batteries open GoblintCil diff --git a/src/analyses/poisonVariables.ml b/src/analyses/poisonVariables.ml index fda8544201..5cb34baa26 100644 --- a/src/analyses/poisonVariables.ml +++ b/src/analyses/poisonVariables.ml @@ -1,4 +1,4 @@ -(** Taint analysis of variables modified between [setjmp] and [longjmp] ([poisonVariables]). *) +(** Taint analysis of variables that were modified between [setjmp] and [longjmp] and not yet overwritten. ([poisonVariables]). *) open Batteries open GoblintCil diff --git a/src/framework/control.ml b/src/framework/control.ml index c59fdbad98..35cadfc12d 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -1,4 +1,4 @@ -(** Main internal functionality: analysis of the program by constraint solving. *) +(** Main internal functionality: analysis of the program by abstract interpretation via constraint solving. *) (** An analyzer that takes the CFG from [MyCFG], a solver from [Selector], constraints from [Constraints] (using the specification from [MCP]) *) From 5ef49e947ebfa48db518ac793a6fef26f12f53cf Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Wed, 24 May 2023 18:40:19 +0200 Subject: [PATCH 256/518] Try *0; in #ifdef __APPLE__ to trigger warning on macOS in test 01 --- .../71-strings/01-string_literals.c | 50 ++++++++++++++----- 1 file changed, 37 insertions(+), 13 deletions(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index 9a7928e8b4..7e20b92190 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -9,7 +9,11 @@ char* hello_world() { } void id(char* s) { - strcpy(s, s); // should warn + #ifdef __APPLE__ + *0; + #else + strcpy(s, s); // WARN + #endif } int main() { @@ -33,7 +37,7 @@ int main() { i = strcmp(s1, s2); __goblint_check(i < 0); - i = strcmp(s2, "abcdfg"); + i = strcmp(s2, "abcdfg"); // WARN __goblint_check(i == 0); char* cmp = strstr(s1, "bcd"); @@ -59,20 +63,40 @@ int main() { i = strncmp(s1, s2, 5); __goblint_check(i != 0); - + + /* the following portion fails on macOS because of a spurious warning: + * see issue goblint/cil#143 + * + * remove #ifdef portions as soon as issue fixed */ + id(s2); + #ifdef __APPLE__ - /* the following portion fails on macOS because of a spurious warning: - * see issue goblint/cil#143 - * - * remove #ifdef portion and change "should warn" to normal warning as soon as issue fixed */ + *0; #else - id(s2); + strcpy(s1, "hi"); // WARN + #endif - strcpy(s1, "hi"); // should warn - strncpy(s1, "hi", 1); // should warn - strcat(s1, "hi"); // should warn - strncat(s1, "hi", 1); // should warn - + #ifdef __APPLE__ + *0; + #else + strncpy(s1, "hi", 1); // WARN + #endif + + #ifdef __APPLE__ + *0; + #else + strcat(s1, "hi"); // WARN + #endif + + #ifdef __APPLE__ + *0; + #else + strncat(s1, "hi", 1); // WARN + #endif + + #ifdef __APPLE__ + // do nothing => no warning + #else char s4[] = "hello"; strcpy(s4, s2); // NOWARN strncpy(s4, s3, 2); // NOWARN From 822b63c8e54e4a530cd56da270483d57364bc7e4 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Wed, 24 May 2023 19:55:05 +0200 Subject: [PATCH 257/518] Trying workaround to make macOS test warn --- .../71-strings/01-string_literals.c | 27 +++++++++++-------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index 7e20b92190..4be1d8ab5b 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -10,10 +10,11 @@ char* hello_world() { void id(char* s) { #ifdef __APPLE__ - *0; + #define ID *NULL #else - strcpy(s, s); // WARN + #define ID strcpy(s, s) #endif + ID; // WARN } int main() { @@ -37,7 +38,7 @@ int main() { i = strcmp(s1, s2); __goblint_check(i < 0); - i = strcmp(s2, "abcdfg"); // WARN + i = strcmp(s2, "abcdfg"); __goblint_check(i == 0); char* cmp = strstr(s1, "bcd"); @@ -71,28 +72,32 @@ int main() { id(s2); #ifdef __APPLE__ - *0; + #define STRCPY *NULL #else - strcpy(s1, "hi"); // WARN + #define STRCPY strcpy(s1, "hi"); #endif + STRCPY; // WARN #ifdef __APPLE__ - *0; + #define STRNCPY *NULL #else - strncpy(s1, "hi", 1); // WARN + # define STRNCPY strncpy(s1, "hi", 1) #endif + STRNCPY; // WARN #ifdef __APPLE__ - *0; + #define STRCAT *NULL #else - strcat(s1, "hi"); // WARN + #define STRCAT strcat(s1, "hi") #endif + STRCAT; // WARN #ifdef __APPLE__ - *0; + #define STRNCAT *NULL #else - strncat(s1, "hi", 1); // WARN + #define STRNCAT strncat(s1, "hi", 1) #endif + STRNCAT; // WARN #ifdef __APPLE__ // do nothing => no warning From 290ca8da93f34b8a8595780e5fd2b4dbc3951d58 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Wed, 24 May 2023 20:30:11 +0200 Subject: [PATCH 258/518] Further changes to trigger warnings on macOS test --- tests/regression/71-strings/01-string_literals.c | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index 4be1d8ab5b..2ce9133783 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -9,8 +9,9 @@ char* hello_world() { } void id(char* s) { + char* ptr = NULL; // future usage of cmp should warn: workaround for macOS test #ifdef __APPLE__ - #define ID *NULL + #define ID int i = strcmp(cmp, "trigger warning") #else #define ID strcpy(s, s) #endif @@ -71,29 +72,31 @@ int main() { * remove #ifdef portions as soon as issue fixed */ id(s2); + cmp = NULL; // future usage of cmp should warn: workaround for macOS test + #ifdef __APPLE__ - #define STRCPY *NULL + #define STRCPY i = strcmp(cmp, "trigger warning") #else #define STRCPY strcpy(s1, "hi"); #endif STRCPY; // WARN #ifdef __APPLE__ - #define STRNCPY *NULL + #define STRNCPY i = strcmp(cmp, "trigger warning") #else # define STRNCPY strncpy(s1, "hi", 1) #endif STRNCPY; // WARN #ifdef __APPLE__ - #define STRCAT *NULL + #define STRCAT i = strcmp(cmp, "trigger warning") #else #define STRCAT strcat(s1, "hi") #endif STRCAT; // WARN #ifdef __APPLE__ - #define STRNCAT *NULL + #define STRNCAT i = strcmp(cmp, "trigger warning") #else #define STRNCAT strncat(s1, "hi", 1) #endif From c2538e7d645063e9a83803916ddded5d1706e0d7 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Wed, 24 May 2023 21:31:48 +0200 Subject: [PATCH 259/518] Fix mistake in test 01 --- tests/regression/71-strings/01-string_literals.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/71-strings/01-string_literals.c index 2ce9133783..190760bca0 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/71-strings/01-string_literals.c @@ -11,7 +11,7 @@ char* hello_world() { void id(char* s) { char* ptr = NULL; // future usage of cmp should warn: workaround for macOS test #ifdef __APPLE__ - #define ID int i = strcmp(cmp, "trigger warning") + #define ID int i = strcmp(ptr, "trigger warning") #else #define ID strcpy(s, s) #endif @@ -69,7 +69,7 @@ int main() { /* the following portion fails on macOS because of a spurious warning: * see issue goblint/cil#143 * - * remove #ifdef portions as soon as issue fixed */ + * remove #ifdef's as soon as issue fixed */ id(s2); cmp = NULL; // future usage of cmp should warn: workaround for macOS test From 8e5ff9e0ab2435ba95408c38f46ff5347f1fa535 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Fri, 5 May 2023 02:29:49 +0200 Subject: [PATCH 260/518] pull out the counter Chain module, remove now redundant Int lattice --- src/analyses/threadId.ml | 7 +- src/analyses/wrapperFunctionAnalysis.ml | 96 ++++++++++-------------- src/analyses/wrapperFunctionAnalysis0.ml | 42 +++++++++++ src/cdomains/threadIdDomain.ml | 2 +- src/domains/lattice.ml | 18 ----- src/domains/printable.ml | 12 --- src/domains/queries.ml | 9 +-- 7 files changed, 87 insertions(+), 99 deletions(-) create mode 100644 src/analyses/wrapperFunctionAnalysis0.ml diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index d3ca4ce075..dd0beede5b 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -90,10 +90,9 @@ struct (** get the node that identifies the current context, possibly that of a wrapper function *) let indexed_node_for_ctx ?(previous = false) ctx = match ctx.ask (Queries.ThreadCreateIndexedNode previous) with - | `Lifted node, `Lifted count -> node, Some count - | `Lifted node, `Bot -> node, Some 0 - | `Lifted node, _ -> node, None - | _ -> ctx.prev_node, None + | `Lifted node, count when WrapperFunctionAnalysis.ThreadCreateUniqueCount.is_top count -> node, None + | `Lifted node, count -> node, Some count + | (`Bot | `Top), _ -> ctx.prev_node, None let threadenter ctx lval f args = (* [ctx] here is the same as in [special], i.e. before incrementing the unique-counter, diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 634adb37c4..7c9df97fea 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -8,11 +8,7 @@ open GobConfig open ThreadIdDomain module Q = Queries -(* Functor argument for creating the chain lattice of unique calls *) -module type UniqueCountArgs = sig - val unique_count : unit -> int - val label : string -end +include WrapperFunctionAnalysis0 (* Functor argument for determining wrapper and wrapped functions *) module type WrapperArgs = sig @@ -21,7 +17,7 @@ module type WrapperArgs = sig end (* The main analysis, generic to which functions are being wrapped. *) -module SpecBase (UniqueCountArgs : UniqueCountArgs) (WrapperArgs : WrapperArgs) = +module SpecBase (UniqueCount : Lattice.S with type t = int) (WrapperArgs : WrapperArgs) = struct include Analyses.DefaultSpec @@ -32,33 +28,24 @@ struct Introduce a function for this to keep things consistent. *) let node_for_ctx ctx = ctx.prev_node - module Chain = Lattice.Chain (struct - let n () = - let p = UniqueCountArgs.unique_count () in - if p < 0 then - failwith @@ UniqueCountArgs.label ^ " has to be non-negative" - else p + 1 (* Unique addresses + top address *) - - let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x - - end) + module UniqueCount = UniqueCount (* Map for counting function call node visits up to n (of the current thread). Also keep track of the value before the most recent change for a given key. *) - module UniqueCallCounter = struct - include MapDomain.MapBot_LiftTop(Q.NodeFlatLattice)(Lattice.Prod (Chain) (Chain)) - - (* Increase counter for given node. If it does not exist yet, create it. *) - let add_unique_call counter node = - let unique_call = `Lifted node in - let (count0, count) = find unique_call counter in - let count' = if Chain.is_top count then count else count + 1 in - (* if the old count, the current count, and the new count are all the same, nothing to do *) - if count0 = count && count = count' then counter - else remove unique_call counter |> add unique_call (count, count') - end - - module D = Lattice.Prod (UniqueCallCounter) (Q.NodeFlatLattice) + module UniqueCallCounter = + MapDomain.MapBot_LiftTop(NodeFlatLattice)(Lattice.Prod (UniqueCount) (UniqueCount)) + + (* Increase counter for given node. If it does not exist yet, create it. *) + let add_unique_call counter node = + let open UniqueCallCounter in + let unique_call = `Lifted node in + let (count0, count) = find unique_call counter in + let count' = if UniqueCount.is_top count then count else count + 1 in + (* if the old count, the current count, and the new count are all the same, nothing to do *) + if count0 = count && count = count' then counter + else remove unique_call counter |> add unique_call (count, count') + + module D = Lattice.Prod (NodeFlatLattice) (UniqueCallCounter) module C = D let wrappers = Hashtbl.create 13 @@ -77,7 +64,7 @@ struct ctx.local let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = - let counter, wrapper_node = ctx.local in + let wrapper_node, counter = ctx.local in let new_wrapper_node = if Hashtbl.mem wrappers f.svar.vname then match wrapper_node with @@ -86,29 +73,29 @@ struct (* if an interesting callee is called by an uninteresting caller, then we remember the callee context *) | _ -> `Lifted (node_for_ctx ctx) else - Q.NodeFlatLattice.top () (* if an uninteresting callee is called, then we forget what was called before *) + NodeFlatLattice.top () (* if an uninteresting callee is called, then we forget what was called before *) in - let callee = (counter, new_wrapper_node) in + let callee = (new_wrapper_node, counter) in [(ctx.local, callee)] - let combine_env ctx lval fexp f args fc (counter, _) f_ask = + let combine_env ctx lval fexp f args fc (_, counter) f_ask = (* Keep (potentially higher) counter from callee and keep wrapper node from caller *) - let _, lnode = ctx.local in - (counter, lnode) + let lnode, _ = ctx.local in + (lnode, counter) let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (_:D.t) (f_ask: Queries.ask) : D.t = ctx.local - let add_unique_call ctx = - let counter, wrapper_node = ctx.local in + let add_unique_call_ctx ctx = + let wrapper_node, counter = ctx.local in + wrapper_node, (* track the unique ID per call to the wrapper function, not to the wrapped function *) - UniqueCallCounter.add_unique_call counter - (match wrapper_node with `Lifted node -> node | _ -> node_for_ctx ctx), - wrapper_node + add_unique_call counter + (match wrapper_node with `Lifted node -> node | _ -> node_for_ctx ctx) let special (ctx: (D.t, G.t, C.t, V.t) ctx) (lval: lval option) (f: varinfo) (arglist:exp list) : D.t = let desc = LibraryFunctions.find f in - if WrapperArgs.is_wrapped @@ desc.special arglist then add_unique_call ctx else ctx.local + if WrapperArgs.is_wrapped @@ desc.special arglist then add_unique_call_ctx ctx else ctx.local let startstate v = D.bot () @@ -128,17 +115,11 @@ struct end -(* Create the chain argument-module, given the config key to loop up *) -let unique_count_args_from_config key = (module struct - let unique_count () = get_int key - let label = "Option " ^ key -end : UniqueCountArgs) - module MallocWrapper : MCPSpec = struct include SpecBase - (val unique_count_args_from_config "ana.malloc.unique_address_count") + (MallocUniqueCount) (struct let wrappers () = get_string_list "ana.malloc.wrappers" @@ -148,7 +129,7 @@ module MallocWrapper : MCPSpec = struct end) module ThreadNode = struct - include Printable.Prod3 (ThreadIdDomain.ThreadLifted) (Node) (Chain) + include Printable.Prod3 (ThreadIdDomain.ThreadLifted) (Node) (UniqueCount) (* Description that gets appended to the varinfo-name in user output. *) let describe_varinfo (v: varinfo) (t, node, c) = @@ -156,7 +137,7 @@ module MallocWrapper : MCPSpec = struct CilType.Location.show loc let name_varinfo (t, node, c) = - Format.asprintf "(alloc@sid:%s@tid:%s(#%s))" (Node.show_id node) (ThreadLifted.show t) (Chain.show c) + Format.asprintf "(alloc@sid:%s@tid:%s(#%s))" (Node.show_id node) (ThreadLifted.show t) (UniqueCount.show c) end @@ -165,7 +146,7 @@ module MallocWrapper : MCPSpec = struct let name () = "mallocWrapper" let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = - let counter, wrapper_node = ctx.local in + let wrapper_node, counter = ctx.local in match q with | Q.HeapVar -> let node = match wrapper_node with @@ -180,7 +161,7 @@ module MallocWrapper : MCPSpec = struct NodeVarinfoMap.mem_varinfo v | Q.IsMultiple v -> begin match NodeVarinfoMap.from_varinfo v with - | Some (_, _, c) -> Chain.is_top c || not (ctx.ask Q.MustBeUniqueThread) + | Some (_, _, c) -> UniqueCount.is_top c || not (ctx.ask Q.MustBeUniqueThread) | None -> false end | _ -> Queries.Result.top q @@ -200,7 +181,7 @@ end module ThreadCreateWrapper : MCPSpec = struct include SpecBase - (val unique_count_args_from_config "ana.thread.unique_thread_id_count") + (ThreadCreateUniqueCount) (struct let wrappers () = get_string_list "ana.thread.wrappers" @@ -215,16 +196,15 @@ module ThreadCreateWrapper : MCPSpec = struct let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = match q with | Q.ThreadCreateIndexedNode (previous : bool) -> - let counter, wrapper_node = ctx.local in + let wrapper_node, counter = ctx.local in let node = match wrapper_node with | `Lifted wrapper_node -> wrapper_node | _ -> node_for_ctx ctx in let (count0, count1) = UniqueCallCounter.find (`Lifted node) counter in - let count = Lattice.lifted_of_chain (module Chain) (if previous then count0 else count1) in - `Lifted node, count + `Lifted node, (if previous then count0 else count1) | _ -> Queries.Result.top q end -let _ = List.iter MCP.register_analysis [(module MallocWrapper); (module ThreadCreateWrapper)]; +let _ = List.iter MCP.register_analysis [(module MallocWrapper); (module ThreadCreateWrapper)] diff --git a/src/analyses/wrapperFunctionAnalysis0.ml b/src/analyses/wrapperFunctionAnalysis0.ml new file mode 100644 index 0000000000..f23a0468f5 --- /dev/null +++ b/src/analyses/wrapperFunctionAnalysis0.ml @@ -0,0 +1,42 @@ +(** Part of the wrapper function analysis. Seperate out the modules for counting + unique calls: Chain alone is a functor, yet we need the resulting module to + define queries over it. Since the wrapper function analysis also references + those queries, we would have a circular dependency otherwise. *) + +open GobConfig + +(* Functor argument for creating the chain lattice of unique calls *) +module type UniqueCountArgs = sig + val unique_count : unit -> int + val label : string +end + +module MakeUniqueCount (UniqueCountArgs : UniqueCountArgs) : Lattice.S with type t = int = + Lattice.Chain (struct + let n () = + let p = UniqueCountArgs.unique_count () in + if p < 0 then + failwith @@ UniqueCountArgs.label ^ " has to be non-negative" + else p + 1 (* Unique addresses + top address *) + + let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x + + end) + +(* Create the chain argument-module, given the config key to loop up *) +let unique_count_args_from_config key = (module struct + let unique_count () = get_int key + let label = "Option " ^ key +end : UniqueCountArgs) + +module MallocUniqueCount = + MakeUniqueCount (val unique_count_args_from_config "ana.malloc.unique_address_count") + +module ThreadCreateUniqueCount = + MakeUniqueCount (val unique_count_args_from_config "ana.thread.unique_thread_id_count") + +(* since the query also references NodeFlatLattice, it also needs to reside here *) +module NodeFlatLattice = Lattice.Flat (Node) (struct + let top_name = "Unknown node" + let bot_name = "Unreachable node" +end) diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index d2fa782505..fc9e790064 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -50,7 +50,7 @@ struct Printable.Prod (Node) ( Printable.Option - (Printable.Int) + (WrapperFunctionAnalysis0.ThreadCreateUniqueCount) (struct let name = "no index" end))) (struct let name = "no node" end)) diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index 648605692d..2cfe49ccb9 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -617,21 +617,3 @@ struct let pretty_diff () ((x:t),(y:t)): Pretty.doc = Pretty.dprintf "%a not leq %a" pretty x pretty y end - -module IntPO : PO with type t = int = struct - include Printable.Int - let leq = (<=) - let join = max - let meet = min - let widen = join - let narrow = meet - let pretty_diff () (x, y) = Pretty.dprintf "%a not leq %a" pretty x pretty y -end - -module LiftedInt = LiftPO (IntPO) (struct let bot_name = "bot" let top_name = "top" end) - -(* note: returns `Top even for single-valued lattices (whose value is really both top and bot) *) -let lifted_of_chain (module Chain : S with type t = int) x = - if Chain.is_top x then `Top - else if Chain.is_bot x then `Bot - else `Lifted x diff --git a/src/domains/printable.ml b/src/domains/printable.ml index de2f2e1a48..990086c9af 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -594,18 +594,6 @@ struct let relift _ = failwith Message.message end -module Int : S with type t = int = struct - include Std - include Int - let hash = Hashtbl.hash - let show = string_of_int - let pretty () = Pretty.num - let printXml f x = BatPrintf.fprintf f "\n\n%d\n\n\n" x - let name () = "Int" - let to_yojson x = `Int x - let relift x = x -end - (** Concatenates a list of strings that fit in the given character constraint *) let get_short_list begin_str end_str list = diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 4d7cb37085..3a92b95d42 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -13,13 +13,10 @@ module TS = SetDomain.ToppedSet (CilType.Typ) (struct let topname = "All" end) module ES = SetDomain.Reverse (SetDomain.ToppedSet (CilType.Exp) (struct let topname = "All" end)) module VS = SetDomain.ToppedSet (CilType.Varinfo) (struct let topname = "All" end) +module NFL = WrapperFunctionAnalysis0.NodeFlatLattice +module TC = WrapperFunctionAnalysis0.ThreadCreateUniqueCount -module NodeFlatLattice = Lattice.Flat (Node) (struct - let top_name = "Unknown node" - let bot_name = "Unreachable node" -end) - -module ThreadNodeLattice = Lattice.Prod (NodeFlatLattice) (Lattice.LiftedInt) +module ThreadNodeLattice = Lattice.Prod (NFL) (TC) module VI = Lattice.Flat (Basetype.Variables) (struct let top_name = "Unknown line" From 61c4fa63df6cd3e5ffc68e0f064a71c41027ff28 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Fri, 5 May 2023 03:53:34 +0200 Subject: [PATCH 261/518] formatting --- src/analyses/wrapperFunctionAnalysis.ml | 34 ++++++++++++------------ src/analyses/wrapperFunctionAnalysis0.ml | 12 ++++----- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 7c9df97fea..4858d2f771 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -43,7 +43,7 @@ struct let count' = if UniqueCount.is_top count then count else count + 1 in (* if the old count, the current count, and the new count are all the same, nothing to do *) if count0 = count && count = count' then counter - else remove unique_call counter |> add unique_call (count, count') + else remove unique_call counter |> add unique_call (count, count') module D = Lattice.Prod (NodeFlatLattice) (UniqueCallCounter) module C = D @@ -119,14 +119,14 @@ end module MallocWrapper : MCPSpec = struct include SpecBase - (MallocUniqueCount) - (struct - let wrappers () = get_string_list "ana.malloc.wrappers" + (MallocUniqueCount) + (struct + let wrappers () = get_string_list "ana.malloc.wrappers" - let is_wrapped = function - | LibraryDesc.(Malloc _ | Calloc _ | Realloc _) -> true - | _ -> false - end) + let is_wrapped = function + | LibraryDesc.(Malloc _ | Calloc _ | Realloc _) -> true + | _ -> false + end) module ThreadNode = struct include Printable.Prod3 (ThreadIdDomain.ThreadLifted) (Node) (UniqueCount) @@ -181,15 +181,15 @@ end module ThreadCreateWrapper : MCPSpec = struct include SpecBase - (ThreadCreateUniqueCount) - (struct - let wrappers () = get_string_list "ana.thread.wrappers" + (ThreadCreateUniqueCount) + (struct + let wrappers () = get_string_list "ana.thread.wrappers" - let is_wrapped = function - | LibraryDesc.ThreadCreate _ -> true - | _ -> false + let is_wrapped = function + | LibraryDesc.ThreadCreate _ -> true + | _ -> false - end) + end) let name () = "threadCreateWrapper" @@ -198,8 +198,8 @@ module ThreadCreateWrapper : MCPSpec = struct | Q.ThreadCreateIndexedNode (previous : bool) -> let wrapper_node, counter = ctx.local in let node = match wrapper_node with - | `Lifted wrapper_node -> wrapper_node - | _ -> node_for_ctx ctx + | `Lifted wrapper_node -> wrapper_node + | _ -> node_for_ctx ctx in let (count0, count1) = UniqueCallCounter.find (`Lifted node) counter in `Lifted node, (if previous then count0 else count1) diff --git a/src/analyses/wrapperFunctionAnalysis0.ml b/src/analyses/wrapperFunctionAnalysis0.ml index f23a0468f5..bdc01d898c 100644 --- a/src/analyses/wrapperFunctionAnalysis0.ml +++ b/src/analyses/wrapperFunctionAnalysis0.ml @@ -18,10 +18,10 @@ module MakeUniqueCount (UniqueCountArgs : UniqueCountArgs) : Lattice.S with type if p < 0 then failwith @@ UniqueCountArgs.label ^ " has to be non-negative" else p + 1 (* Unique addresses + top address *) - + let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x - - end) + + end) (* Create the chain argument-module, given the config key to loop up *) let unique_count_args_from_config key = (module struct @@ -37,6 +37,6 @@ module ThreadCreateUniqueCount = (* since the query also references NodeFlatLattice, it also needs to reside here *) module NodeFlatLattice = Lattice.Flat (Node) (struct - let top_name = "Unknown node" - let bot_name = "Unreachable node" -end) + let top_name = "Unknown node" + let bot_name = "Unreachable node" + end) From 39ab8c154bd224a94fc79b15cf7f55792f37d5b4 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Fri, 5 May 2023 04:05:35 +0200 Subject: [PATCH 262/518] remove GobList.span --- src/cdomains/threadIdDomain.ml | 2 +- src/util/gobList.ml | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index fc9e790064..d5545f3d8b 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -144,7 +144,7 @@ struct let compose ((p, s) as current) ni = if BatList.mem_cmp Base.compare ni p then ( - let shared, unique = GobList.span (not % Base.equal ni) p in + let shared, unique = BatList.span (not % Base.equal ni) p in (List.tl unique, S.of_list shared |> S.union s |> S.add ni) ) else if is_unique current then diff --git a/src/util/gobList.ml b/src/util/gobList.ml index ee6e6e7b19..3743b0127e 100644 --- a/src/util/gobList.ml +++ b/src/util/gobList.ml @@ -30,13 +30,6 @@ let rec fold_while_some (f : 'a -> 'b -> 'a option) (acc: 'a) (xs: 'b list): 'a let equal = List.eq -(** [span p xs] is [take_while p xs, drop_while p xs] but may be more efficient *) -let span p = - let rec span_helper prefix = function - | x :: xs when p x -> span_helper (x :: prefix) xs - | suffix -> List.rev prefix, suffix - in span_helper [] - (** Given a predicate and a list, returns two lists [(l1, l2)]. [l1] contains the prefix of the list until the last element that satisfies the predicate, [l2] contains all subsequent elements. The order of elements is preserved. *) let until_last_with (pred: 'a -> bool) (xs: 'a list) = From 4fbfbbd323aea452c4aa4b6f56991d35b5200afa Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Fri, 5 May 2023 04:07:12 +0200 Subject: [PATCH 263/518] cleanup --- src/cdomains/threadIdDomain.ml | 1 - src/domains/printable.ml | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index d5545f3d8b..e79ce785ce 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -77,7 +77,6 @@ struct (v, None) let is_main = function - (* shouldn't this check configured mainfun?? *) | ({vname; _}, None) -> List.mem vname @@ GobConfig.get_string_list "mainfun" | _ -> false diff --git a/src/domains/printable.ml b/src/domains/printable.ml index 990086c9af..55e38d03a3 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -470,7 +470,7 @@ module type ChainParams = sig val names: int -> string end -module Chain (P: ChainParams) = +module Chain (P: ChainParams): S with type t = int = struct type t = int [@@deriving eq, ord, hash] include StdLeaf From 8fea30a4bb679670eb623e75290ff302d9bee5f7 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Fri, 5 May 2023 04:09:57 +0200 Subject: [PATCH 264/518] use IdentitySpec --- src/analyses/wrapperFunctionAnalysis.ml | 21 ++------------------- 1 file changed, 2 insertions(+), 19 deletions(-) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 4858d2f771..8a5d19404c 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -19,7 +19,7 @@ end (* The main analysis, generic to which functions are being wrapped. *) module SpecBase (UniqueCount : Lattice.S with type t = int) (WrapperArgs : WrapperArgs) = struct - include Analyses.DefaultSpec + include IdentitySpec (* Use the previous CFG node (ctx.prev_node) for identifying calls to (wrapper) functions. For one, this is the node that typically contains the call as its statement. @@ -51,17 +51,6 @@ struct let wrappers = Hashtbl.create 13 (* transfer functions *) - let assign ctx (lval:lval) (rval:exp) : D.t = - ctx.local - - let branch ctx (exp:exp) (tv:bool) : D.t = - ctx.local - - let body ctx (f:fundec) : D.t = - ctx.local - - let return ctx (exp:exp option) (f:fundec) : D.t = - ctx.local let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = let wrapper_node, counter = ctx.local in @@ -83,9 +72,6 @@ struct let lnode, _ = ctx.local in (lnode, counter) - let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (_:D.t) (f_ask: Queries.ask) : D.t = - ctx.local - let add_unique_call_ctx ctx = let wrapper_node, counter = ctx.local in wrapper_node, @@ -103,10 +89,7 @@ struct (* The new thread receives a fresh counter *) [D.bot ()] - let threadspawn ctx lval f args fctx = - ctx.local - - let exitstate v = D.top () + let exitstate v = D.top () type marshal = unit From 8fe09331beaedeff889eb6cc0377cc38725ed0af Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Fri, 5 May 2023 04:25:40 +0200 Subject: [PATCH 265/518] use fctx, remove the previous/next hack --- src/analyses/threadId.ml | 9 +++------ src/analyses/wrapperFunctionAnalysis.ml | 21 +++++++++------------ src/domains/queries.ml | 11 +++++------ 3 files changed, 17 insertions(+), 24 deletions(-) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index dd0beede5b..9a8a695748 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -88,22 +88,19 @@ struct None (** get the node that identifies the current context, possibly that of a wrapper function *) - let indexed_node_for_ctx ?(previous = false) ctx = - match ctx.ask (Queries.ThreadCreateIndexedNode previous) with + let indexed_node_for_ctx ctx = + match ctx.ask Queries.ThreadCreateIndexedNode with | `Lifted node, count when WrapperFunctionAnalysis.ThreadCreateUniqueCount.is_top count -> node, None | `Lifted node, count -> node, Some count | (`Bot | `Top), _ -> ctx.prev_node, None let threadenter ctx lval f args = - (* [ctx] here is the same as in [special], i.e. before incrementing the unique-counter, - thus we want the current counter (previous: false) *) let+ tid = create_tid ctx.local (indexed_node_for_ctx ctx) f in (tid, TD.bot ()) let threadspawn ctx lval f args fctx = let (current, td) = ctx.local in - (* here we see the updated counter, so we want the previous counter value *) - let node, index = indexed_node_for_ctx ~previous:true ctx in + let node, index = indexed_node_for_ctx fctx in (current, Thread.threadspawn td node index f) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 8a5d19404c..eb438ebbf8 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -30,20 +30,17 @@ struct module UniqueCount = UniqueCount - (* Map for counting function call node visits up to n (of the current thread). - Also keep track of the value before the most recent change for a given key. *) + (* Map for counting function call node visits up to n (of the current thread). *) module UniqueCallCounter = - MapDomain.MapBot_LiftTop(NodeFlatLattice)(Lattice.Prod (UniqueCount) (UniqueCount)) + MapDomain.MapBot_LiftTop(NodeFlatLattice)(UniqueCount) (* Increase counter for given node. If it does not exist yet, create it. *) let add_unique_call counter node = let open UniqueCallCounter in let unique_call = `Lifted node in - let (count0, count) = find unique_call counter in - let count' = if UniqueCount.is_top count then count else count + 1 in - (* if the old count, the current count, and the new count are all the same, nothing to do *) - if count0 = count && count = count' then counter - else remove unique_call counter |> add unique_call (count, count') + let count = find unique_call counter in + if UniqueCount.is_top count then counter + else remove unique_call counter |> add unique_call (count + 1) module D = Lattice.Prod (NodeFlatLattice) (UniqueCallCounter) module C = D @@ -136,7 +133,7 @@ module MallocWrapper : MCPSpec = struct | `Lifted wrapper_node -> wrapper_node | _ -> node_for_ctx ctx in - let (_, count) = UniqueCallCounter.find (`Lifted node) counter in + let count = UniqueCallCounter.find (`Lifted node) counter in let var = NodeVarinfoMap.to_varinfo (ctx.ask Q.CurrentThreadId, node, count) in var.vdecl <- UpdateCil.getLoc node; (* TODO: does this do anything bad for incremental? *) `Lifted var @@ -178,14 +175,14 @@ module ThreadCreateWrapper : MCPSpec = struct let query (ctx: (D.t, G.t, C.t, V.t) ctx) (type a) (q: a Q.t): a Q.result = match q with - | Q.ThreadCreateIndexedNode (previous : bool) -> + | Q.ThreadCreateIndexedNode -> let wrapper_node, counter = ctx.local in let node = match wrapper_node with | `Lifted wrapper_node -> wrapper_node | _ -> node_for_ctx ctx in - let (count0, count1) = UniqueCallCounter.find (`Lifted node) counter in - `Lifted node, (if previous then count0 else count1) + let count = UniqueCallCounter.find (`Lifted node) counter in + `Lifted node, count | _ -> Queries.Result.top q end diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 3a92b95d42..5fcbbb4951 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -74,7 +74,7 @@ type _ t = | MustBeSingleThreaded: MustBool.t t | MustBeUniqueThread: MustBool.t t | CurrentThreadId: ThreadIdDomain.ThreadLifted.t t - | ThreadCreateIndexedNode: bool -> ThreadNodeLattice.t t (* boolean previous: whether to get the previous unique index *) + | ThreadCreateIndexedNode: ThreadNodeLattice.t t | MayBeThreadReturn: MayBool.t t | EvalFunvar: exp -> LS.t t | EvalInt: exp -> ID.t t @@ -143,7 +143,7 @@ struct | EvalValue _ -> (module VD) | BlobSize _ -> (module ID) | CurrentThreadId -> (module ThreadIdDomain.ThreadLifted) - | ThreadCreateIndexedNode _ -> (module ThreadNodeLattice) + | ThreadCreateIndexedNode -> (module ThreadNodeLattice) | HeapVar -> (module VI) | EvalStr _ -> (module SD) | IterPrevVars _ -> (module Unit) @@ -203,7 +203,7 @@ struct | EvalValue _ -> VD.top () | BlobSize _ -> ID.top () | CurrentThreadId -> ThreadIdDomain.ThreadLifted.top () - | ThreadCreateIndexedNode _ -> ThreadNodeLattice.top () + | ThreadCreateIndexedNode -> ThreadNodeLattice.top () | HeapVar -> VI.top () | EvalStr _ -> SD.top () | IterPrevVars _ -> Unit.top () @@ -282,7 +282,7 @@ struct | Any ActiveJumpBuf -> 46 | Any ValidLongJmp -> 47 | Any (MayBeModifiedSinceSetjmp _) -> 48 - | Any ThreadCreateIndexedNode _ -> 49 + | Any ThreadCreateIndexedNode -> 49 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -299,7 +299,6 @@ struct | Any (MayBePublic x1), Any (MayBePublic x2) -> compare_maybepublic x1 x2 | Any (MayBePublicWithout x1), Any (MayBePublicWithout x2) -> compare_maybepublicwithout x1 x2 | Any (MustBeProtectedBy x1), Any (MustBeProtectedBy x2) -> compare_mustbeprotectedby x1 x2 - | Any (ThreadCreateIndexedNode inc1), Any (ThreadCreateIndexedNode inc2) -> Bool.compare inc1 inc2 | Any (EvalFunvar e1), Any (EvalFunvar e2) -> CilType.Exp.compare e1 e2 | Any (EvalInt e1), Any (EvalInt e2) -> CilType.Exp.compare e1 e2 | Any (EvalStr e1), Any (EvalStr e2) -> CilType.Exp.compare e1 e2 @@ -384,7 +383,7 @@ struct | Any MustBeSingleThreaded -> Pretty.dprintf "MustBeSingleThreaded" | Any MustBeUniqueThread -> Pretty.dprintf "MustBeUniqueThread" | Any CurrentThreadId -> Pretty.dprintf "CurrentThreadId" - | Any (ThreadCreateIndexedNode inc) -> Pretty.dprintf "ThreadCreateIndexedNode %b" inc + | Any ThreadCreateIndexedNode -> Pretty.dprintf "ThreadCreateIndexedNode" | Any MayBeThreadReturn -> Pretty.dprintf "MayBeThreadReturn" | Any (EvalFunvar e) -> Pretty.dprintf "EvalFunvar %a" CilType.Exp.pretty e | Any (EvalInt e) -> Pretty.dprintf "EvalInt %a" CilType.Exp.pretty e From ccdc02192662c6922796090c422672682747f35e Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Thu, 25 May 2023 01:08:44 +0200 Subject: [PATCH 266/518] whitespace --- src/domains/printable.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/domains/printable.ml b/src/domains/printable.ml index d1da24b5df..4f68bc29a5 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -594,6 +594,7 @@ struct let relift _ = failwith Message.message end + (** Concatenates a list of strings that fit in the given character constraint *) let get_short_list begin_str end_str list = From 68b22676ada38dda0aa61df7edc740118d7f283e Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Thu, 25 May 2023 01:20:43 +0200 Subject: [PATCH 267/518] more tests Add tests that specifically check that Goblint can't detect two threads as being distinct if unique_thread_id_count is not high enough. --- .../04-unique-counter-id-count-0.c | 43 +++++++++++++++ .../05-wrapper-unique-counter-id-count-0.c | 53 +++++++++++++++++++ 2 files changed, 96 insertions(+) create mode 100644 tests/regression/71-thread_create_wrapper/04-unique-counter-id-count-0.c create mode 100644 tests/regression/71-thread_create_wrapper/05-wrapper-unique-counter-id-count-0.c diff --git a/tests/regression/71-thread_create_wrapper/04-unique-counter-id-count-0.c b/tests/regression/71-thread_create_wrapper/04-unique-counter-id-count-0.c new file mode 100644 index 0000000000..0c79b04a0d --- /dev/null +++ b/tests/regression/71-thread_create_wrapper/04-unique-counter-id-count-0.c @@ -0,0 +1,43 @@ +// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.unique_thread_id_count 0 +// Adapted from test `unique-counter`, but with `unique_thread_id_count` set to 0. +// We expect Goblint to find a race condition. + +#include +#include + +// not marked as a wrapper this time: instead, the two calls are given unique IDs +int my_pthread_create( + pthread_t *restrict thread, + const pthread_attr_t *restrict attr, + void *(*start_routine)(void *), + void *restrict arg +) { + return pthread_create(thread, attr, start_routine, arg); +} + +// uncomment to remove the wrapper +// #define my_pthread_create pthread_create + +int g = 0; +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&A); + g = 1; + pthread_mutex_unlock(&A); + return NULL; +} + +int main() { + pthread_t id1; + my_pthread_create(&id1, NULL, t_fun, NULL); + pthread_t id2; + my_pthread_create(&id2, NULL, t_fun, NULL); + + pthread_join(id1, NULL); + pthread_join(id2, NULL); + + g = 2; // RACE + + return 0; +} diff --git a/tests/regression/71-thread_create_wrapper/05-wrapper-unique-counter-id-count-0.c b/tests/regression/71-thread_create_wrapper/05-wrapper-unique-counter-id-count-0.c new file mode 100644 index 0000000000..eb4df18d5d --- /dev/null +++ b/tests/regression/71-thread_create_wrapper/05-wrapper-unique-counter-id-count-0.c @@ -0,0 +1,53 @@ +// PARAM: --set ana.activated[+] threadJoins --set ana.activated[+] threadCreateWrapper --set ana.thread.wrappers[+] my_pthread_create --set ana.thread.unique_thread_id_count 0 +// Adapted from test `wrapper-unique-counter`, but with `unique_thread_id_count` set to 0. +// We expect Goblint to find a race condition. + +#include +#include + +// mark this as a wrapper, which is called multiple times in the same place +int my_pthread_create( + pthread_t *restrict thread, + const pthread_attr_t *restrict attr, + void *(*start_routine)(void *), + void *restrict arg +) { + return pthread_create(thread, attr, start_routine, arg); +} + +// this is not marked as a wrapper; instead each call to my_pthread_create is given a unique ID +int my_other_pthread_create( + pthread_t *restrict thread, + const pthread_attr_t *restrict attr, + void *(*start_routine)(void *), + void *restrict arg +) { + return my_pthread_create(thread, attr, start_routine, arg); +} + +// uncomment to remove the wrapper +// #define my_other_pthread_create pthread_create + +int g = 0; +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&A); + g = 1; + pthread_mutex_unlock(&A); + return NULL; +} + +int main() { + pthread_t id1; + my_other_pthread_create(&id1, NULL, t_fun, NULL); + pthread_t id2; + my_other_pthread_create(&id2, NULL, t_fun, NULL); + + pthread_join(id1, NULL); + pthread_join(id2, NULL); + + g = 2; // RACE + + return 0; +} From e7e15faa47ca6cfc854283d5f052bbbad587cbeb Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 09:32:23 +0200 Subject: [PATCH 268/518] Fix whitespace Co-authored-by: Simmo Saan --- src/analyses/threadAnalysis.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/analyses/threadAnalysis.ml b/src/analyses/threadAnalysis.ml index a144c9e63a..a0f0ede61f 100644 --- a/src/analyses/threadAnalysis.ml +++ b/src/analyses/threadAnalysis.ml @@ -23,7 +23,6 @@ struct let should_join = D.equal (* transfer functions *) - let return ctx (exp:exp option) (f:fundec) : D.t = let tid = ThreadId.get_current (Analyses.ask_of_ctx ctx) in begin match tid with From 550c4f3946f8607fe76c105a1f30df8bbdfba20c Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 09:33:18 +0200 Subject: [PATCH 269/518] Style improvement Co-authored-by: Simmo Saan --- src/cdomains/mutexAttrDomain.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/cdomains/mutexAttrDomain.ml b/src/cdomains/mutexAttrDomain.ml index 8d8378cfcb..76669fa3a0 100644 --- a/src/cdomains/mutexAttrDomain.ml +++ b/src/cdomains/mutexAttrDomain.ml @@ -38,6 +38,7 @@ let of_int z = `Lifted MutexKind.NonRec else let recursive_int = Lazy.force recursive_int in - match recursive_int with - | r when Z.equal z r -> `Lifted MutexKind.Recursive - | _ -> `Top + if Z.equal z recursive_int then + `Lifted MutexKind.Recursive + else + `Top From f90bbd7c94a0d79d6f0f3e3a642b836f68106e05 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 09:33:59 +0200 Subject: [PATCH 270/518] Indentation Co-authored-by: Simmo Saan --- src/analyses/mayLocks.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 44cc4f32e4..98b738b2f7 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -11,7 +11,10 @@ struct let add ctx (l,r) = if D.mem l ctx.local then - let default () = (M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a (possibly non-recursive) mutex that may be already held"; ctx.local) in + let default () = + M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a (possibly non-recursive) mutex that may be already held"; + ctx.local + in match D.Addr.to_var_must l with | Some v -> (let mtype = ctx.ask (Queries.MutexType v) in From aa29d4c011569e424ce95da3503cac0873d1ff77 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 09:34:19 +0200 Subject: [PATCH 271/518] Indentation Co-authored-by: Simmo Saan --- src/analyses/mayLocks.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 98b738b2f7..95aeafb0ef 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -20,7 +20,9 @@ struct (let mtype = ctx.ask (Queries.MutexType v) in match mtype with | `Lifted MutexAttrDomain.MutexKind.Recursive -> ctx.local - | `Lifted MutexAttrDomain.MutexKind.NonRec -> (M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a non-recursive mutex that may be already held"; ctx.local) + | `Lifted MutexAttrDomain.MutexKind.NonRec -> + M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a non-recursive mutex that may be already held"; + ctx.local | _ -> default ()) | _ -> default () else From 1b0ffc40bd717d0a3a9ec9aa6fd25f0dd723d66b Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 09:40:17 +0200 Subject: [PATCH 272/518] Fix annotation --- tests/regression/71-doublelocking/09-other-dyn.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/71-doublelocking/09-other-dyn.c b/tests/regression/71-doublelocking/09-other-dyn.c index a9d50895b8..cb4ef064f9 100644 --- a/tests/regression/71-doublelocking/09-other-dyn.c +++ b/tests/regression/71-doublelocking/09-other-dyn.c @@ -24,7 +24,7 @@ void* f2(void* ptr) { pthread_mutex_unlock(mut); // To check that this is now actually removed from the may lockset - return NULL; //WARN + return NULL; //NOWARN } From 9f99115b544505b828884a4da5ed0634125dfd95 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 09:49:41 +0200 Subject: [PATCH 273/518] Comments on why 71/07 contains no assertions. --- tests/regression/71-doublelocking/07-rec-dyn-osx.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/regression/71-doublelocking/07-rec-dyn-osx.c b/tests/regression/71-doublelocking/07-rec-dyn-osx.c index a221bc2417..d911cf0daf 100644 --- a/tests/regression/71-doublelocking/07-rec-dyn-osx.c +++ b/tests/regression/71-doublelocking/07-rec-dyn-osx.c @@ -1,4 +1,6 @@ // PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +// We are just testing we don't crash on the code OS X produces here. +// There can be no meaningful asserts, as we set pthread_mutexattr_type to `2` which has different meanings between Linux and OS X. typedef signed char __int8_t; typedef unsigned char __uint8_t; typedef short __int16_t; From 03048e6ba5cbdd825c4a2da3755ed02862ab3ec5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 25 May 2023 11:49:30 +0300 Subject: [PATCH 274/518] Improve some ocamldoc synopses Co-authored-by: Michael Schwarz --- src/analyses/threadReturn.ml | 2 +- src/solvers/generic.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/threadReturn.ml b/src/analyses/threadReturn.ml index b78b339f72..470c4ceaa8 100644 --- a/src/analyses/threadReturn.ml +++ b/src/analyses/threadReturn.ml @@ -1,4 +1,4 @@ -(** Thread returning analysis using boolean call stack ([threadreturn]). *) +(** Thread returning analysis which abstracts a thread's call stack by a boolean, indicating whether it is at the topmost call stack frame or not ([threadreturn]). *) open GoblintCil open Analyses diff --git a/src/solvers/generic.ml b/src/solvers/generic.ml index 3abc0bc95c..2569341dd1 100644 --- a/src/solvers/generic.ml +++ b/src/solvers/generic.ml @@ -1,4 +1,4 @@ -(** Various old solvers. *) +(** Various simple/old solvers and solver utilities. *) open Batteries open GobConfig From 1208190cbc5e76a4c304497533cf7993652a70e7 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 25 May 2023 12:49:35 +0300 Subject: [PATCH 275/518] Switch docs workflow to master branch only --- .github/workflows/docs.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index 9944e678c4..fdfb948cdc 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -3,7 +3,7 @@ name: docs on: push: branches: - - api-docs # TODO: change to master + - master workflow_dispatch: From b9afd1d8ed7a852e2b4f53570bfd28d02aaffece Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 25 May 2023 12:59:30 +0300 Subject: [PATCH 276/518] Fix indentation (PR #1055) --- src/analyses/mallocWrapperAnalysis.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/mallocWrapperAnalysis.ml b/src/analyses/mallocWrapperAnalysis.ml index 47a0e4c3a2..4d965f88d3 100644 --- a/src/analyses/mallocWrapperAnalysis.ml +++ b/src/analyses/mallocWrapperAnalysis.ml @@ -1,7 +1,7 @@ (** Analysis which provides symbolic heap locations for dynamic memory allocations. ([mallocWrapper]). - Provided heap locations are based on the node and thread ID. - Considers [malloc] wrapper functions and a number of unique heap locations for additional precision. *) + Provided heap locations are based on the node and thread ID. + Considers [malloc] wrapper functions and a number of unique heap locations for additional precision. *) open GoblintCil open Analyses From 7ce140a5fe4e04f86868e96b8bc41106ae0edf3f Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 25 May 2023 11:08:00 +0200 Subject: [PATCH 277/518] write out gobview files in server mode also --- src/util/server.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/util/server.ml b/src/util/server.ml index ba58fbd032..364f3b6107 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -285,7 +285,8 @@ let analyze ?(reset=false) (s: t) = Fun.protect ~finally:(fun () -> GobConfig.set_bool "incremental.load" true ) (fun () -> - Maingoblint.do_analyze increment_data (Option.get s.file) + Maingoblint.do_analyze increment_data (Option.get s.file); + Maingoblint.do_gobview (Option.get s.file); ) let () = From 52c701f3787671b320bad139604056e9c01f40b3 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 12:48:34 +0200 Subject: [PATCH 278/518] Fix test 71/08 on OS X which doesn't define some constants --- tests/regression/71-doublelocking/08-other-type.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/tests/regression/71-doublelocking/08-other-type.c b/tests/regression/71-doublelocking/08-other-type.c index 839284e7ce..0f4a2f7887 100644 --- a/tests/regression/71-doublelocking/08-other-type.c +++ b/tests/regression/71-doublelocking/08-other-type.c @@ -12,9 +12,12 @@ pthread_mutex_t mut = PTHREAD_MUTEX_INITIALIZER; #ifndef __APPLE__ pthread_mutex_t mut2 = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP; -#endif - pthread_mutex_t mut3 = PTHREAD_ERRORCHECK_MUTEX_INITIALIZER_NP; +#else +// OS X does not define PTHREAD_ERRORCHECK_MUTEX_INITIALIZER_NP +// we thus use the default one there, which should also create warnings +pthread_mutex_t mut3; +#endif void* f1(void* ptr) { From 7f39fbcdf3cdab3877eaea164fcd2d759ed31ae8 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Thu, 25 May 2023 12:52:56 +0200 Subject: [PATCH 279/518] adapt GobView documentation --- docs/user-guide/inspecting.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/docs/user-guide/inspecting.md b/docs/user-guide/inspecting.md index 411b5d8ec2..67aa86aa97 100644 --- a/docs/user-guide/inspecting.md +++ b/docs/user-guide/inspecting.md @@ -19,6 +19,7 @@ For the initial setup: To build GobView (also for development): 1. Run `dune build gobview` in the analyzer directory to build the web UI -2. Run Goblint with these flags: `--enable gobview --set save_run DIR` (`DIR` is the name of the result directory that Goblint will create and populate, if not specified it is `run`) -3. `cd` into `DIR` and run `python3 -m http.server` +2. The executable for the http-server can then be found in the directory `./_build/default/gobview/goblint-http-server`. It takes the analyzer directory and additional Goblint configurations such as the files to be analyzed as parameters. Run it e.g. with the following command:\ +`./_build/default/gobview/goblint-http-server/goblint_http.exe -with-goblint ../analyzer/goblint -goblint --set files[+] "../analyzer/tests/regression/00-sanity/01-assert.c"` + 4. Visit From fec7dd3972361b873d62f9b496a516b6ff6ddea6 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 13:01:31 +0200 Subject: [PATCH 280/518] 71/07: Do not include pthread.h so OS X tests can have asserts --- tests/regression/71-doublelocking/07-rec-dyn-osx.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/regression/71-doublelocking/07-rec-dyn-osx.c b/tests/regression/71-doublelocking/07-rec-dyn-osx.c index d911cf0daf..bb3cf65657 100644 --- a/tests/regression/71-doublelocking/07-rec-dyn-osx.c +++ b/tests/regression/71-doublelocking/07-rec-dyn-osx.c @@ -1,6 +1,6 @@ -// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' -// We are just testing we don't crash on the code OS X produces here. -// There can be no meaningful asserts, as we set pthread_mutexattr_type to `2` which has different meanings between Linux and OS X. +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' --set pre.cppflags[+] "-DGOBLINT_NO_PTHREAD_ONCE" +// Here, we do not include pthread.h, so MutexAttr.recursive_int remains at `2`, emulating the behavior of OS X. +#define GOBLINT_NO_PTHREAD_ONCE 1 typedef signed char __int8_t; typedef unsigned char __uint8_t; typedef short __int16_t; @@ -71,7 +71,7 @@ void* f1(void* ptr) { pthread_mutex_t* mut = (pthread_mutex_t*) ptr; pthread_mutex_lock(mut); - pthread_mutex_lock(mut); + pthread_mutex_lock(mut); //NOWARN pthread_mutex_unlock(mut); pthread_mutex_unlock(mut); return ((void *)0); @@ -92,7 +92,7 @@ int main(int argc, char const *argv[]) pthread_mutex_lock(&mut); - pthread_mutex_lock(&mut); + pthread_mutex_lock(&mut); //NOWARN pthread_mutex_unlock(&mut); pthread_mutex_unlock(&mut); From 5758ff76233106b25ae1f1670679e005f1150c39 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 13:19:28 +0200 Subject: [PATCH 281/518] Ensure `MutexAttr` survives joins --- src/cdomains/valueDomain.ml | 8 +++ .../71-doublelocking/11-rec-dyn-branch.c | 50 +++++++++++++++++++ 2 files changed, 58 insertions(+) create mode 100644 tests/regression/71-doublelocking/11-rec-dyn-branch.c diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 66185f91bb..0695d3cf88 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -168,6 +168,7 @@ struct match t with | t when is_mutex_type t -> `Mutex | t when is_jmp_buf_type t -> `JmpBuf (JmpBufs.top ()) + | t when is_mutexattr_type t -> `MutexAttr (MutexAttrDomain.top ()) | TInt (ik,_) -> `Int (ID.top_of ik) | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> `Float (FD.top_of fkind) | TPtr _ -> `Address AD.top_ptr @@ -186,6 +187,7 @@ struct match t with | _ when is_mutex_type t -> `Mutex | t when is_jmp_buf_type t -> `JmpBuf (JmpBufs.top ()) + | t when is_mutexattr_type t -> `MutexAttr (MutexAttrDomain.top ()) | TInt (ik,_) -> `Int (ID.(cast_to ik (top_of ik))) | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> `Float (FD.top_of fkind) | TPtr _ -> `Address AD.top_ptr @@ -219,6 +221,7 @@ struct match t with | _ when is_mutex_type t -> `Mutex | t when is_jmp_buf_type t -> `JmpBuf (JmpBufs.top ()) + | t when is_mutexattr_type t -> `MutexAttr (MutexAttrDomain.top ()) | TInt (ikind, _) -> `Int (ID.of_int ikind BI.zero) | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> `Float (FD.of_const fkind 0.0) | TPtr _ -> `Address AD.null_ptr @@ -520,6 +523,7 @@ struct | (`Address x, `Thread y) -> true | (`JmpBuf x, `JmpBuf y) -> JmpBufs.leq x y | (`Mutex, `Mutex) -> true + | (`MutexAttr x, `MutexAttr y) -> MutexAttr.leq x y | _ -> warn_type "leq" x y; false let rec join x y = @@ -553,6 +557,7 @@ struct `Thread y (* TODO: ignores address! *) | (`JmpBuf x, `JmpBuf y) -> `JmpBuf (JmpBufs.join x y) | (`Mutex, `Mutex) -> `Mutex + | (`MutexAttr x, `MutexAttr y) -> `MutexAttr (MutexAttr.join x y) | _ -> warn_type "join" x y; `Top @@ -587,6 +592,7 @@ struct `Thread y (* TODO: ignores address! *) | (`Mutex, `Mutex) -> `Mutex | (`JmpBuf x, `JmpBuf y) -> `JmpBuf (JmpBufs.widen x y) + | (`MutexAttr x, `MutexAttr y) -> `MutexAttr (MutexAttr.widen x y) | _ -> warn_type "widen" x y; `Top @@ -646,6 +652,7 @@ struct `Address x (* TODO: ignores thread! *) | (`Mutex, `Mutex) -> `Mutex | (`JmpBuf x, `JmpBuf y) -> `JmpBuf (JmpBufs.meet x y) + | (`MutexAttr x, `MutexAttr y) -> `MutexAttr (MutexAttr.meet x y) | _ -> warn_type "meet" x y; `Bot @@ -670,6 +677,7 @@ struct | (`Thread y, `Address x) -> `Address x (* TODO: ignores thread! *) | (`Mutex, `Mutex) -> `Mutex + | (`MutexAttr x, `MutexAttr y) -> `MutexAttr (MutexAttr.narrow x y) | x, `Top | `Top, x -> x | x, `Bot | `Bot, x -> `Bot | _ -> diff --git a/tests/regression/71-doublelocking/11-rec-dyn-branch.c b/tests/regression/71-doublelocking/11-rec-dyn-branch.c new file mode 100644 index 0000000000..4fee99a765 --- /dev/null +++ b/tests/regression/71-doublelocking/11-rec-dyn-branch.c @@ -0,0 +1,50 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +// Like 06, but tests mutexattr survives joins +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; + +void* f1(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_unlock(mut); + pthread_mutex_unlock(mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_mutex_t mut; + + pthread_mutexattr_t attr; + + if(argc == 2) { + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + } else { + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + } + + pthread_mutex_init(&mut, &attr); + + + pthread_create(&t1,NULL,f1,&mut); + + + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_unlock(&mut); + pthread_mutex_unlock(&mut); + + pthread_join(t1, NULL); + + + return 0; +} From fe5c49f46e19f4b368ec865774f7fae3ee84e379 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 17:13:18 +0200 Subject: [PATCH 282/518] Support for Lvals --- src/analyses/mayLocks.ml | 12 ++-- src/analyses/mutexTypeAnalysis.ml | 20 +++++-- src/domains/queries.ml | 6 +- .../71-doublelocking/12-rec-dyn-struct.c | 56 +++++++++++++++++++ 4 files changed, 81 insertions(+), 13 deletions(-) create mode 100644 tests/regression/71-doublelocking/12-rec-dyn-struct.c diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 95aeafb0ef..a250b44098 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -15,9 +15,9 @@ struct M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a (possibly non-recursive) mutex that may be already held"; ctx.local in - match D.Addr.to_var_must l with - | Some v -> - (let mtype = ctx.ask (Queries.MutexType v) in + match D.Addr.to_var_offset l with + | Some (v,o) -> + (let mtype = ctx.ask (Queries.MutexType (v, MutexTypeAnalysis.offs_no_index o)) in match mtype with | `Lifted MutexAttrDomain.MutexKind.Recursive -> ctx.local | `Lifted MutexAttrDomain.MutexKind.NonRec -> @@ -30,9 +30,9 @@ struct let remove ctx l = if not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; - match D.Addr.to_var_must l with - | Some v -> - (let mtype = ctx.ask (Queries.MutexType v) in + match D.Addr.to_var_offset l with + | Some (v,o) -> + (let mtype = ctx.ask (Queries.MutexType (v, MutexTypeAnalysis.offs_no_index o)) in match mtype with | `Lifted MutexAttrDomain.MutexKind.NonRec -> D.remove l ctx.local | _ -> ctx.local (* we cannot remove them here *)) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 9581819d40..03b44b73b0 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -6,6 +6,13 @@ open Analyses module MAttr = ValueDomain.MutexAttr module LF = LibraryFunctions +(* Removing indexes here avoids complicated lookups inside the map for a varinfo, at the price that different types of mutexes in arrays are not dinstinguished *) +let rec offs_no_index o = + match o with + | `NoOffset -> `NoOffset + | `Field (f,o) -> `Field (f, offs_no_index o) + | `Index (i,o) -> `Index (Lval.any_index_exp, offs_no_index o) + module Spec : Analyses.MCPSpec with module D = Lattice.Unit and module C = Lattice.Unit = struct include Analyses.DefaultSpec @@ -14,7 +21,8 @@ struct let name () = "pthreadMutexType" module D = Lattice.Unit module C = Lattice.Unit - module G = MAttr + + module G = MapDomain.MapBot_LiftTop (Lval.CilLval) (MAttr) (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = @@ -25,7 +33,8 @@ struct | Const (CInt (c, _, _)) -> MAttr.of_int c | _ -> `Top) in - ctx.sideg v kind; + let r = G.singleton ((v,`NoOffset)) kind in + ctx.sideg v r; ctx.local | _ -> ctx.local @@ -53,7 +62,10 @@ struct | MutexInit {mutex = mutex; attr = attr} -> let mutexes = ctx.ask (Queries.MayPointTo mutex) in let attr = ctx.ask (Queries.EvalMutexAttr attr) in - Queries.LS.iter (function (v, _) -> ctx.sideg v attr) mutexes; + (* It is correct to iter over these sets here, as mutexes need to be intialized before being used, and an analysis that detects usage before initialization is a different analysis. *) + Queries.LS.iter (function (v, o) -> + let r = G.singleton (v, offs_no_index o) attr in + ctx.sideg v r) mutexes; ctx.local | _ -> ctx.local @@ -64,7 +76,7 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = match q with - | Queries.MutexType v -> (ctx.global v:MutexAttrDomain.t) + | Queries.MutexType ((v,o):Lval.CilLval.t) -> let r = ctx.global v in (G.find (v,o) r:MutexAttrDomain.t) | _ -> Queries.Result.top q end diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 448c642aa4..9da1d65b5b 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -83,7 +83,7 @@ type _ t = | HeapVar: VI.t t | IsHeapVar: varinfo -> MayBool.t t (* TODO: is may or must? *) | IsMultiple: varinfo -> MustBool.t t (* Is no other copy of this local variable reachable via pointers? *) - | MutexType: varinfo -> MutexAttrDomain.t t + | MutexType: Lval.CilLval.t -> MutexAttrDomain.t t | EvalThread: exp -> ConcDomain.ThreadSet.t t | EvalMutexAttr: exp -> MutexAttrDomain.t t | EvalJumpBuf: exp -> JmpBufDomain.JmpBufSet.t t @@ -321,7 +321,7 @@ struct | Any (Invariant i1), Any (Invariant i2) -> compare_invariant_context i1 i2 | Any (InvariantGlobal vi1), Any (InvariantGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) - | Any (MutexType v1), Any (MutexType v2) -> CilType.Varinfo.compare v1 v2 + | Any (MutexType v1), Any (MutexType v2) -> Lval.CilLval.compare v1 v2 | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 @@ -358,7 +358,7 @@ struct | Any (EvalJumpBuf e) -> CilType.Exp.hash e | Any (WarnGlobal vi) -> Hashtbl.hash vi | Any (Invariant i) -> hash_invariant_context i - | Any (MutexType v) -> CilType.Varinfo.hash v + | Any (MutexType v) -> Lval.CilLval.hash v | Any (InvariantGlobal vi) -> Hashtbl.hash vi | Any (MustProtectedVars m) -> hash_mustprotectedvars m | Any (MayBeModifiedSinceSetjmp e) -> JmpBufDomain.BufferEntry.hash e diff --git a/tests/regression/71-doublelocking/12-rec-dyn-struct.c b/tests/regression/71-doublelocking/12-rec-dyn-struct.c new file mode 100644 index 0000000000..bf30db6898 --- /dev/null +++ b/tests/regression/71-doublelocking/12-rec-dyn-struct.c @@ -0,0 +1,56 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +// Like 06, but tests mutexattr survives joins +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; +struct s { + pthread_mutex_t mut; +}; + +typedef struct s s_t; + + +void* f1(void* ptr) { + pthread_mutex_t* mut = &(((s_t*) ptr)->mut); + + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_unlock(mut); + pthread_mutex_unlock(mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + s_t mut_str; + + pthread_mutexattr_t attr; + + if(argc == 2) { + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + } else { + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + } + + pthread_mutex_init(&mut_str.mut, &attr); + + + pthread_create(&t1,NULL,f1,&mut_str); + + + pthread_mutex_lock(&mut_str.mut); //NOWARN + pthread_mutex_lock(&mut_str.mut); //NOWARN + pthread_mutex_unlock(&mut_str.mut); + pthread_mutex_unlock(&mut_str.mut); + + pthread_join(t1, NULL); + + + return 0; +} From eeb11fad5d5ecbbbeebfb1ffd730337d26d49acd Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 17:48:22 +0200 Subject: [PATCH 283/518] Support mutexes in structs also for assignments --- src/analyses/mutexTypeAnalysis.ml | 30 ++++++++--- .../71-doublelocking/13-rec-struct.c | 53 +++++++++++++++++++ 2 files changed, 75 insertions(+), 8 deletions(-) create mode 100644 tests/regression/71-doublelocking/13-rec-struct.c diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 03b44b73b0..7720f67e50 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -26,16 +26,30 @@ struct (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = + (* replaces the rightmost offset with r *) + let rec replace_no_offset o r = match o with + | `NoOffset -> r + | `Field (f,o) -> `Field (f, replace_no_offset o r) + | `Index (i,o) -> `Index (i, replace_no_offset o r) + in match lval with - | Var v, Field ({fname = "__data"; _}, Field ({fname = "__kind"; _}, NoOffset)) when ValueDomain.Compound.is_mutex_type v.vtype -> - let kind = - (match Cil.constFold true rval with - | Const (CInt (c, _, _)) -> MAttr.of_int c - | _ -> `Top) + | (Var v, o) -> + let rec helper o t = function + | Field ({fname = "__data"; _}, Field ({fname = "__kind"; _}, NoOffset)) when ValueDomain.Compound.is_mutex_type t -> + let kind = + (match Cil.constFold true rval with + | Const (CInt (c, _, _)) -> MAttr.of_int c + | _ -> `Top) + in + + let r = G.singleton ((v,o)) kind in + ctx.sideg v r; + ctx.local + | Index (i,o') -> helper (replace_no_offset o (`Index (Lval.any_index_exp,`NoOffset))) (Cilfacade.typeOffset t (Index (i,NoOffset))) o' + | Field (f,o') -> helper (replace_no_offset o (`Field (f,`NoOffset))) (Cilfacade.typeOffset t (Field (f,NoOffset))) o' + | NoOffset -> ctx.local in - let r = G.singleton ((v,`NoOffset)) kind in - ctx.sideg v r; - ctx.local + helper `NoOffset v.vtype o | _ -> ctx.local let branch ctx (exp:exp) (tv:bool) : D.t = diff --git a/tests/regression/71-doublelocking/13-rec-struct.c b/tests/regression/71-doublelocking/13-rec-struct.c new file mode 100644 index 0000000000..272353e33b --- /dev/null +++ b/tests/regression/71-doublelocking/13-rec-struct.c @@ -0,0 +1,53 @@ +// PARAM: --set ana.activated[+] 'maylocks' --set ana.activated[+] 'pthreadMutexType' +#define _GNU_SOURCE +#include +#include +#include +#include + + +int g; + +struct s { + pthread_mutex_t m; +}; + +typedef struct s s_t; + +s_t mut = { PTHREAD_MUTEX_INITIALIZER }; + +#ifndef __APPLE__ +s_t mut2 = { PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP }; +#endif + + +void* f1(void* ptr) { + int top; + + g = 1; + if(top) { + pthread_mutex_lock(&mut.m); + } + pthread_mutex_lock(&mut.m); //WARN + pthread_mutex_unlock(&mut.m); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_t t2; + + pthread_create(&t1,NULL,f1,NULL); + pthread_join(t1, NULL); + +#ifndef __APPLE__ + pthread_mutex_lock(&mut2.m); //NOWARN + pthread_mutex_lock(&mut2.m); //NOWARN + pthread_mutex_unlock(&mut2.m); + pthread_mutex_unlock(&mut2.m); +#endif + + return 0; +} From be5432c0290d523b6d7f34f15be6c5d3dd8b6d27 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 17:54:54 +0200 Subject: [PATCH 284/518] Add comment --- src/analyses/mutexTypeAnalysis.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 7720f67e50..1243e3ab26 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -34,6 +34,7 @@ struct in match lval with | (Var v, o) -> + (* There's no way to use the PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP etc for accesses via pointers *) let rec helper o t = function | Field ({fname = "__data"; _}, Field ({fname = "__kind"; _}, NoOffset)) when ValueDomain.Compound.is_mutex_type t -> let kind = From fbc3df44974c912b9837c7d7c702450fe81a9e55 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 25 May 2023 18:37:06 +0200 Subject: [PATCH 285/518] Cleanup --- src/analyses/mayLocks.ml | 4 ++-- src/analyses/mutexTypeAnalysis.ml | 19 +++++++------------ src/cdomains/lval.ml | 29 +++++++++++++++++++++++++++++ src/domains/queries.ml | 12 ++++++++---- 4 files changed, 46 insertions(+), 18 deletions(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index a250b44098..b005ba56be 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -17,7 +17,7 @@ struct in match D.Addr.to_var_offset l with | Some (v,o) -> - (let mtype = ctx.ask (Queries.MutexType (v, MutexTypeAnalysis.offs_no_index o)) in + (let mtype = ctx.ask (Queries.MutexType (v, Lval.OffsetNoIdx.of_offs o)) in match mtype with | `Lifted MutexAttrDomain.MutexKind.Recursive -> ctx.local | `Lifted MutexAttrDomain.MutexKind.NonRec -> @@ -32,7 +32,7 @@ struct if not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; match D.Addr.to_var_offset l with | Some (v,o) -> - (let mtype = ctx.ask (Queries.MutexType (v, MutexTypeAnalysis.offs_no_index o)) in + (let mtype = ctx.ask (Queries.MutexType (v, Lval.OffsetNoIdx.of_offs o)) in match mtype with | `Lifted MutexAttrDomain.MutexKind.NonRec -> D.remove l ctx.local | _ -> ctx.local (* we cannot remove them here *)) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 1243e3ab26..1a5edf7aa9 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -6,12 +6,7 @@ open Analyses module MAttr = ValueDomain.MutexAttr module LF = LibraryFunctions -(* Removing indexes here avoids complicated lookups inside the map for a varinfo, at the price that different types of mutexes in arrays are not dinstinguished *) -let rec offs_no_index o = - match o with - | `NoOffset -> `NoOffset - | `Field (f,o) -> `Field (f, offs_no_index o) - | `Index (i,o) -> `Index (Lval.any_index_exp, offs_no_index o) + module Spec : Analyses.MCPSpec with module D = Lattice.Unit and module C = Lattice.Unit = struct @@ -22,7 +17,8 @@ struct module D = Lattice.Unit module C = Lattice.Unit - module G = MapDomain.MapBot_LiftTop (Lval.CilLval) (MAttr) + (* Removing indexes here avoids complicated lookups inside the map for a varinfo, at the price that different types of mutexes in arrays are not dinstinguished *) + module G = MapDomain.MapBot_LiftTop (Lval.OffsetNoIdx) (MAttr) (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = @@ -42,11 +38,10 @@ struct | Const (CInt (c, _, _)) -> MAttr.of_int c | _ -> `Top) in - - let r = G.singleton ((v,o)) kind in + let r = G.singleton (o) kind in ctx.sideg v r; ctx.local - | Index (i,o') -> helper (replace_no_offset o (`Index (Lval.any_index_exp,`NoOffset))) (Cilfacade.typeOffset t (Index (i,NoOffset))) o' + | Index (i,o') -> helper (replace_no_offset o (`Index (Lval.OffsetNoIdx.SomeIdx,`NoOffset))) (Cilfacade.typeOffset t (Index (i,NoOffset))) o' | Field (f,o') -> helper (replace_no_offset o (`Field (f,`NoOffset))) (Cilfacade.typeOffset t (Field (f,NoOffset))) o' | NoOffset -> ctx.local in @@ -79,7 +74,7 @@ struct let attr = ctx.ask (Queries.EvalMutexAttr attr) in (* It is correct to iter over these sets here, as mutexes need to be intialized before being used, and an analysis that detects usage before initialization is a different analysis. *) Queries.LS.iter (function (v, o) -> - let r = G.singleton (v, offs_no_index o) attr in + let r = G.singleton (Lval.OffsetNoIdx.of_offs o) attr in ctx.sideg v r) mutexes; ctx.local | _ -> ctx.local @@ -91,7 +86,7 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = match q with - | Queries.MutexType ((v,o):Lval.CilLval.t) -> let r = ctx.global v in (G.find (v,o) r:MutexAttrDomain.t) + | Queries.MutexType (v,o) -> let r = ctx.global v in (G.find o r:MutexAttrDomain.t) | _ -> Queries.Result.top q end diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index e6143e0de9..7dd4cbd1ec 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -626,3 +626,32 @@ struct end ) end + +module OffsetNoIdx = +struct + type someidx = SomeIdx [@@deriving eq, ord, hash] + + include Printable.StdLeaf + type t = (CilType.Fieldinfo.t, someidx) offs [@@deriving eq, ord, hash] + + let name () = "offset without index" + + let rec short_offs (o: (fieldinfo, _) offs) a = + match o with + | `NoOffset -> a + | `Field (f,o) -> short_offs o (a^"."^f.fname) + | `Index (_,o) -> short_offs o (a^"[?]") + + let rec of_offs = function + | `NoOffset -> `NoOffset + | `Field (f,o) -> `Field (f, of_offs o) + | `Index (i,o) -> `Index (SomeIdx, of_offs o) + + let show o = short_offs o "" + include Printable.SimpleShow ( + struct + type nonrec t = t + let show = show + end + ) +end diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 9da1d65b5b..90a2b3b28d 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -83,7 +83,7 @@ type _ t = | HeapVar: VI.t t | IsHeapVar: varinfo -> MayBool.t t (* TODO: is may or must? *) | IsMultiple: varinfo -> MustBool.t t (* Is no other copy of this local variable reachable via pointers? *) - | MutexType: Lval.CilLval.t -> MutexAttrDomain.t t + | MutexType: varinfo * Lval.OffsetNoIdx.t -> MutexAttrDomain.t t | EvalThread: exp -> ConcDomain.ThreadSet.t t | EvalMutexAttr: exp -> MutexAttrDomain.t t | EvalJumpBuf: exp -> JmpBufDomain.JmpBufSet.t t @@ -321,7 +321,11 @@ struct | Any (Invariant i1), Any (Invariant i2) -> compare_invariant_context i1 i2 | Any (InvariantGlobal vi1), Any (InvariantGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) - | Any (MutexType v1), Any (MutexType v2) -> Lval.CilLval.compare v1 v2 + | Any (MutexType (v1,o1)), Any (MutexType (v2,o2)) -> let r = CilType.Varinfo.compare v1 v2 in + if r <> 0 then + r + else + Lval.OffsetNoIdx.compare o1 o2 | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 @@ -358,7 +362,7 @@ struct | Any (EvalJumpBuf e) -> CilType.Exp.hash e | Any (WarnGlobal vi) -> Hashtbl.hash vi | Any (Invariant i) -> hash_invariant_context i - | Any (MutexType v) -> Lval.CilLval.hash v + | Any (MutexType (v,o)) -> 31*CilType.Varinfo.hash v + Lval.OffsetNoIdx.hash o | Any (InvariantGlobal vi) -> Hashtbl.hash vi | Any (MustProtectedVars m) -> hash_mustprotectedvars m | Any (MayBeModifiedSinceSetjmp e) -> JmpBufDomain.BufferEntry.hash e @@ -412,7 +416,7 @@ struct | Any (WarnGlobal vi) -> Pretty.dprintf "WarnGlobal _" | Any (IterSysVars _) -> Pretty.dprintf "IterSysVars _" | Any (InvariantGlobal i) -> Pretty.dprintf "InvariantGlobal _" - | Any (MutexType m) -> Pretty.dprintf "MutexType _" + | Any (MutexType (v,o)) -> Pretty.dprintf "MutexType _" | Any (EvalMutexAttr a) -> Pretty.dprintf "EvalMutexAttr _" | Any MayAccessed -> Pretty.dprintf "MayAccessed" | Any MayBeTainted -> Pretty.dprintf "MayBeTainted" From 0231a662efe38b1e086ef02a01694dc20da80e91 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Thu, 25 May 2023 20:03:56 +0000 Subject: [PATCH 286/518] Bump actions/configure-pages from 2 to 3 Bumps [actions/configure-pages](https://github.com/actions/configure-pages) from 2 to 3. - [Release notes](https://github.com/actions/configure-pages/releases) - [Commits](https://github.com/actions/configure-pages/compare/v2...v3) --- updated-dependencies: - dependency-name: actions/configure-pages dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/docs.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index fdfb948cdc..0f2a254222 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -43,7 +43,7 @@ jobs: - name: Setup Pages id: pages - uses: actions/configure-pages@v2 + uses: actions/configure-pages@v3 - name: Install dependencies run: opam install . --deps-only --locked --with-doc From 27d29fa35d485ada2961a62bd3cc535e6af56950 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Thu, 25 May 2023 20:04:01 +0000 Subject: [PATCH 287/518] Bump actions/deploy-pages from 1 to 2 Bumps [actions/deploy-pages](https://github.com/actions/deploy-pages) from 1 to 2. - [Release notes](https://github.com/actions/deploy-pages/releases) - [Commits](https://github.com/actions/deploy-pages/compare/v1...v2) --- updated-dependencies: - dependency-name: actions/deploy-pages dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/docs.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index fdfb948cdc..13c0191e66 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -65,4 +65,4 @@ jobs: steps: - name: Deploy to GitHub Pages id: deployment - uses: actions/deploy-pages@v1 + uses: actions/deploy-pages@v2 From f2fe2bc94609de422ed4def1336f57029cb185d3 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 09:48:35 +0200 Subject: [PATCH 288/518] derive compare for MutexType --- src/domains/queries.ml | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/domains/queries.ml b/src/domains/queries.ml index aec8e1c779..344a3c62ca 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -321,11 +321,7 @@ struct | Any (Invariant i1), Any (Invariant i2) -> compare_invariant_context i1 i2 | Any (InvariantGlobal vi1), Any (InvariantGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) - | Any (MutexType (v1,o1)), Any (MutexType (v2,o2)) -> let r = CilType.Varinfo.compare v1 v2 in - if r <> 0 then - r - else - Lval.OffsetNoIdx.compare o1 o2 + | Any (MutexType (v1,o1)), Any (MutexType (v2,o2)) -> [%ord: CilType.Varinfo.t * Lval.OffsetNoIdx.t] (v1,o1) (v2,o2) | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 From 48f154a9fcf4805ce381c6fb6481e34e17e3fe7f Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 10:01:14 +0200 Subject: [PATCH 289/518] Use bespoke V, reduce boilerplate --- src/analyses/mutexTypeAnalysis.ml | 39 ++++++++++--------------------- 1 file changed, 12 insertions(+), 27 deletions(-) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 1a5edf7aa9..73c2c66363 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -10,15 +10,19 @@ module LF = LibraryFunctions module Spec : Analyses.MCPSpec with module D = Lattice.Unit and module C = Lattice.Unit = struct - include Analyses.DefaultSpec - module V = VarinfoV + include Analyses.IdentitySpec let name () = "pthreadMutexType" module D = Lattice.Unit module C = Lattice.Unit - (* Removing indexes here avoids complicated lookups inside the map for a varinfo, at the price that different types of mutexes in arrays are not dinstinguished *) - module G = MapDomain.MapBot_LiftTop (Lval.OffsetNoIdx) (MAttr) + (* Removing indexes here avoids complicated lookups and allows to have the LVals as vars here, at the price that different types of mutexes in arrays are not dinstinguished *) + module V = struct + include Printable.Prod(CilType.Varinfo)(Lval.OffsetNoIdx) + let is_write_only _ = false + end + + module G = MAttr (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = @@ -38,8 +42,7 @@ struct | Const (CInt (c, _, _)) -> MAttr.of_int c | _ -> `Top) in - let r = G.singleton (o) kind in - ctx.sideg v r; + ctx.sideg (v,o) kind; ctx.local | Index (i,o') -> helper (replace_no_offset o (`Index (Lval.OffsetNoIdx.SomeIdx,`NoOffset))) (Cilfacade.typeOffset t (Index (i,NoOffset))) o' | Field (f,o') -> helper (replace_no_offset o (`Field (f,`NoOffset))) (Cilfacade.typeOffset t (Field (f,NoOffset))) o' @@ -48,24 +51,6 @@ struct helper `NoOffset v.vtype o | _ -> ctx.local - let branch ctx (exp:exp) (tv:bool) : D.t = - ctx.local - - let body ctx (f:fundec) : D.t = - ctx.local - - let return ctx (exp:exp option) (f:fundec) : D.t = - ctx.local - - let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = - [ctx.local, ctx.local] - - let combine_env ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (au:D.t) (f_ask:Queries.ask) : D.t = - au - - let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (au:D.t) (f_ask: Queries.ask) : D.t = - ctx.local - let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = let desc = LF.find f in match desc.special arglist with @@ -74,8 +59,8 @@ struct let attr = ctx.ask (Queries.EvalMutexAttr attr) in (* It is correct to iter over these sets here, as mutexes need to be intialized before being used, and an analysis that detects usage before initialization is a different analysis. *) Queries.LS.iter (function (v, o) -> - let r = G.singleton (Lval.OffsetNoIdx.of_offs o) attr in - ctx.sideg v r) mutexes; + let o' = Lval.OffsetNoIdx.of_offs o in + ctx.sideg (v,o') attr) mutexes; ctx.local | _ -> ctx.local @@ -86,7 +71,7 @@ struct let query ctx (type a) (q: a Queries.t): a Queries.result = match q with - | Queries.MutexType (v,o) -> let r = ctx.global v in (G.find o r:MutexAttrDomain.t) + | Queries.MutexType (v,o) -> (ctx.global (v,o):MutexAttrDomain.t) | _ -> Queries.Result.top q end From 655c1be4dd5469e490a2b22bf7d45446beb2d0ab Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 10:11:24 +0200 Subject: [PATCH 290/518] Simplify --- src/analyses/mutexTypeAnalysis.ml | 22 +++++++--------------- src/cdomains/lval.ml | 6 ++++++ 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 73c2c66363..5790589671 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -6,8 +6,6 @@ open Analyses module MAttr = ValueDomain.MutexAttr module LF = LibraryFunctions - - module Spec : Analyses.MCPSpec with module D = Lattice.Unit and module C = Lattice.Unit = struct include Analyses.IdentitySpec @@ -17,8 +15,10 @@ struct module C = Lattice.Unit (* Removing indexes here avoids complicated lookups and allows to have the LVals as vars here, at the price that different types of mutexes in arrays are not dinstinguished *) + module O = Lval.OffsetNoIdx + module V = struct - include Printable.Prod(CilType.Varinfo)(Lval.OffsetNoIdx) + include Printable.Prod(CilType.Varinfo)(O) let is_write_only _ = false end @@ -26,12 +26,6 @@ struct (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = - (* replaces the rightmost offset with r *) - let rec replace_no_offset o r = match o with - | `NoOffset -> r - | `Field (f,o) -> `Field (f, replace_no_offset o r) - | `Index (i,o) -> `Index (i, replace_no_offset o r) - in match lval with | (Var v, o) -> (* There's no way to use the PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP etc for accesses via pointers *) @@ -44,8 +38,8 @@ struct in ctx.sideg (v,o) kind; ctx.local - | Index (i,o') -> helper (replace_no_offset o (`Index (Lval.OffsetNoIdx.SomeIdx,`NoOffset))) (Cilfacade.typeOffset t (Index (i,NoOffset))) o' - | Field (f,o') -> helper (replace_no_offset o (`Field (f,`NoOffset))) (Cilfacade.typeOffset t (Field (f,NoOffset))) o' + | Index (i,o') -> helper (O.add_offset o (`Index (O.SomeIdx,`NoOffset))) (Cilfacade.typeOffset t (Index (i,NoOffset))) o' + | Field (f,o') -> helper (O.add_offset o (`Field (f,`NoOffset))) (Cilfacade.typeOffset t (Field (f,NoOffset))) o' | NoOffset -> ctx.local in helper `NoOffset v.vtype o @@ -55,12 +49,10 @@ struct let desc = LF.find f in match desc.special arglist with | MutexInit {mutex = mutex; attr = attr} -> - let mutexes = ctx.ask (Queries.MayPointTo mutex) in let attr = ctx.ask (Queries.EvalMutexAttr attr) in + let mutexes = ctx.ask (Queries.MayPointTo mutex) in (* It is correct to iter over these sets here, as mutexes need to be intialized before being used, and an analysis that detects usage before initialization is a different analysis. *) - Queries.LS.iter (function (v, o) -> - let o' = Lval.OffsetNoIdx.of_offs o in - ctx.sideg (v,o') attr) mutexes; + Queries.LS.iter (function (v, o) -> ctx.sideg (v,O.of_offs o) attr) mutexes; ctx.local | _ -> ctx.local diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 9bde60418f..5132a98472 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -649,6 +649,12 @@ struct | `Field (f,o) -> `Field (f, of_offs o) | `Index (i,o) -> `Index (SomeIdx, of_offs o) + let rec add_offset o1 o2 = + match o1 with + | `NoOffset -> o2 + | `Field (f1,o1) -> `Field (f1,add_offset o1 o2) + | `Index (i1,o1) -> `Index (i1,add_offset o1 o2) + let show o = short_offs o "" include Printable.SimpleShow ( struct From 01b9841b262a911f79d30328d3d9b245408cc309 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 10:54:53 +0200 Subject: [PATCH 291/518] Attempt at reuse --- src/analyses/mutexTypeAnalysis.ml | 8 +++-- src/cdomains/lval.ml | 57 ++++++++++--------------------- 2 files changed, 24 insertions(+), 41 deletions(-) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 5790589671..feb7fb413e 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -38,8 +38,12 @@ struct in ctx.sideg (v,o) kind; ctx.local - | Index (i,o') -> helper (O.add_offset o (`Index (O.SomeIdx,`NoOffset))) (Cilfacade.typeOffset t (Index (i,NoOffset))) o' - | Field (f,o') -> helper (O.add_offset o (`Field (f,`NoOffset))) (Cilfacade.typeOffset t (Field (f,NoOffset))) o' + | Index (i,o') -> + let o'' = O.of_offs (`Index (i, `NoOffset)) in + helper (O.add_offset o o'') (Cilfacade.typeOffset t (Index (i,NoOffset))) o' + | Field (f,o') -> + let o'' = O.of_offs (`Field (f, `NoOffset)) in + helper (O.add_offset o o'') (Cilfacade.typeOffset t (Field (f,NoOffset))) o' | NoOffset -> ctx.local in helper `NoOffset v.vtype o diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 5132a98472..656797a3b8 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -443,32 +443,38 @@ struct end end -(** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module NormalLatRepr (Idx: IntDomain.Z) = -struct - include NormalLat (Idx) - +(* Helper for offsets without abstract values for index offsets, i.e. with unit index offsets.*) +module NoIdxOffsetBase = struct module UnitIdxDomain = struct include Lattice.Unit let equal_to _ _ = `Top let to_int _ = None end + + let rec of_offs = function + | `NoOffset -> `NoOffset + | `Field (f,o) -> `Field (f, of_offs o) + | `Index (i,o) -> `Index (UnitIdxDomain.top (), of_offs o) +end + +(** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) +module NormalLatRepr (Idx: IntDomain.Z) = +struct + include NormalLat (Idx) + (** Representatives for lvalue sublattices as defined by {!NormalLat}. *) module R: DisjointDomain.Representative with type elt = t = struct type elt = t + open NoIdxOffsetBase (* Offset module for representative without abstract values for index offsets, i.e. with unit index offsets. Reason: The offset in the representative (used for buckets) should not depend on the integer domains, since different integer domains may be active at different program points. *) include Normal (UnitIdxDomain) - let rec of_elt_offset: (fieldinfo, Idx.t) offs -> (fieldinfo, UnitIdxDomain.t) offs = - function - | `NoOffset -> `NoOffset - | `Field (f,o) -> `Field (f, of_elt_offset o) - | `Index (_,o) -> `Index (UnitIdxDomain.top (), of_elt_offset o) (* all indices to same bucket *) + let of_elt_offset: (fieldinfo, Idx.t) offs -> (fieldinfo, UnitIdxDomain.t) offs = of_offs let of_elt (x: elt): t = match x with | Addr (v, o) -> Addr (v, of_elt_offset o) (* addrs grouped by var and part of offset *) @@ -631,35 +637,8 @@ end module OffsetNoIdx = struct - type someidx = SomeIdx [@@deriving eq, ord, hash] - - include Printable.StdLeaf - type t = (CilType.Fieldinfo.t, someidx) offs [@@deriving eq, ord, hash] + include NoIdxOffsetBase + include Offset(UnitIdxDomain) let name () = "offset without index" - - let rec short_offs (o: (fieldinfo, _) offs) a = - match o with - | `NoOffset -> a - | `Field (f,o) -> short_offs o (a^"."^f.fname) - | `Index (_,o) -> short_offs o (a^"[?]") - - let rec of_offs = function - | `NoOffset -> `NoOffset - | `Field (f,o) -> `Field (f, of_offs o) - | `Index (i,o) -> `Index (SomeIdx, of_offs o) - - let rec add_offset o1 o2 = - match o1 with - | `NoOffset -> o2 - | `Field (f1,o1) -> `Field (f1,add_offset o1 o2) - | `Index (i1,o1) -> `Index (i1,add_offset o1 o2) - - let show o = short_offs o "" - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) end From 6fae749ec9577078337958f121e0010d43d43378 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 11:19:06 +0200 Subject: [PATCH 292/518] Fix comment --- src/analyses/basePriv.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 2f36065ce6..e5ca0ee7d9 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -596,8 +596,9 @@ struct {st with cpa= cpa_local } let threadenter ask (st: BaseComponents (D).t): BaseComponents (D).t = - (* We cannot copy over protected things, the thread may start with things privatized that are overwritten before becoming public *) let _,lmust,l = st.priv in + (* Thread starts without any mutexes, so the local state cannot contain any privatized things. The locals of the created thread are added later, *) + (* so the cpa component of st is bot. *) {st with cpa = CPA.bot (); priv = (W.bot (),lmust,l)} let threadspawn (ask:Queries.ask) get set (st: BaseComponents (D).t) = From 10d3ae5bf6244587e365d4b8a1e77238060cf2eb Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 13:00:10 +0200 Subject: [PATCH 293/518] Introduce type for weak / strong prptection --- src/analyses/basePriv.ml | 23 ++++++++++++----------- src/analyses/commonPriv.ml | 17 +++++++++-------- src/analyses/mutexAnalysis.ml | 16 ++++++++-------- src/domains/queries.ml | 17 ++++++++++++++--- 4 files changed, 43 insertions(+), 30 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index e5ca0ee7d9..0154924a1c 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -393,6 +393,7 @@ end module PerMutexMeetTIDPriv: S = struct + open Queries.Protection include PerMutexMeetPrivBase include PerMutexTidCommon(struct let exclude_not_started () = GobConfig.get_bool "ana.base.priv.not-started" @@ -426,7 +427,7 @@ struct let get_relevant_writes (ask:Q.ask) m v = let current = ThreadId.get_current ask in let must_joined = ask.f Queries.MustJoinedThreads in - let is_in_Gm x _ = is_protected_by ~recoverable:true ask m x in + let is_in_Gm x _ = is_protected_by ~protection:Weak ask m x in GMutex.fold (fun k v acc -> if compatible ask current must_joined k then CPA.join acc (CPA.filter is_in_Gm v) @@ -441,7 +442,7 @@ struct get_m else let get_mutex_inits = merge_all @@ G.mutex @@ getg V.mutex_inits in - let is_in_Gm x _ = is_protected_by ~recoverable:true ask m x in + let is_in_Gm x _ = is_protected_by ~protection:Weak ask m x in let get_mutex_inits' = CPA.filter is_in_Gm get_mutex_inits in CPA.join get_m get_mutex_inits' in @@ -452,7 +453,7 @@ struct let lm = LLock.global x in let tmp = get_mutex_global_g_with_mutex_inits (not (LMust.mem lm lmust)) ask getg x in let local_m = BatOption.default (CPA.bot ()) (L.find_opt lm l) in - if is_unprotected ask ~recoverable:true x then + if is_unprotected ask ~protection:Weak x then (* We can not rely upon the old value here, it may be too small due to reuse at widening points (and or nice bot/top confusion) in Base *) CPA.find x (CPA.join tmp local_m) else @@ -460,14 +461,14 @@ struct let read_global ask getg st x = let v = read_global ask getg st x in - if M.tracing then M.tracel "priv" "READ GLOBAL %a %B %a = %a\n" CilType.Varinfo.pretty x (is_unprotected ~recoverable:true ask x) CPA.pretty st.cpa VD.pretty v; + if M.tracing then M.tracel "priv" "READ GLOBAL %a %B %a = %a\n" CilType.Varinfo.pretty x (is_unprotected ~protection:Weak ask x) CPA.pretty st.cpa VD.pretty v; v let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = let w,lmust,l = st.priv in let lm = LLock.global x in let cpa' = - if is_unprotected ask ~recoverable:true x then + if is_unprotected ask ~protection:Weak x then st.cpa else CPA.add x v st.cpa @@ -492,7 +493,7 @@ struct let lm = LLock.mutex m in let get_m = get_m_with_mutex_inits (not (LMust.mem lm lmust)) ask getg m in let local_m = BatOption.default (CPA.bot ()) (L.find_opt lm l) in - let is_in_Gm x _ = is_protected_by ~recoverable:true ask m x in + let is_in_Gm x _ = is_protected_by ~protection:Weak ask m x in let local_m = CPA.filter is_in_Gm local_m in let r = CPA.join get_m local_m in let meet = long_meet st.cpa r in @@ -504,18 +505,18 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let w,lmust,l = st.priv in let cpa' = CPA.fold (fun x v cpa -> - if is_protected_by ~recoverable:true ask m x && is_unprotected_without ~recoverable:true ask x m then + if is_protected_by ~protection:Weak ask m x && is_unprotected_without ~protection:Weak ask x m then CPA.remove x cpa else cpa ) st.cpa st.cpa in - let w' = W.filter (fun v -> not (is_unprotected_without ~recoverable:true ask v m)) w in - let side_needed = W.exists (fun v -> is_protected_by ~recoverable:true ask m v) w in + let w' = W.filter (fun v -> not (is_unprotected_without ~protection:Weak ask v m)) w in + let side_needed = W.exists (fun v -> is_protected_by ~protection:Weak ask m v) w in if not side_needed then {st with cpa = cpa'; priv = (w',lmust,l)} else - let is_in_Gm x _ = is_protected_by ~recoverable:true ask m x in + let is_in_Gm x _ = is_protected_by ~protection:Weak ask m x in let tid = ThreadId.get_current ask in let sidev = GMutex.singleton tid (CPA.filter is_in_Gm st.cpa) in sideg (V.mutex m) (G.create_mutex sidev); @@ -603,7 +604,7 @@ struct let threadspawn (ask:Queries.ask) get set (st: BaseComponents (D).t) = let is_recovered_st = ask.f (Queries.MustBeSingleThreaded {since_start = false}) && not @@ ask.f (Queries.MustBeSingleThreaded {since_start = true}) in - let unprotected_after x = ask.f (Q.MayBePublic {global=x; write=true; recoverable=true}) in + let unprotected_after x = ask.f (Q.MayBePublic {global=x; write=true; protection=Weak}) in if is_recovered_st then (* Remove all things that are now unprotected *) let cpa' = CPA.fold (fun x v cpa -> diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 4ca26b68b5..7106cf5912 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -39,22 +39,23 @@ end module Protection = struct - let is_unprotected ask ?(recoverable=false) x: bool = - let multi = if recoverable then ThreadFlag.is_currently_multi ask else ThreadFlag.has_ever_been_multi ask in + open Q.Protection + let is_unprotected ask ?(protection=Strong) x: bool = + let multi = if protection = Weak then ThreadFlag.is_currently_multi ask else ThreadFlag.has_ever_been_multi ask in (!GobConfig.earlyglobs && not multi && not (is_excluded_from_earlyglobs x)) || ( multi && - ask.f (Q.MayBePublic {global=x; write=true; recoverable}) + ask.f (Q.MayBePublic {global=x; write=true; protection}) ) - let is_unprotected_without ask ?(write=true) ?(recoverable=false) x m: bool = - (if recoverable then ThreadFlag.is_currently_multi ask else ThreadFlag.has_ever_been_multi ask) && - ask.f (Q.MayBePublicWithout {global=x; write; without_mutex=m; recoverable}) + let is_unprotected_without ask ?(write=true) ?(protection=Strong) x m: bool = + (if protection = Weak then ThreadFlag.is_currently_multi ask else ThreadFlag.has_ever_been_multi ask) && + ask.f (Q.MayBePublicWithout {global=x; write; without_mutex=m; protection}) - let is_protected_by ask ?(recoverable=false) m x: bool = + let is_protected_by ask ?(protection=Strong) m x: bool = is_global ask x && not (VD.is_immediate_type x.vtype) && - ask.f (Q.MustBeProtectedBy {mutex=m; global=x; write=true; recoverable}) + ask.f (Q.MustBeProtectedBy {mutex=m; global=x; write=true; protection}) let protected_vars (ask: Q.ask): varinfo list = let module VS = Set.Make (CilType.Varinfo) in diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index f6374229c4..810a285a9b 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -124,10 +124,10 @@ struct `Index (i_exp, conv_offset_inv o) let query ctx (type a) (q: a Queries.t): a Queries.result = - let check_fun ~write ~recover ls = + let check_fun ~write ~protection ls = let locks = Lockset.export_locks ls in let rw,w = if write then (Mutexes.bot (),locks) else (locks, Mutexes.bot ()) in - if recover then + if protection = Queries.Protection.Weak then (Mutexes.bot (), Mutexes.bot (), rw, w) else (rw, w, Mutexes.bot (), Mutexes.bot ()) @@ -138,24 +138,24 @@ struct in match q with | Queries.MayBePublic _ when Lockset.is_bot ctx.local -> false - | Queries.MayBePublic {global=v; write; recoverable} -> - let held_locks: GProtecting.t = check_fun ~write ~recover:recoverable (Lockset.filter snd ctx.local) in + | Queries.MayBePublic {global=v; write; protection} -> + let held_locks: GProtecting.t = check_fun ~write ~protection (Lockset.filter snd ctx.local) in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks ctx.local) then false else *) non_overlapping held_locks (G.protecting (ctx.global (V.protecting v))) | Queries.MayBePublicWithout _ when Lockset.is_bot ctx.local -> false - | Queries.MayBePublicWithout {global=v; write; without_mutex; recoverable} -> - let held_locks: GProtecting.t = check_fun ~write ~recover:recoverable (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in + | Queries.MayBePublicWithout {global=v; write; without_mutex; protection} -> + let held_locks: GProtecting.t = check_fun ~write ~protection (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks (Lockset.remove (without_mutex, true) ctx.local)) then false else *) non_overlapping held_locks (G.protecting (ctx.global (V.protecting v))) - | Queries.MustBeProtectedBy {mutex; global; write; recoverable} -> + | Queries.MustBeProtectedBy {mutex; global; write; protection} -> let mutex_lockset = Lockset.singleton (mutex, true) in - let held_locks: GProtecting.t = check_fun ~write ~recover:recoverable mutex_lockset in + let held_locks: GProtecting.t = check_fun ~write ~protection mutex_lockset in (* TODO: unsound in 29/24, why did we do this before? *) (* if LockDomain.Addr.equal mutex verifier_atomic then true diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 584d971d4d..7a6ea87019 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -34,10 +34,21 @@ module MustBool = BoolDomain.MustBool module Unit = Lattice.Unit +(** Different notions of protection for a global variables g by a mutex m + m protects g strongly if: + - whenever g is accessed after the program went multi-threaded for the first time, m is held + + m protects g weakly if: + - whenever g is accessed and there are any threads other than the main thread that are created but not joined yet, m is held +*) +module Protection = struct + type t = Strong | Weak [@@deriving ord, hash] +end + (* Helper definitions for deriving complex parts of Any.compare below. *) -type maybepublic = {global: CilType.Varinfo.t; write: bool; recoverable: bool} [@@deriving ord, hash] -type maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: PreValueDomain.Addr.t; recoverable: bool} [@@deriving ord, hash] -type mustbeprotectedby = {mutex: PreValueDomain.Addr.t; global: CilType.Varinfo.t; write: bool; recoverable: bool} [@@deriving ord, hash] +type maybepublic = {global: CilType.Varinfo.t; write: bool; protection: Protection.t} [@@deriving ord, hash] +type maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: PreValueDomain.Addr.t; protection: Protection.t} [@@deriving ord, hash] +type mustbeprotectedby = {mutex: PreValueDomain.Addr.t; global: CilType.Varinfo.t; write: bool; protection: Protection.t} [@@deriving ord, hash] type mustprotectedvars = {mutex: PreValueDomain.Addr.t; write: bool} [@@deriving ord, hash] type memory_access = {exp: CilType.Exp.t; var_opt: CilType.Varinfo.t option; kind: AccessKind.t} [@@deriving ord, hash] type access = From 951fcdcf8a4b91e8d69d59757423d68dbe654e56 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 13:05:25 +0200 Subject: [PATCH 294/518] Indentation --- src/analyses/mutexAnalysis.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 810a285a9b..ae1029b6b2 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -270,10 +270,10 @@ struct let protected = if write then (vs_empty, vs_empty, vs_empty, vs) - else - (vs_empty, vs_empty, vs, vs_empty) - in - ctx.sideg (V.protected addr) (G.create_protected protected) + else + (vs_empty, vs_empty, vs, vs_empty) + in + ctx.sideg (V.protected addr) (G.create_protected protected) ) held_recovery; ) | None -> M.info ~category:Unsound "Write to unknown address: privatization is unsound." From c246c884d9eb99dab3dee0a2592dff30d720c5d7 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 18:00:56 +0200 Subject: [PATCH 295/518] Rewrite --- src/analyses/mutexAnalysis.ml | 143 ++++++++++++++++------------------ src/domains/queries.ml | 8 +- 2 files changed, 72 insertions(+), 79 deletions(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 33806a6516..627193d237 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -8,6 +8,7 @@ module LF = LibraryFunctions open GoblintCil open Analyses open Batteries +open Queries.Protection module VarSet = SetDomain.Make (Basetype.Variables) @@ -34,33 +35,56 @@ struct | `Right _ -> true end - module MakeG (G0: Lattice.S) = - struct - module ReadWriteNoRecover = - struct - include G0 - let name () = "readwriteNoRecover" - end - module WriteNoRecover = - struct - include G0 - let name () = "writeNoRecover" - end - module ReadWriteRecover = + module MakeG (G0: Lattice.S) = struct + module ReadWrite = struct include G0 - let name () = "readwriteRecover" + let name () = "readwrite" end - module WriteRecover = + + module Write = struct include G0 - let name () = "writeRecover" + let name () = "write" end - include Lattice.Prod4 (ReadWriteNoRecover) (WriteNoRecover) (ReadWriteRecover) (WriteRecover) + + module P = Lattice.Prod (ReadWrite) (Write) + include Lattice.Prod (P) (P) + + let name () = "strong protection * weak protection" + + let get ~write protection (s,w) = + let (rw, w) = match protection with + | Strong -> s + | Weak -> w + in + if write then w else rw + end + + module GProtecting = struct + include MakeG (LockDomain.Simple) + + let make ~write ~recovered locks = + (* If the access is not a write, set to T so intersection with current write-protecting is identity *) + let wlocks = if write then locks else Mutexes.top () in + if recovered then + (* If we are in single-threaded mode again, this does not need to be added to set of mutexes protecting in mt-mode only *) + ((locks, wlocks), (Mutexes.top (), Mutexes.top ())) + else + ((locks, wlocks), (locks, wlocks)) + end + + module GProtected = struct + include MakeG (VarSet) + + let make ~write vs = + let vs_empty = VarSet.empty () in + if write then + ((vs_empty, vs), (vs_empty, vs)) + else + ((vs, vs_empty), (vs, vs_empty)) end - module GProtecting = MakeG (LockDomain.Simple) - module GProtected = MakeG (VarSet) module G = struct include Lattice.Lift2 (GProtecting) (GProtected) (Printable.DefaultNames) @@ -124,43 +148,36 @@ struct `Index (i_exp, conv_offset_inv o) let query ctx (type a) (q: a Queries.t): a Queries.result = - let check_fun ~write ~protection ls = - let locks = Lockset.export_locks ls in - let rw,w = if write then (Mutexes.bot (),locks) else (locks, Mutexes.bot ()) in - if protection = Queries.Protection.Weak then - (Mutexes.bot (), Mutexes.bot (), rw, w) - else - (rw, w, Mutexes.bot (), Mutexes.bot ()) - in - let non_overlapping locks1 locks2 = - let intersect = GProtecting.join locks1 locks2 in - GProtecting.is_top intersect - in + (* get the set of mutexes protecting the variable v in the given mode *) + let protecting ~write mode v = GProtecting.get ~write mode (G.protecting (ctx.global (V.protecting v))) in + let non_overlapping locks1 locks2 = Mutexes.is_empty @@ Mutexes.inter locks1 locks2 in match q with | Queries.MayBePublic _ when Lockset.is_bot ctx.local -> false | Queries.MayBePublic {global=v; write; protection} -> - let held_locks: GProtecting.t = check_fun ~write ~protection (Lockset.filter snd ctx.local) in + let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in + let protecting = protecting ~write protection v in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks ctx.local) then false else *) - non_overlapping held_locks (G.protecting (ctx.global (V.protecting v))) + non_overlapping held_locks protecting | Queries.MayBePublicWithout _ when Lockset.is_bot ctx.local -> false | Queries.MayBePublicWithout {global=v; write; without_mutex; protection} -> - let held_locks: GProtecting.t = check_fun ~write ~protection (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in + let held_locks = Lockset.export_locks (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in + let protecting = protecting ~write protection v in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks (Lockset.remove (without_mutex, true) ctx.local)) then false else *) - non_overlapping held_locks (G.protecting (ctx.global (V.protecting v))) - | Queries.MustBeProtectedBy {mutex; global; write; protection} -> - let mutex_lockset = Lockset.singleton (mutex, true) in - let held_locks: GProtecting.t = check_fun ~write ~protection mutex_lockset in + non_overlapping held_locks protecting + | Queries.MustBeProtectedBy {mutex; global=v; write; protection} -> + let mutex_lockset = Lockset.export_locks @@ Lockset.singleton (mutex, true) in + let protecting = protecting ~write protection v in (* TODO: unsound in 29/24, why did we do this before? *) (* if LockDomain.Addr.equal mutex verifier_atomic then true else *) - GProtecting.leq (G.protecting (ctx.global (V.protecting global))) held_locks + Mutexes.leq mutex_lockset protecting | Queries.MustLockset -> let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in let ls = Mutexes.fold (fun addr ls -> @@ -174,7 +191,7 @@ struct let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in Mutexes.mem (LockDomain.Addr.from_var LF.verifier_atomic_var) held_locks | Queries.MustProtectedVars {mutex = m; write} -> - let protected = (if write then Tuple4.second else Tuple4.first) (G.protected (ctx.global (V.protected m))) in + let protected = GProtecting.get ~write Strong (G.protected (ctx.global (V.protected m))) in VarSet.fold (fun v acc -> Queries.LS.add (v, `NoOffset) acc ) protected (Queries.LS.empty ()) @@ -185,13 +202,13 @@ struct begin match g with | `Left g' -> (* protecting *) if GobConfig.get_bool "dbg.print_protection" then ( - let (protecting, _, _, _) = G.protecting (ctx.global g) in (* readwrite protecting *) + let protecting = GProtecting.get ~write:false Strong (G.protecting (ctx.global g)) in (* readwrite protecting *) let s = Mutexes.cardinal protecting in M.info_noloc ~category:Race "Variable %a read-write protected by %d mutex(es): %a" CilType.Varinfo.pretty g' s Mutexes.pretty protecting ) | `Right m -> (* protected *) if GobConfig.get_bool "dbg.print_protection" then ( - let (protected, _, _ ,_) = G.protected (ctx.global g) in (* readwrite protected *) + let protected = GProtecting.get ~write:false Strong (G.protected (ctx.global g)) in (* readwrite protected *) let s = VarSet.cardinal protected in max_protected := max !max_protected s; sum_protected := !sum_protected + s; @@ -238,43 +255,19 @@ struct | Read -> false | Spawn -> false (* TODO: nonsense? *) in - (* If the access is not a write, set to T so intersection with current write-protecting is identity *) - let wlocks = if write then locks else Mutexes.top () in - let el = - if is_recovered_to_st then - (* If we are in single-threaded mode again, this does not need to be added to set of mutexes protecting in mt-mode only *) - (locks, wlocks, Mutexes.top (), Mutexes.top ()) - else - (locks, wlocks, locks, wlocks) - in - ctx.sideg (V.protecting v) (G.create_protecting el); + let s = GProtecting.make ~write ~recovered:is_recovered_to_st locks in + ctx.sideg (V.protecting v) (G.create_protecting s); if !AnalysisState.postsolving then ( - let protecting = G.protecting (ctx.global (V.protecting v)) in - let vs_empty = VarSet.empty () in + let protecting mode = GProtecting.get ~write mode (G.protecting (ctx.global (V.protecting v))) in + let held_strong = protecting Strong in + let held_weak = protecting Weak in let vs = VarSet.singleton v in - let held_norecovery = (if write then Tuple4.second else Tuple4.first) protecting in - let held_recovery = (if write then Tuple4.fourth else Tuple4.third) protecting in - Mutexes.iter (fun addr -> - let protected = - if write then - (vs_empty, vs, vs_empty, vs) - else - (vs, vs_empty, vs, vs_empty) - in - ctx.sideg (V.protected addr) (G.create_protected protected) - ) held_norecovery; + let protected = G.create_protected @@ GProtected.make ~write vs in + Mutexes.iter (fun addr -> ctx.sideg (V.protected addr) protected) held_strong; (* If the mutex set here is top, it is actually not accessed *) - if is_recovered_to_st && not @@ Mutexes.is_top held_recovery then - Mutexes.iter (fun addr -> - let protected = - if write then - (vs_empty, vs_empty, vs_empty, vs) - else - (vs_empty, vs_empty, vs, vs_empty) - in - ctx.sideg (V.protected addr) (G.create_protected protected) - ) held_recovery; + if is_recovered_to_st && not @@ Mutexes.is_top held_weak then + Mutexes.iter (fun addr -> ctx.sideg (V.protected addr) protected) held_weak; ) | None -> M.info ~category:Unsound "Write to unknown address: privatization is unsound." in diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 1a6f9c64bf..f3e9655fa6 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -42,13 +42,13 @@ module Unit = Lattice.Unit - whenever g is accessed and there are any threads other than the main thread that are created but not joined yet, m is held *) module Protection = struct - type t = Strong | Weak [@@deriving ord, hash] + type protection = Strong | Weak [@@deriving ord, hash] end (* Helper definitions for deriving complex parts of Any.compare below. *) -type maybepublic = {global: CilType.Varinfo.t; write: bool; protection: Protection.t} [@@deriving ord, hash] -type maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: PreValueDomain.Addr.t; protection: Protection.t} [@@deriving ord, hash] -type mustbeprotectedby = {mutex: PreValueDomain.Addr.t; global: CilType.Varinfo.t; write: bool; protection: Protection.t} [@@deriving ord, hash] +type maybepublic = {global: CilType.Varinfo.t; write: bool; protection: Protection.protection} [@@deriving ord, hash] +type maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: PreValueDomain.Addr.t; protection: Protection.protection} [@@deriving ord, hash] +type mustbeprotectedby = {mutex: PreValueDomain.Addr.t; global: CilType.Varinfo.t; write: bool; protection: Protection.protection} [@@deriving ord, hash] type mustprotectedvars = {mutex: PreValueDomain.Addr.t; write: bool} [@@deriving ord, hash] type memory_access = {exp: CilType.Exp.t; var_opt: CilType.Varinfo.t option; kind: AccessKind.t} [@@deriving ord, hash] type access = From 0b11e6d5bd49563df603c09f5e2a2ad8a1e40049 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 26 May 2023 18:36:48 +0200 Subject: [PATCH 296/518] Give signatures to expose less internal stuff --- src/analyses/mutexAnalysis.ml | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 627193d237..7f475147e2 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -35,7 +35,7 @@ struct | `Right _ -> true end - module MakeG (G0: Lattice.S) = struct + module MakeP (G0: Lattice.S) = struct module ReadWrite = struct include G0 @@ -61,8 +61,13 @@ struct if write then w else rw end - module GProtecting = struct - include MakeG (LockDomain.Simple) + (** Collects information about which variables are protected by which mutexes *) + module GProtecting: sig + include Lattice.S + val make: write:bool -> recovered:bool -> Mutexes.t -> t + val get: write:bool -> protection -> t -> Mutexes.t + end = struct + include MakeP (LockDomain.Simple) let make ~write ~recovered locks = (* If the access is not a write, set to T so intersection with current write-protecting is identity *) @@ -74,8 +79,14 @@ struct ((locks, wlocks), (locks, wlocks)) end - module GProtected = struct - include MakeG (VarSet) + + (** Collects information about which mutex protects which variable *) + module GProtected: sig + include Lattice.S + val make: write:bool -> VarSet.t -> t + val get: write:bool -> protection -> t -> VarSet.t + end = struct + include MakeP (VarSet) let make ~write vs = let vs_empty = VarSet.empty () in @@ -191,7 +202,7 @@ struct let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in Mutexes.mem (LockDomain.Addr.from_var LF.verifier_atomic_var) held_locks | Queries.MustProtectedVars {mutex = m; write} -> - let protected = GProtecting.get ~write Strong (G.protected (ctx.global (V.protected m))) in + let protected = GProtected.get ~write Strong (G.protected (ctx.global (V.protected m))) in VarSet.fold (fun v acc -> Queries.LS.add (v, `NoOffset) acc ) protected (Queries.LS.empty ()) @@ -208,7 +219,7 @@ struct ) | `Right m -> (* protected *) if GobConfig.get_bool "dbg.print_protection" then ( - let protected = GProtecting.get ~write:false Strong (G.protected (ctx.global g)) in (* readwrite protected *) + let protected = GProtected.get ~write:false Strong (G.protected (ctx.global g)) in (* readwrite protected *) let s = VarSet.cardinal protected in max_protected := max !max_protected s; sum_protected := !sum_protected + s; From 5095d2b38ba919ee1cdf9bed975162f8a799d0c6 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Sat, 27 May 2023 14:13:42 +0200 Subject: [PATCH 297/518] Use Z.minus_one in string_comparison --- src/cdomains/addressDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 82ff0fa59d..c6c2a56767 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -159,7 +159,7 @@ struct else if res > 0 then Idx.starting IInt Z.one else - Idx.ending IInt (Z.neg (Z.one)) in + Idx.ending IInt Z.minus_one in (* if any of the input address sets contains an element that isn't a StrPtr, return top *) if List.mem None x' || List.mem None y' then From 441fec222a66596d8129a4a457425fdb9f45bfed Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 29 May 2023 04:17:17 +0200 Subject: [PATCH 298/518] ctx.local instead of bottom in wrapper function threadenter --- src/analyses/wrapperFunctionAnalysis.ml | 4 ++-- src/analyses/wrapperFunctionAnalysis0.ml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index ab3724eac0..04f6344459 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -83,8 +83,8 @@ struct let startstate v = D.bot () let threadenter ctx lval f args = - (* The new thread receives a fresh counter *) - [D.bot ()] + (* The new thread receives the same wrapper node and counter *) + [ctx.local] let exitstate v = D.top () diff --git a/src/analyses/wrapperFunctionAnalysis0.ml b/src/analyses/wrapperFunctionAnalysis0.ml index bdc01d898c..9ea9c0c9aa 100644 --- a/src/analyses/wrapperFunctionAnalysis0.ml +++ b/src/analyses/wrapperFunctionAnalysis0.ml @@ -1,4 +1,4 @@ -(** Part of the wrapper function analysis. Seperate out the modules for counting +(** Part of the wrapper function analysis. Separate out the modules for counting unique calls: Chain alone is a functor, yet we need the resulting module to define queries over it. Since the wrapper function analysis also references those queries, we would have a circular dependency otherwise. *) From ca381af1a09be1007f71ac4a5d93c92cfd6e7c1c Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 29 May 2023 04:44:21 +0200 Subject: [PATCH 299/518] add back adapted synopsis --- src/analyses/wrapperFunctionAnalysis.ml | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 04f6344459..1e6f2525b8 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -1,6 +1,11 @@ -(** An analysis that handles the case when an interesting function is called - from a wrapper function all over the code. Currently handles the [malloc]- - family of memory allocation functions, as well as [pthread_create] *) +(** Family of analyses which provide symbolic locations for special library functions. + Provides symbolic heap locations for dynamic memory allocations and symbolic thread + identifiers for thread creation ([mallocWrapper], [threadCreateWrapper]). + + Provided heap locations are based on the node and thread ID. + Provided thread identifiers are based solely the node. + Considers wrapper functions and a number of unique heap locations + or thread identifiers for additional precision. *) open GoblintCil open Analyses From ab3b027c46130889c3302d7952ad396e169d0b62 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 29 May 2023 14:07:33 +0200 Subject: [PATCH 300/518] Revert "ctx.local instead of bottom in wrapper function threadenter" This partially reverts commit 441fec222a66596d8129a4a457425fdb9f45bfed. --- src/analyses/wrapperFunctionAnalysis.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 1e6f2525b8..d9bbdb6197 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -88,8 +88,8 @@ struct let startstate v = D.bot () let threadenter ctx lval f args = - (* The new thread receives the same wrapper node and counter *) - [ctx.local] + (* The new thread receives a fresh counter *) + [D.bot ()] let exitstate v = D.top () From bc36eee134401642051c6b30bd2bfaff2a2cf642 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 29 May 2023 18:30:44 +0200 Subject: [PATCH 301/518] include wrapper node that created thread in ThreadId domain --- src/analyses/threadId.ml | 37 +++++++++++++++++++++++-------------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index 161f7f39a5..bde8caa438 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -17,30 +17,38 @@ let get_current_unlift ask: Thread.t = | `Lifted thread -> thread | _ -> failwith "ThreadId.get_current_unlift" +module VNI = + Printable.Prod3 + (CilType.Varinfo) + (Node) + (Printable.Option + (WrapperFunctionAnalysis0.ThreadCreateUniqueCount) + (struct let name = "no index" end)) module Spec = struct include Analyses.IdentitySpec + module N = Lattice.Flat (VNI) (struct let bot_name = "unknown node" let top_name = "unknown node" end) module TD = Thread.D - module D = Lattice.Prod (ThreadLifted) (TD) + module D = Lattice.Prod3 (N) (ThreadLifted) (TD) module C = D let tids = ref (Hashtbl.create 20) let name () = "threadid" - let startstate v = (ThreadLifted.bot (), TD.bot ()) - let exitstate v = (`Lifted (Thread.threadinit v ~multiple:false), TD.bot ()) + let startstate v = (N.bot (), ThreadLifted.bot (), TD.bot ()) + let exitstate v = (N.bot (), `Lifted (Thread.threadinit v ~multiple:false), TD.bot ()) let morphstate v _ = let tid = Thread.threadinit v ~multiple:false in if GobConfig.get_bool "dbg.print_tids" then Hashtbl.replace !tids tid (); - (`Lifted (tid), TD.bot ()) + (N.bot (), `Lifted (tid), TD.bot ()) - let create_tid (current, td) ((node, index): Node.t * int option) v = + let create_tid (_, current, td) ((node, index): Node.t * int option) v = match current with | `Lifted current -> let+ tid = Thread.threadenter (current, td) node index v in @@ -53,17 +61,17 @@ struct let is_unique ctx = ctx.ask Queries.MustBeUniqueThread - let created (current, td) = + let created (_, current, td) = match current with | `Lifted current -> BatOption.map_default (ConcDomain.ThreadSet.of_list) (ConcDomain.ThreadSet.top ()) (Thread.created current td) | _ -> ConcDomain.ThreadSet.top () let query (ctx: (D.t, _, _, _) ctx) (type a) (x: a Queries.t): a Queries.result = match x with - | Queries.CurrentThreadId -> fst ctx.local + | Queries.CurrentThreadId -> Tuple3.second ctx.local | Queries.CreatedThreads -> created ctx.local | Queries.MustBeUniqueThread -> - begin match fst ctx.local with + begin match Tuple3.second ctx.local with | `Lifted tid -> Thread.is_unique tid | _ -> Queries.MustBool.top () end @@ -81,7 +89,7 @@ struct let access ctx _ = if is_unique ctx then - let tid = fst ctx.local in + let tid = Tuple3.second ctx.local in Some tid else None @@ -94,13 +102,14 @@ struct | (`Bot | `Top), _ -> ctx.prev_node, None let threadenter ctx lval f args = - let+ tid = create_tid ctx.local (indexed_node_for_ctx ctx) f in - (tid, TD.bot ()) + let n, i = indexed_node_for_ctx ctx in + let+ tid = create_tid ctx.local (n, i) f in + (`Lifted (f, n, i), tid, TD.bot ()) let threadspawn ctx lval f args fctx = - let (current, td) = ctx.local in - let node, index = indexed_node_for_ctx fctx in - (current, Thread.threadspawn td node index f) + let (current_n, current, td) = ctx.local in + let v, n, i = match fctx.local with `Lifted vni, _, _ -> vni | _ -> failwith "ThreadId.threadspawn" in + (current_n, current, Thread.threadspawn td n i v) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) let init (m:marshal option): unit = From 24aad8bbbf89568920bbf8fd73fd04b0c8bb2eb7 Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Mon, 29 May 2023 18:31:54 +0200 Subject: [PATCH 302/518] format --- src/analyses/threadId.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index bde8caa438..e0f3611707 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -20,8 +20,8 @@ let get_current_unlift ask: Thread.t = module VNI = Printable.Prod3 (CilType.Varinfo) - (Node) - (Printable.Option + (Node) ( + Printable.Option (WrapperFunctionAnalysis0.ThreadCreateUniqueCount) (struct let name = "no index" end)) From 08559692182bf4254a9e79b2ac483526b8ffde1e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 29 May 2023 21:02:09 +0300 Subject: [PATCH 303/518] Rename Queries.Protection.protection back to t --- src/analyses/mutexAnalysis.ml | 7 +++---- src/domains/queries.ml | 8 ++++---- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 7f475147e2..0ad8fa5770 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -8,7 +8,6 @@ module LF = LibraryFunctions open GoblintCil open Analyses open Batteries -open Queries.Protection module VarSet = SetDomain.Make (Basetype.Variables) @@ -55,7 +54,7 @@ struct let get ~write protection (s,w) = let (rw, w) = match protection with - | Strong -> s + | Queries.Protection.Strong -> s | Weak -> w in if write then w else rw @@ -65,7 +64,7 @@ struct module GProtecting: sig include Lattice.S val make: write:bool -> recovered:bool -> Mutexes.t -> t - val get: write:bool -> protection -> t -> Mutexes.t + val get: write:bool -> Queries.Protection.t -> t -> Mutexes.t end = struct include MakeP (LockDomain.Simple) @@ -84,7 +83,7 @@ struct module GProtected: sig include Lattice.S val make: write:bool -> VarSet.t -> t - val get: write:bool -> protection -> t -> VarSet.t + val get: write:bool -> Queries.Protection.t -> t -> VarSet.t end = struct include MakeP (VarSet) diff --git a/src/domains/queries.ml b/src/domains/queries.ml index f3e9655fa6..1a6f9c64bf 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -42,13 +42,13 @@ module Unit = Lattice.Unit - whenever g is accessed and there are any threads other than the main thread that are created but not joined yet, m is held *) module Protection = struct - type protection = Strong | Weak [@@deriving ord, hash] + type t = Strong | Weak [@@deriving ord, hash] end (* Helper definitions for deriving complex parts of Any.compare below. *) -type maybepublic = {global: CilType.Varinfo.t; write: bool; protection: Protection.protection} [@@deriving ord, hash] -type maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: PreValueDomain.Addr.t; protection: Protection.protection} [@@deriving ord, hash] -type mustbeprotectedby = {mutex: PreValueDomain.Addr.t; global: CilType.Varinfo.t; write: bool; protection: Protection.protection} [@@deriving ord, hash] +type maybepublic = {global: CilType.Varinfo.t; write: bool; protection: Protection.t} [@@deriving ord, hash] +type maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: PreValueDomain.Addr.t; protection: Protection.t} [@@deriving ord, hash] +type mustbeprotectedby = {mutex: PreValueDomain.Addr.t; global: CilType.Varinfo.t; write: bool; protection: Protection.t} [@@deriving ord, hash] type mustprotectedvars = {mutex: PreValueDomain.Addr.t; write: bool} [@@deriving ord, hash] type memory_access = {exp: CilType.Exp.t; var_opt: CilType.Varinfo.t option; kind: AccessKind.t} [@@deriving ord, hash] type access = From 11b083c4f7bbfeaaa38ce6c7cf5cfd2496995fc1 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 30 May 2023 10:00:29 +0200 Subject: [PATCH 304/518] Fix indent (#1049) --- src/analyses/mutexAnalysis.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 4d517ad104..6b063067c0 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -40,7 +40,7 @@ struct include G0 let name () = "readwrite" end - + module Write = struct include G0 From 3ad512a796ee7d2913c04e35641bdf6bf33ebc6c Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 30 May 2023 10:11:46 +0200 Subject: [PATCH 305/518] Rm unneeded TODO --- tests/regression/58-base-mm-tid/25-phases-intricate-sound.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/58-base-mm-tid/25-phases-intricate-sound.c b/tests/regression/58-base-mm-tid/25-phases-intricate-sound.c index 8b4d3cdcb2..cedb1d7c47 100644 --- a/tests/regression/58-base-mm-tid/25-phases-intricate-sound.c +++ b/tests/regression/58-base-mm-tid/25-phases-intricate-sound.c @@ -11,7 +11,7 @@ void *t_benign(void *arg) { pthread_mutex_lock(&A); pthread_mutex_lock(&B); g = 10; - __goblint_check(g == 10); //TODO + __goblint_check(g == 10); pthread_mutex_unlock(&B); pthread_mutex_unlock(&A); return NULL; @@ -21,7 +21,7 @@ void *t_benign2(void *arg) { pthread_mutex_lock(&A); pthread_mutex_lock(&B); g = 10; - __goblint_check(g == 10); //TODO + __goblint_check(g == 10); pthread_mutex_unlock(&B); pthread_mutex_unlock(&A); return NULL; From 7eed44db94409ec4e974292d2177d3e9fd75561c Mon Sep 17 00:00:00 2001 From: Max Lang <17551908+just-max@users.noreply.github.com> Date: Tue, 30 May 2023 11:07:48 +0200 Subject: [PATCH 306/518] 71-thread_create_wrapper -> 72-thread_create_wrapper --- .../01-wrapper.c | 0 .../02-unique-counter.c | 0 .../03-wrapper-unique-counter.c | 0 .../04-unique-counter-id-count-0.c | 0 .../05-wrapper-unique-counter-id-count-0.c | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename tests/regression/{71-thread_create_wrapper => 72-thread_create_wrapper}/01-wrapper.c (100%) rename tests/regression/{71-thread_create_wrapper => 72-thread_create_wrapper}/02-unique-counter.c (100%) rename tests/regression/{71-thread_create_wrapper => 72-thread_create_wrapper}/03-wrapper-unique-counter.c (100%) rename tests/regression/{71-thread_create_wrapper => 72-thread_create_wrapper}/04-unique-counter-id-count-0.c (100%) rename tests/regression/{71-thread_create_wrapper => 72-thread_create_wrapper}/05-wrapper-unique-counter-id-count-0.c (100%) diff --git a/tests/regression/71-thread_create_wrapper/01-wrapper.c b/tests/regression/72-thread_create_wrapper/01-wrapper.c similarity index 100% rename from tests/regression/71-thread_create_wrapper/01-wrapper.c rename to tests/regression/72-thread_create_wrapper/01-wrapper.c diff --git a/tests/regression/71-thread_create_wrapper/02-unique-counter.c b/tests/regression/72-thread_create_wrapper/02-unique-counter.c similarity index 100% rename from tests/regression/71-thread_create_wrapper/02-unique-counter.c rename to tests/regression/72-thread_create_wrapper/02-unique-counter.c diff --git a/tests/regression/71-thread_create_wrapper/03-wrapper-unique-counter.c b/tests/regression/72-thread_create_wrapper/03-wrapper-unique-counter.c similarity index 100% rename from tests/regression/71-thread_create_wrapper/03-wrapper-unique-counter.c rename to tests/regression/72-thread_create_wrapper/03-wrapper-unique-counter.c diff --git a/tests/regression/71-thread_create_wrapper/04-unique-counter-id-count-0.c b/tests/regression/72-thread_create_wrapper/04-unique-counter-id-count-0.c similarity index 100% rename from tests/regression/71-thread_create_wrapper/04-unique-counter-id-count-0.c rename to tests/regression/72-thread_create_wrapper/04-unique-counter-id-count-0.c diff --git a/tests/regression/71-thread_create_wrapper/05-wrapper-unique-counter-id-count-0.c b/tests/regression/72-thread_create_wrapper/05-wrapper-unique-counter-id-count-0.c similarity index 100% rename from tests/regression/71-thread_create_wrapper/05-wrapper-unique-counter-id-count-0.c rename to tests/regression/72-thread_create_wrapper/05-wrapper-unique-counter-id-count-0.c From ab903e1d756e54ea9fb72ceae8b4b5d5c7dff7da Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 13:43:03 +0300 Subject: [PATCH 307/518] Extract Offset module --- src/analyses/base.ml | 4 +- src/analyses/mutexAnalysis.ml | 4 +- src/analyses/region.ml | 2 +- src/cdomains/arrayDomain.ml | 14 ++-- src/cdomains/lval.ml | 127 ++-------------------------------- src/cdomains/offset.ml | 119 +++++++++++++++++++++++++++++++ src/cdomains/valueDomain.ml | 2 +- src/framework/cfgTools.ml | 2 +- 8 files changed, 140 insertions(+), 134 deletions(-) create mode 100644 src/cdomains/offset.ml diff --git a/src/analyses/base.ml b/src/analyses/base.ml index d28d3765e1..86ba46bb02 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -625,7 +625,7 @@ struct let toInt i = match IdxDom.to_int @@ ID.cast_to ik i with | Some x -> Const (CInt (x,ik, None)) - | _ -> Lval.any_index_exp + | _ -> Offset.any_index_exp in match o with | `NoOffset -> `NoOffset @@ -1049,7 +1049,7 @@ struct match ofs with | NoOffset -> `NoOffset | Field (fld, ofs) -> `Field (fld, convert_offset a gs st ofs) - | Index (exp, ofs) when CilType.Exp.equal exp Lval.any_index_exp -> (* special offset added by convertToQueryLval *) + | Index (exp, ofs) when CilType.Exp.equal exp Offset.any_index_exp -> (* special offset added by convertToQueryLval *) `Index (IdxDom.top (), convert_offset a gs st ofs) | Index (exp, ofs) -> match eval_rv a gs st exp with diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 6b063067c0..e1db358ead 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -40,7 +40,7 @@ struct include G0 let name () = "readwrite" end - + module Write = struct include G0 @@ -155,7 +155,7 @@ struct let i_exp = match ValueDomain.IndexDomain.to_int i with | Some i -> Const (CInt (i, Cilfacade.ptrdiff_ikind (), Some (Z.to_string i))) - | None -> Lval.any_index_exp + | None -> Offset.any_index_exp in `Index (i_exp, conv_offset_inv o) diff --git a/src/analyses/region.ml b/src/analyses/region.ml index 33bef7e014..c4c9f7bec1 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -85,7 +85,7 @@ struct let rec unknown_index = function | `NoOffset -> `NoOffset | `Field (f, os) -> `Field (f, unknown_index os) - | `Index (i, os) -> `Index (Lval.any_index_exp, unknown_index os) (* forget specific indices *) + | `Index (i, os) -> `Index (Offset.any_index_exp, unknown_index os) (* forget specific indices *) in Option.map (Lvals.of_list % List.map (Tuple2.map2 unknown_index)) (get_region ctx e) diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index c93cd68915..2aac3ea8e1 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -88,7 +88,7 @@ struct let get ?(checkBounds=true) (ask: VDQ.t) a i = a let set (ask: VDQ.t) a (ie, i) v = match ie with - | Some ie when CilType.Exp.equal ie Lval.all_index_exp -> + | Some ie when CilType.Exp.equal ie Offset.all_index_exp -> v | _ -> join a v @@ -111,7 +111,7 @@ struct match offset with (* invariants for all indices *) | NoOffset when get_bool "witness.invariant.goblint" -> - let i_lval = Cil.addOffsetLval (Index (Lval.all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Offset.all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval x | NoOffset -> Invariant.none @@ -193,7 +193,7 @@ struct else ((update_unrolled_values min_i (Z.of_int ((factor ())-1))), (Val.join xr v)) let set ask (xl, xr) (ie, i) v = match ie with - | Some ie when CilType.Exp.equal ie Lval.all_index_exp -> + | Some ie when CilType.Exp.equal ie Offset.all_index_exp -> (* TODO: Doesn't seem to work for unassume because unrolled elements are top-initialized, not bot-initialized. *) (BatList.make (factor ()) v, v) | _ -> @@ -226,7 +226,7 @@ struct if Val.is_bot xr then Invariant.top () else if get_bool "witness.invariant.goblint" then ( - let i_lval = Cil.addOffsetLval (Index (Lval.all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Offset.all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) ) else @@ -481,10 +481,10 @@ struct let set_with_length length (ask:VDQ.t) x (i,_) a = if M.tracing then M.trace "update_offset" "part array set_with_length %a %s %a\n" pretty x (BatOption.map_default Basetype.CilExp.show "None" i) Val.pretty a; match i with - | Some ie when CilType.Exp.equal ie Lval.all_index_exp -> + | Some ie when CilType.Exp.equal ie Offset.all_index_exp -> (* TODO: Doesn't seem to work for unassume. *) Joint a - | Some i when CilType.Exp.equal i Lval.any_index_exp -> + | Some i when CilType.Exp.equal i Offset.any_index_exp -> (assert !AnalysisState.global_initialization; (* just joining with xm here assumes that all values will be set, which is guaranteed during inits *) (* the join is needed here! see e.g 30/04 *) let o = match x with Partitioned (_, (_, xm, _)) -> xm | Joint v -> v in @@ -765,7 +765,7 @@ struct match offset with (* invariants for all indices *) | NoOffset when get_bool "witness.invariant.goblint" -> - let i_lval = Cil.addOffsetLval (Index (Lval.all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Offset.all_index_exp, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) | NoOffset -> Invariant.none diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 656797a3b8..540384dca2 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -1,129 +1,16 @@ -(** Domains for offsets and lvalues. *) +(** Domains for lvalues. *) open GoblintCil open Pretty module M = Messages -(** Special index expression for some unknown index. - Weakly updates array in assignment. - Used for exp.fast_global_inits. *) -let any_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") +type ('f, 'i) offs = 'i Offset.t [@@deriving eq, ord, hash] -(** Special index expression for all indices. - Strongly updates array in assignment. - Used for Goblint-specific witness invariants. *) -let all_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") - - -type ('a, 'b) offs = [ - | `NoOffset - | `Field of 'a * ('a,'b) offs - | `Index of 'b * ('a,'b) offs -] [@@deriving eq, ord, hash] - - -(** Subinterface of IntDomain.Z which is sufficient for Printable (but not Lattice) Offset. *) -module type IdxPrintable = -sig - include Printable.S - val equal_to: IntOps.BigIntOps.t -> t -> [`Eq | `Neq | `Top] - val to_int: t -> IntOps.BigIntOps.t option -end - -module Offset (Idx: IdxPrintable) = -struct - type t = (CilType.Fieldinfo.t, Idx.t) offs [@@deriving eq, ord, hash] - include Printable.StdLeaf - - let name () = "offset" - - let is_first_field x = match x.fcomp.cfields with - | [] -> false - | f :: _ -> CilType.Fieldinfo.equal f x - - let rec cmp_zero_offset : t -> [`MustZero | `MustNonzero | `MayZero] = function - | `NoOffset -> `MustZero - | `Index (x, o) -> (match cmp_zero_offset o, Idx.equal_to (IntOps.BigIntOps.zero) x with - | `MustNonzero, _ - | _, `Neq -> `MustNonzero - | `MustZero, `Eq -> `MustZero - | _, _ -> `MayZero) - | `Field (x, o) -> - if is_first_field x then cmp_zero_offset o else `MustNonzero - - let rec show = function - | `NoOffset -> "" - | `Index (x,o) -> "[" ^ (Idx.show x) ^ "]" ^ (show o) - | `Field (x,o) -> "." ^ (x.fname) ^ (show o) - - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - - let pretty_diff () (x,y) = - dprintf "%s: %a not leq %a" (name ()) pretty x pretty y - - let name () = "Offset" - - let from_offset x = x - - let rec is_definite = function - | `NoOffset -> true - | `Field (f,o) -> is_definite o - | `Index (i,o) -> Idx.to_int i <> None && is_definite o - - (* append offset o2 to o1 *) - (* TODO: unused *) - let rec add_offset o1 o2 = - match o1 with - | `NoOffset -> o2 - | `Field (f1,o1) -> `Field (f1,add_offset o1 o2) - | `Index (i1,o1) -> `Index (i1,add_offset o1 o2) - - let rec to_cil_offset (x:t) = - match x with - | `NoOffset -> NoOffset - | `Field(f,o) -> Field(f, to_cil_offset o) - | `Index(i,o) -> NoOffset (* array domain can not deal with this -> leads to being handeled as access to unknown part *) -end - -module OffsetLat (Idx: IntDomain.Z) = -struct - include Offset (Idx) - - let rec leq x y = - match x, y with - | `NoOffset, `NoOffset -> true - | `Index (i1,o1), `Index (i2,o2) when Idx.leq i1 i2 -> leq o1 o2 - | `Field (f1,o1), `Field (f2,o2) when CilType.Fieldinfo.equal f1 f2 -> leq o1 o2 - | _ -> false - - let rec merge cop x y = - let op = match cop with `Join -> Idx.join | `Meet -> Idx.meet | `Widen -> Idx.widen | `Narrow -> Idx.narrow in - match x, y with - | `NoOffset, `NoOffset -> `NoOffset - | `Field (x1,y1), `Field (x2,y2) when CilType.Fieldinfo.equal x1 x2 -> `Field (x1, merge cop y1 y2) - | `Index (x1,y1), `Index (x2,y2) -> `Index (op x1 x2, merge cop y1 y2) - | _ -> raise Lattice.Uncomparable (* special case not used for AddressDomain any more due to splitting *) - - let join x y = merge `Join x y - let meet x y = merge `Meet x y - let widen x y = merge `Widen x y - let narrow x y = merge `Narrow x y - - let rec drop_ints = function - | `Index (x, o) -> `Index (Idx.top (), drop_ints o) - | `Field (x, o) -> `Field (x, drop_ints o) - | `NoOffset -> `NoOffset -end module OffsetLatWithSemanticEqual (Idx: IntDomain.Z) = struct - include OffsetLat (Idx) + include Offset.MakeLattice (Idx) let ikind () = Cilfacade.ptrdiff_ikind () @@ -232,11 +119,11 @@ struct ) end -module Normal (Idx: IdxPrintable) = +module Normal (Idx: Offset.IdxPrintable) = struct type field = fieldinfo type idx = Idx.t - module Offs = Offset (Idx) + module Offs = Offset.MakePrintable (Idx) include PreNormal (Offs) let name () = "Normal Lvals" @@ -601,7 +488,7 @@ struct match o with | `NoOffset -> a | `Field (f,o) -> short_offs o (a^"."^f.fname) - | `Index (e,o) when CilType.Exp.equal e any_index_exp -> short_offs o (a^"[?]") + | `Index (e,o) when CilType.Exp.equal e Offset.any_index_exp -> short_offs o (a^"[?]") | `Index (e,o) -> short_offs o (a^"["^CilType.Exp.show e^"]") let rec of_ciloffs x = @@ -638,7 +525,7 @@ end module OffsetNoIdx = struct include NoIdxOffsetBase - include Offset(UnitIdxDomain) + include Offset.MakePrintable (UnitIdxDomain) let name () = "offset without index" end diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml new file mode 100644 index 0000000000..979fafb953 --- /dev/null +++ b/src/cdomains/offset.ml @@ -0,0 +1,119 @@ +(** Domains for offsets. *) + +open GoblintCil + +(** Special index expression for some unknown index. + Weakly updates array in assignment. + Used for exp.fast_global_inits. *) +let any_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") + +(** Special index expression for all indices. + Strongly updates array in assignment. + Used for Goblint-specific witness invariants. *) +let all_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") + +type 'i t = [ + | `NoOffset + | `Field of CilType.Fieldinfo.t * 'i t + | `Index of 'i * 'i t +] [@@deriving eq, ord, hash] + +type 'i offs = 'i t [@@deriving eq, ord, hash] + +(** Subinterface of IntDomain.Z which is sufficient for Printable (but not Lattice) Offset. *) +module type IdxPrintable = +sig + include Printable.S + val equal_to: IntOps.BigIntOps.t -> t -> [`Eq | `Neq | `Top] + val to_int: t -> IntOps.BigIntOps.t option +end + +module MakePrintable (Idx: IdxPrintable) = +struct + type t = Idx.t offs [@@deriving eq, ord, hash] + include Printable.StdLeaf + + let name () = "offset" + + let is_first_field x = match x.fcomp.cfields with + | [] -> false + | f :: _ -> CilType.Fieldinfo.equal f x + + let rec cmp_zero_offset : t -> [`MustZero | `MustNonzero | `MayZero] = function + | `NoOffset -> `MustZero + | `Index (x, o) -> (match cmp_zero_offset o, Idx.equal_to (IntOps.BigIntOps.zero) x with + | `MustNonzero, _ + | _, `Neq -> `MustNonzero + | `MustZero, `Eq -> `MustZero + | _, _ -> `MayZero) + | `Field (x, o) -> + if is_first_field x then cmp_zero_offset o else `MustNonzero + + let rec show = function + | `NoOffset -> "" + | `Index (x,o) -> "[" ^ (Idx.show x) ^ "]" ^ (show o) + | `Field (x,o) -> "." ^ (x.fname) ^ (show o) + + include Printable.SimpleShow ( + struct + type nonrec t = t + let show = show + end + ) + + let pretty_diff () (x,y) = + Pretty.dprintf "%s: %a not leq %a" (name ()) pretty x pretty y + + let name () = "Offset" + + let from_offset x = x + + let rec is_definite = function + | `NoOffset -> true + | `Field (f,o) -> is_definite o + | `Index (i,o) -> Idx.to_int i <> None && is_definite o + + (* append offset o2 to o1 *) + (* TODO: unused *) + let rec add_offset o1 o2 = + match o1 with + | `NoOffset -> o2 + | `Field (f1,o1) -> `Field (f1,add_offset o1 o2) + | `Index (i1,o1) -> `Index (i1,add_offset o1 o2) + + let rec to_cil_offset (x:t) = + match x with + | `NoOffset -> NoOffset + | `Field(f,o) -> Field(f, to_cil_offset o) + | `Index(i,o) -> NoOffset (* array domain can not deal with this -> leads to being handeled as access to unknown part *) +end + +module MakeLattice (Idx: IntDomain.Z) = +struct + include MakePrintable (Idx) + + let rec leq x y = + match x, y with + | `NoOffset, `NoOffset -> true + | `Index (i1,o1), `Index (i2,o2) when Idx.leq i1 i2 -> leq o1 o2 + | `Field (f1,o1), `Field (f2,o2) when CilType.Fieldinfo.equal f1 f2 -> leq o1 o2 + | _ -> false + + let rec merge cop x y = + let op = match cop with `Join -> Idx.join | `Meet -> Idx.meet | `Widen -> Idx.widen | `Narrow -> Idx.narrow in + match x, y with + | `NoOffset, `NoOffset -> `NoOffset + | `Field (x1,y1), `Field (x2,y2) when CilType.Fieldinfo.equal x1 x2 -> `Field (x1, merge cop y1 y2) + | `Index (x1,y1), `Index (x2,y2) -> `Index (op x1 x2, merge cop y1 y2) + | _ -> raise Lattice.Uncomparable (* special case not used for AddressDomain any more due to splitting *) + + let join x y = merge `Join x y + let meet x y = merge `Meet x y + let widen x y = merge `Widen x y + let narrow x y = merge `Narrow x y + + let rec drop_ints = function + | `Index (x, o) -> `Index (Idx.top (), drop_ints o) + | `Field (x, o) -> `Field (x, drop_ints o) + | `NoOffset -> `NoOffset +end diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 7cba43ecc2..e05279a65f 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -5,7 +5,7 @@ open Pretty open PrecisionUtil include PreValueDomain -module Offs = Lval.OffsetLat (IndexDomain) +module Offs = Offset.MakeLattice (IndexDomain) module M = Messages module BI = IntOps.BigIntOps module MutexAttr = MutexAttrDomain diff --git a/src/framework/cfgTools.ml b/src/framework/cfgTools.ml index e61a208bc3..19ecc38fb6 100644 --- a/src/framework/cfgTools.ml +++ b/src/framework/cfgTools.ml @@ -685,7 +685,7 @@ let getGlobalInits (file: file) : edges = lval in let rec any_index_offset = function - | Index (e,o) -> Index (Lval.any_index_exp, any_index_offset o) + | Index (e,o) -> Index (Offset.any_index_exp, any_index_offset o) | Field (f,o) -> Field (f, any_index_offset o) | NoOffset -> NoOffset in From 0b21d70b5716e75f8097d6aad638f52a26ba2fc6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 14:34:16 +0300 Subject: [PATCH 308/518] Extract Offset.Unit --- src/analyses/mayLocks.ml | 4 ++-- src/analyses/mutexTypeAnalysis.ml | 2 +- src/cdomains/lval.ml | 39 +++++++------------------------ src/cdomains/offset.ml | 39 +++++++++++++++++++++++++------ src/domains/queries.ml | 6 ++--- 5 files changed, 46 insertions(+), 44 deletions(-) diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 0f636f6f7e..e6da4fd329 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -18,7 +18,7 @@ struct in match D.Addr.to_var_offset l with | Some (v,o) -> - (let mtype = ctx.ask (Queries.MutexType (v, Lval.OffsetNoIdx.of_offs o)) in + (let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in match mtype with | `Lifted MutexAttrDomain.MutexKind.Recursive -> ctx.local | `Lifted MutexAttrDomain.MutexKind.NonRec -> @@ -33,7 +33,7 @@ struct if not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; match D.Addr.to_var_offset l with | Some (v,o) -> - (let mtype = ctx.ask (Queries.MutexType (v, Lval.OffsetNoIdx.of_offs o)) in + (let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in match mtype with | `Lifted MutexAttrDomain.MutexKind.NonRec -> D.remove l ctx.local | _ -> ctx.local (* we cannot remove them here *)) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index feb7fb413e..8e3dc6ead4 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -15,7 +15,7 @@ struct module C = Lattice.Unit (* Removing indexes here avoids complicated lookups and allows to have the LVals as vars here, at the price that different types of mutexes in arrays are not dinstinguished *) - module O = Lval.OffsetNoIdx + module O = Offset.Unit module V = struct include Printable.Prod(CilType.Varinfo)(O) diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 540384dca2..4fdd9fcb93 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -8,7 +8,7 @@ module M = Messages type ('f, 'i) offs = 'i Offset.t [@@deriving eq, ord, hash] -module OffsetLatWithSemanticEqual (Idx: IntDomain.Z) = +module OffsetLatWithSemanticEqual (Idx: Offset.Index.Lattice) = struct include Offset.MakeLattice (Idx) @@ -119,7 +119,7 @@ struct ) end -module Normal (Idx: Offset.IdxPrintable) = +module Normal (Idx: Offset.Index.Printable) = struct type field = fieldinfo type idx = Idx.t @@ -224,7 +224,7 @@ end - {!NullPtr} is a singleton sublattice. - {!UnknownPtr} is a singleton sublattice. - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) -module NormalLat (Idx: IntDomain.Z) = +module NormalLat (Idx: Offset.Index.Lattice) = struct include Normal (Idx) module Offs = OffsetLatWithSemanticEqual (Idx) @@ -308,7 +308,7 @@ struct end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module BaseAddrRepr (Idx: IntDomain.Z) = +module BaseAddrRepr (Idx: Offset.Index.Lattice) = struct include NormalLat (Idx) @@ -330,23 +330,8 @@ struct end end -(* Helper for offsets without abstract values for index offsets, i.e. with unit index offsets.*) -module NoIdxOffsetBase = struct - module UnitIdxDomain = - struct - include Lattice.Unit - let equal_to _ _ = `Top - let to_int _ = None - end - - let rec of_offs = function - | `NoOffset -> `NoOffset - | `Field (f,o) -> `Field (f, of_offs o) - | `Index (i,o) -> `Index (UnitIdxDomain.top (), of_offs o) -end - (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module NormalLatRepr (Idx: IntDomain.Z) = +module NormalLatRepr (Idx: Offset.Index.Lattice) = struct include NormalLat (Idx) @@ -354,14 +339,14 @@ struct module R: DisjointDomain.Representative with type elt = t = struct type elt = t - open NoIdxOffsetBase + open Offset.Unit (* Offset module for representative without abstract values for index offsets, i.e. with unit index offsets. Reason: The offset in the representative (used for buckets) should not depend on the integer domains, since different integer domains may be active at different program points. *) - include Normal (UnitIdxDomain) + include Normal (Offset.Index.Unit) - let of_elt_offset: (fieldinfo, Idx.t) offs -> (fieldinfo, UnitIdxDomain.t) offs = of_offs + let of_elt_offset: (fieldinfo, Idx.t) offs -> (fieldinfo, unit) offs = of_offs let of_elt (x: elt): t = match x with | Addr (v, o) -> Addr (v, of_elt_offset o) (* addrs grouped by var and part of offset *) @@ -521,11 +506,3 @@ struct end ) end - -module OffsetNoIdx = -struct - include NoIdxOffsetBase - include Offset.MakePrintable (UnitIdxDomain) - - let name () = "offset without index" -end diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 979fafb953..5429b5fe40 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -20,15 +20,29 @@ type 'i t = [ type 'i offs = 'i t [@@deriving eq, ord, hash] -(** Subinterface of IntDomain.Z which is sufficient for Printable (but not Lattice) Offset. *) -module type IdxPrintable = -sig - include Printable.S - val equal_to: IntOps.BigIntOps.t -> t -> [`Eq | `Neq | `Top] - val to_int: t -> IntOps.BigIntOps.t option +module Index = +struct + + (** Subinterface of IntDomain.Z which is sufficient for Printable (but not Lattice) Offset. *) + module type Printable = + sig + include Printable.S + val equal_to: IntOps.BigIntOps.t -> t -> [`Eq | `Neq | `Top] + val to_int: t -> IntOps.BigIntOps.t option + end + + module type Lattice = IntDomain.Z + + + module Unit: Printable with type t = unit = + struct + include Printable.Unit + let equal_to _ _ = `Top + let to_int _ = None + end end -module MakePrintable (Idx: IdxPrintable) = +module MakePrintable (Idx: Index.Printable) = struct type t = Idx.t offs [@@deriving eq, ord, hash] include Printable.StdLeaf @@ -117,3 +131,14 @@ struct | `Field (x, o) -> `Field (x, drop_ints o) | `NoOffset -> `NoOffset end + +module Unit = +struct + include MakePrintable (Index.Unit) + + (* TODO: rename to of_poly? *) + let rec of_offs: 'i offs -> t = function + | `NoOffset -> `NoOffset + | `Field (f,o) -> `Field (f, of_offs o) + | `Index (i,o) -> `Index ((), of_offs o) +end diff --git a/src/domains/queries.ml b/src/domains/queries.ml index afe23f47a7..67cfe47d76 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -94,7 +94,7 @@ type _ t = | HeapVar: VI.t t | IsHeapVar: varinfo -> MayBool.t t (* TODO: is may or must? *) | IsMultiple: varinfo -> MustBool.t t (* Is no other copy of this local variable reachable via pointers? *) - | MutexType: varinfo * Lval.OffsetNoIdx.t -> MutexAttrDomain.t t + | MutexType: varinfo * Offset.Unit.t -> MutexAttrDomain.t t | EvalThread: exp -> ConcDomain.ThreadSet.t t | EvalMutexAttr: exp -> MutexAttrDomain.t t | EvalJumpBuf: exp -> JmpBufDomain.JmpBufSet.t t @@ -332,7 +332,7 @@ struct | Any (Invariant i1), Any (Invariant i2) -> compare_invariant_context i1 i2 | Any (InvariantGlobal vi1), Any (InvariantGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) - | Any (MutexType (v1,o1)), Any (MutexType (v2,o2)) -> [%ord: CilType.Varinfo.t * Lval.OffsetNoIdx.t] (v1,o1) (v2,o2) + | Any (MutexType (v1,o1)), Any (MutexType (v2,o2)) -> [%ord: CilType.Varinfo.t * Offset.Unit.t] (v1,o1) (v2,o2) | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 @@ -369,7 +369,7 @@ struct | Any (EvalJumpBuf e) -> CilType.Exp.hash e | Any (WarnGlobal vi) -> Hashtbl.hash vi | Any (Invariant i) -> hash_invariant_context i - | Any (MutexType (v,o)) -> 31*CilType.Varinfo.hash v + Lval.OffsetNoIdx.hash o + | Any (MutexType (v,o)) -> [%hash: CilType.Varinfo.t * Offset.Unit.t] (v, o) | Any (InvariantGlobal vi) -> Hashtbl.hash vi | Any (MustProtectedVars m) -> hash_mustprotectedvars m | Any (MayBeModifiedSinceSetjmp e) -> JmpBufDomain.BufferEntry.hash e From 78753bd2598c173c155f99638e47d742aa8c231d Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 30 May 2023 14:02:33 +0200 Subject: [PATCH 309/518] Add notion of clean joins to thread analysis. --- src/analyses/threadId.ml | 13 ++++ src/analyses/threadJoins.ml | 62 +++++++++++-------- src/domains/queries.ml | 5 ++ .../58-base-mm-tid/32-phases-sound-tid.c | 45 ++++++++++++++ .../33-phases-sound-tid-other.c | 41 ++++++++++++ 5 files changed, 141 insertions(+), 25 deletions(-) create mode 100644 tests/regression/58-base-mm-tid/32-phases-sound-tid.c create mode 100644 tests/regression/58-base-mm-tid/33-phases-sound-tid-other.c diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index ec10ec001c..4986839aa5 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -67,6 +67,19 @@ struct | `Lifted tid -> Thread.is_unique tid | _ -> Queries.MustBool.top () end + | Queries.MustBeSingleThreaded {since_start} -> + begin match fst ctx.local with + | `Lifted tid when Thread.is_main tid -> + let created = created ctx.local in + if since_start then + ConcDomain.ThreadSet.is_empty created + else if ctx.ask Queries.ThreadsJoinedCleanly then + let joined = ctx.ask Queries.MustJoinedThreads in + ConcDomain.ThreadSet.is_empty (ConcDomain.ThreadSet.diff created joined) + else + false + | _ -> false + end | _ -> Queries.Result.top x module A = diff --git a/src/analyses/threadJoins.ml b/src/analyses/threadJoins.ml index 19433aae9f..f2cd36619f 100644 --- a/src/analyses/threadJoins.ml +++ b/src/analyses/threadJoins.ml @@ -8,15 +8,19 @@ open Analyses module TID = ThreadIdDomain.Thread module TIDs = ConcDomain.ThreadSet module MustTIDs = ConcDomain.MustThreadSet +module CleanExit = Queries.MustBool module Spec = struct include Analyses.IdentitySpec let name () = "threadJoins" - module D = MustTIDs + + (* The first component is the set of must-joined TIDs, the second component tracks whether all TIDs recorded in MustTIDs have been exited cleanly, *) + (* i.e., all created subthreads have also been joined. This is helpful as there is no set of all transitively created threads available. *) + module D = Lattice.Prod(MustTIDs)(CleanExit) module C = D - module G = MustTIDs + module G = D module V = struct include TID @@ -24,22 +28,25 @@ struct end (* transfer functions *) + let threadreturn ctx = + match ctx.ask CurrentThreadId with + | `Lifted tid -> + let (j,joined_clean) = ctx.local in + (* the current thread has been exited cleanly if all joined threads where exited cleanly, and all created threads are joined *) + let created = ctx.ask Queries.CreatedThreads in + let clean = TIDs.subset created j in + ctx.sideg tid (j, joined_clean && clean) + | _ -> () (* correct? *) + + let return ctx (exp:exp option) (f:fundec) : D.t = - ( - match ctx.ask CurrentThreadId with - | `Lifted tid when ThreadReturn.is_current (Analyses.ask_of_ctx ctx) -> ctx.sideg tid ctx.local - | _ -> () (* correct? *) - ); + if ThreadReturn.is_current (Analyses.ask_of_ctx ctx) then threadreturn ctx; ctx.local let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = let desc = LibraryFunctions.find f in match desc.special arglist, f.vname with - | ThreadExit _, _ -> (match ctx.ask CurrentThreadId with - | `Lifted tid -> ctx.sideg tid ctx.local - | _ -> () (* correct? *) - ); - ctx.local + | ThreadExit _, _ -> threadreturn ctx; ctx.local | ThreadJoin { thread = id; ret_var }, _ -> let threads = ctx.ask (Queries.EvalThread id) in if TIDs.is_top threads then @@ -49,9 +56,10 @@ struct let threads = TIDs.elements threads in match threads with | [tid] when TID.is_unique tid-> - let joined = ctx.global tid in - D.union (D.add tid ctx.local) joined - | _ -> ctx.local (* if multiple possible thread ids are joined, none of them is must joined*) + let (local_joined, local_clean) = ctx.local in + let (other_joined, other_clean) = ctx.global tid in + (MustTIDs.union (MustTIDs.add tid local_joined) other_joined, local_clean && other_clean) + | _ -> ctx.local (* if multiple possible thread ids are joined, none of them is must joined *) (* Possible improvement: Do the intersection first, things that are must joined in all possibly joined threads are must-joined *) ) | Unknown, "__goblint_assume_join" -> @@ -59,17 +67,17 @@ struct let threads = ctx.ask (Queries.EvalThread id) in if TIDs.is_top threads then ( M.info ~category:Unsound "Unknown thread ID assume-joined, assuming ALL threads must-joined."; - D.bot () (* consider everything joined, D is reversed so bot is All threads *) + (MustTIDs.bot(), true) (* consider everything joined, MustTIDs is reversed so bot is All threads *) ) else ( (* elements throws if the thread set is top *) let threads = TIDs.elements threads in if List.compare_length_with threads 1 > 0 then M.info ~category:Unsound "Ambiguous thread ID assume-joined, assuming all of those threads must-joined."; - List.fold_left (fun acc tid -> - let joined = ctx.global tid in - D.union (D.add tid acc) joined - ) ctx.local threads + List.fold_left (fun (joined, clean) tid -> + let (other_joined, other_clean) = ctx.global tid in + (MustTIDs.union (MustTIDs.add tid joined) other_joined, clean && other_clean) + ) (ctx.local) threads ) | _, _ -> ctx.local @@ -81,20 +89,24 @@ struct else match ThreadId.get_current (Analyses.ask_of_ctx fctx) with | `Lifted tid -> - D.remove tid ctx.local + let (j, clean) = ctx.local in + (MustTIDs.remove tid j, clean) | _ -> ctx.local let query ctx (type a) (q: a Queries.t): a Queries.result = match q with - | Queries.MustJoinedThreads -> (ctx.local:ConcDomain.MustThreadSet.t) (* type annotation needed to avoid "would escape the scope of its equation" *) + | Queries.MustJoinedThreads -> (fst ctx.local:ConcDomain.MustThreadSet.t) (* type annotation needed to avoid "would escape the scope of its equation" *) + | Queries.ThreadsJoinedCleanly -> (snd ctx.local:bool) | _ -> Queries.Result.top q let combine_env ctx lval fexp f args fc au f_ask = - D.union ctx.local au + let (caller_joined, local_clean) = ctx.local in + let (callee_joined, callee_clean) = au in + (MustTIDs.union caller_joined callee_joined, local_clean && callee_clean) - let startstate v = D.top () - let exitstate v = D.top () + let startstate v = (MustTIDs.empty (), true) + let exitstate v = (MustTIDs.empty (), true) end let _ = MCP.register_analysis ~dep:["threadid"] (module Spec : MCPSpec) diff --git a/src/domains/queries.ml b/src/domains/queries.ml index afe23f47a7..4f743fded5 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -102,6 +102,7 @@ type _ t = | ValidLongJmp: JmpBufDomain.JmpBufSet.t t | CreatedThreads: ConcDomain.ThreadSet.t t | MustJoinedThreads: ConcDomain.MustThreadSet.t t + | ThreadsJoinedCleanly: MustBool.t t | MustProtectedVars: mustprotectedvars -> LS.t t | Invariant: invariant_context -> Invariant.t t | InvariantGlobal: Obj.t -> Invariant.t t (** Argument must be of corresponding [Spec.V.t]. *) @@ -164,6 +165,7 @@ struct | ValidLongJmp -> (module JmpBufDomain.JmpBufSet) | CreatedThreads -> (module ConcDomain.ThreadSet) | MustJoinedThreads -> (module ConcDomain.MustThreadSet) + | ThreadsJoinedCleanly -> (module MustBool) | MustProtectedVars _ -> (module LS) | Invariant _ -> (module Invariant) | InvariantGlobal _ -> (module Invariant) @@ -225,6 +227,7 @@ struct | ValidLongJmp -> JmpBufDomain.JmpBufSet.top () | CreatedThreads -> ConcDomain.ThreadSet.top () | MustJoinedThreads -> ConcDomain.MustThreadSet.top () + | ThreadsJoinedCleanly -> MustBool.top () | MustProtectedVars _ -> LS.top () | Invariant _ -> Invariant.top () | InvariantGlobal _ -> Invariant.top () @@ -291,6 +294,7 @@ struct | Any (MayBeModifiedSinceSetjmp _) -> 48 | Any (MutexType _) -> 49 | Any (EvalMutexAttr _ ) -> 50 + | Any ThreadsJoinedCleanly -> 51 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -418,6 +422,7 @@ struct | Any ValidLongJmp -> Pretty.dprintf "ValidLongJmp" | Any CreatedThreads -> Pretty.dprintf "CreatedThreads" | Any MustJoinedThreads -> Pretty.dprintf "MustJoinedThreads" + | Any ThreadsJoinedCleanly -> Pretty.dprintf "ThreadsJoinedCleanly" | Any (MustProtectedVars m) -> Pretty.dprintf "MustProtectedVars _" | Any (Invariant i) -> Pretty.dprintf "Invariant _" | Any (WarnGlobal vi) -> Pretty.dprintf "WarnGlobal _" diff --git a/tests/regression/58-base-mm-tid/32-phases-sound-tid.c b/tests/regression/58-base-mm-tid/32-phases-sound-tid.c new file mode 100644 index 0000000000..81304351bd --- /dev/null +++ b/tests/regression/58-base-mm-tid/32-phases-sound-tid.c @@ -0,0 +1,45 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void *t_benign(void *arg) { + pthread_mutex_lock(&A); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +void *t_benign2(void *arg) { + pthread_mutex_lock(&A); + __goblint_check(g == 20); + g = 10; + __goblint_check(g == 10); + pthread_mutex_unlock(&A); + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + + g = 20; + __goblint_check(g == 20); + + pthread_t id; + pthread_create(&id, NULL, t_benign2, NULL); + + + pthread_mutex_lock(&A); + __goblint_check(g == 20); //UNKNOWN! + pthread_mutex_unlock(&A); + + return 0; +} diff --git a/tests/regression/58-base-mm-tid/33-phases-sound-tid-other.c b/tests/regression/58-base-mm-tid/33-phases-sound-tid-other.c new file mode 100644 index 0000000000..30a0a7003f --- /dev/null +++ b/tests/regression/58-base-mm-tid/33-phases-sound-tid-other.c @@ -0,0 +1,41 @@ +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --enable ana.int.interval --set ana.activated[+] threadJoins +#include +#include + +int g = 10; + +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void* t_other(void *arg) { + g = 60; +} + +void *t_benign(void *arg) { + pthread_mutex_lock(&A); + g = 10; + __goblint_check(g == 10); //UNKNOWN! + pthread_mutex_unlock(&A); + + + pthread_t id2; + pthread_create(&id2, NULL, t_other, NULL); + + return NULL; +} + +int main(void) { + + pthread_t id2; + pthread_create(&id2, NULL, t_benign, NULL); + pthread_join(id2, NULL); + + + g = 20; + __goblint_check(g == 20); //UNKNOWN! + + pthread_mutex_lock(&A); + __goblint_check(g == 20); //UNKNOWN! + pthread_mutex_unlock(&A); + + return 0; +} From 2936ea835eff287996d95d0a3024cf8bffa4342d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 15:30:10 +0300 Subject: [PATCH 310/518] Add Lval/Offset TODOs --- src/analyses/base.ml | 3 +++ src/analyses/commonPriv.ml | 1 + src/analyses/malloc_null.ml | 1 + src/analyses/mutexAnalysis.ml | 1 + src/analyses/mutexEventsAnalysis.ml | 2 +- src/analyses/pthreadSignals.ml | 1 + src/analyses/region.ml | 1 + src/analyses/uninit.ml | 1 + src/cdomains/addressDomain.ml | 1 + src/cdomains/lockDomain.ml | 1 + src/cdomains/lval.ml | 7 +++++++ src/cdomains/valueDomain.ml | 1 + src/domains/access.ml | 5 +++++ 13 files changed, 25 insertions(+), 1 deletion(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 86ba46bb02..122cbe1402 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -404,6 +404,7 @@ struct | _, `Bot -> `Bot | _ -> VD.top () + (* TODO: move to Offset *) (* Auxiliary function to append an additional offset to a given offset. *) let rec add_offset ofs add = match ofs with @@ -413,6 +414,7 @@ struct | `Index (exp, `NoOffset) -> `Index (exp, add) | `Index (exp, ofs) -> `Index (exp, add_offset ofs add) + (* TODO: move to Lval *) (* We need the previous function with the varinfo carried along, so we can * map it on the address sets. *) let add_offset_varinfo add ad = @@ -619,6 +621,7 @@ struct %> f (ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.base.context.interval" ~removeAttr:"base.no-interval" ~keepAttr:"base.interval" fd) drop_interval %> f (ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.base.context.interval_set" ~removeAttr:"base.no-interval_set" ~keepAttr:"base.interval_set" fd) drop_intervalSet + (* TODO: Lval *) let convertToQueryLval x = let rec offsNormal o = let ik = Cilfacade.ptrdiff_ikind () in diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index b866c7e201..af6cf9aaa5 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -125,6 +125,7 @@ struct module MustLockset = SetDomain.Reverse (Lockset) + (* TODO: Lval *) let rec conv_offset = function | `NoOffset -> `NoOffset | `Field (f, o) -> `Field (f, conv_offset o) diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index caaf4ce3e3..f151cca096 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -16,6 +16,7 @@ struct module C = ValueDomain.AddrSetDomain module P = IdentityP (D) + (* TODO: Lval *) (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain element) answers with Lval.any_index_exp on all non-concrete cases. *) let rec conv_offset x = diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index e1db358ead..c5f5beeaaf 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -148,6 +148,7 @@ struct num_mutexes := 0; sum_protected := 0 + (* TODO: Lval *) let rec conv_offset_inv = function | `NoOffset -> `NoOffset | `Field (f, o) -> `Field (f, conv_offset_inv o) diff --git a/src/analyses/mutexEventsAnalysis.ml b/src/analyses/mutexEventsAnalysis.ml index ff6fce9562..4b24e784f6 100644 --- a/src/analyses/mutexEventsAnalysis.ml +++ b/src/analyses/mutexEventsAnalysis.ml @@ -18,7 +18,7 @@ struct include UnitAnalysis.Spec let name () = "mutexEvents" - + (* TODO: Lval *) (* Currently we care only about concrete indexes. *) let rec conv_offset x = match x with diff --git a/src/analyses/pthreadSignals.ml b/src/analyses/pthreadSignals.ml index d49a8f12bc..2a17f47837 100644 --- a/src/analyses/pthreadSignals.ml +++ b/src/analyses/pthreadSignals.ml @@ -17,6 +17,7 @@ struct module C = MustSignals module G = SetDomain.ToppedSet (MHP) (struct let topname = "All Threads" end) + (* TODO: Lval *) let rec conv_offset x = match x with | `NoOffset -> `NoOffset diff --git a/src/analyses/region.ml b/src/analyses/region.ml index c4c9f7bec1..6f4b0335d2 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -82,6 +82,7 @@ struct Some (Lvals.empty ()) | Memory {exp = e; _} -> (* TODO: remove regions that cannot be reached from the var*) + (* TODO: Offset *) let rec unknown_index = function | `NoOffset -> `NoOffset | `Field (f, os) -> `Field (f, unknown_index os) diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 3177dd7708..9b1db639df 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -29,6 +29,7 @@ struct let threadspawn ctx lval f args fctx = ctx.local let exitstate v : D.t = D.empty () + (* TODO: Lval *) (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain element) answers with Lval.any_index_exp on all non-concrete cases. *) let rec conv_offset x = diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 02a52d00c2..30143697d7 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -57,6 +57,7 @@ struct type field = Addr.field type idx = Idx.t + (* TODO: Offset *) type offs = [`NoOffset | `Field of (field * offs) | `Index of (idx * offs)] let null_ptr = singleton Addr.NullPtr diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index a107dbf91a..1904f3daf4 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -45,6 +45,7 @@ struct include SetDomain.Reverse(SetDomain.ToppedSet (Lock) (struct let topname = "All mutexes" end)) + (* TODO: Offset *) let rec may_be_same_offset of1 of2 = match of1, of2 with | `NoOffset , `NoOffset -> true diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 4fdd9fcb93..5bd533d5ce 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -186,6 +186,7 @@ struct (* TODO: seems to be unused *) let to_exp (f:idx -> exp) x = + (* TODO: Offset *) let rec to_cil c = match c with | `NoOffset -> NoOffset @@ -198,6 +199,7 @@ struct | StrPtr None -> raise (Lattice.Unsupported "Cannot express unknown string pointer as expression.") | NullPtr -> integer 0 | UnknownPtr -> raise Lattice.TopValue + (* TODO: Offset *) let rec add_offsets x y = match x with | `NoOffset -> y | `Index (i,x) -> `Index (i, add_offsets x y) @@ -206,6 +208,7 @@ struct let add_offset x o = match x with | Addr (v, u) -> Addr (v, add_offsets u o) | x -> x + (* TODO: Offset *) let rec remove_offset = function | `NoOffset -> `NoOffset | `Index (_,`NoOffset) | `Field (_,`NoOffset) -> `NoOffset @@ -469,6 +472,7 @@ struct | _ when Cilfacade.is_varinfo_formal v -> `Parameter | _ -> `Local + (* TODO: Offset *) let rec short_offs (o: (fieldinfo, exp) offs) a = match o with | `NoOffset -> a @@ -476,12 +480,14 @@ struct | `Index (e,o) when CilType.Exp.equal e Offset.any_index_exp -> short_offs o (a^"[?]") | `Index (e,o) -> short_offs o (a^"["^CilType.Exp.show e^"]") + (* TODO: Offset *) let rec of_ciloffs x = match x with | NoOffset -> `NoOffset | Index (i,o) -> `Index (i, of_ciloffs o) | Field (f,o) -> `Field (f, of_ciloffs o) + (* TODO: Offset *) let rec to_ciloffs x = match x with | `NoOffset -> NoOffset @@ -491,6 +497,7 @@ struct let to_lval (v,o) = Var v, to_ciloffs o let to_exp (v,o) = Lval (Var v, to_ciloffs o) + (* TODO: Offset *) let rec has_index_offs = function | `NoOffset -> false diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index e05279a65f..a29a88adca 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -1261,6 +1261,7 @@ struct | Addr.UnknownPtr -> None | Addr.Addr (vi, offs) when Addr.Offs.is_definite offs -> + (* TODO: Offset *) let rec offs_to_offset = function | `NoOffset -> NoOffset | `Field (f, offs) -> Field (f, offs_to_offset offs) diff --git a/src/domains/access.ml b/src/domains/access.ml index c40e6f136c..076e78aeb3 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -52,19 +52,23 @@ let reset () = Hashtbl.clear typeIncl +(* TODO: Offset *) type offs = [`NoOffset | `Index of offs | `Field of CilType.Fieldinfo.t * offs] [@@deriving eq, ord, hash] +(* TODO: Offset *) let rec remove_idx : offset -> offs = function | NoOffset -> `NoOffset | Index (_,o) -> `Index (remove_idx o) | Field (f,o) -> `Field (f, remove_idx o) +(* TODO: Offset *) let rec addOffs os1 os2 : offs = match os1 with | `NoOffset -> os2 | `Index os -> `Index (addOffs os os2) | `Field (f,os) -> `Field (f, addOffs os os2) +(* TODO: Offset *) let rec d_offs () : offs -> doc = function | `NoOffset -> nil | `Index o -> dprintf "[?]%a" d_offs o @@ -200,6 +204,7 @@ let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (va let add_propagate side e kind conf ty ls a = (* ignore (printf "%a:\n" d_exp e); *) + (* TODO: Offset *) let rec only_fields = function | `NoOffset -> true | `Field (_,os) -> only_fields os From 5a121411c74f85506629a924e6dda44fc5988304 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 16:17:07 +0300 Subject: [PATCH 311/518] Clean up Lval.CilLval --- src/analyses/accessAnalysis.ml | 2 +- src/analyses/apron/relationAnalysis.apron.ml | 9 ++- src/analyses/base.ml | 6 +- src/analyses/condVars.ml | 2 +- src/analyses/extractPthread.ml | 4 +- src/analyses/mutexAnalysis.ml | 2 +- src/analyses/raceAnalysis.ml | 2 +- src/analyses/spec.ml | 2 +- src/analyses/symbLocks.ml | 2 +- src/analyses/varEq.ml | 6 +- src/cdomains/lval.ml | 64 ++++++-------------- src/cdomains/lvalMapDomain.ml | 4 +- src/cdomains/offset.ml | 37 +++++++++++ src/cdomains/symbLocksDomain.ml | 6 +- 14 files changed, 79 insertions(+), 69 deletions(-) diff --git a/src/analyses/accessAnalysis.ml b/src/analyses/accessAnalysis.ml index 4ad207b3b8..0ecf797eb7 100644 --- a/src/analyses/accessAnalysis.ml +++ b/src/analyses/accessAnalysis.ml @@ -142,7 +142,7 @@ struct ctx.sideg ctx.node (G.singleton access) | ls -> let events = Queries.LS.fold (fun (var, offs) acc -> - let coffs = Lval.CilLval.to_ciloffs offs in + let coffs = Offset.Exp.to_cil offs in let access: AccessDomain.Event.t = if CilType.Varinfo.equal var dummyFunDec.svar then {var_opt = None; offs_opt = (Some coffs); kind} diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 1884f36be0..f55a150f89 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -163,7 +163,7 @@ struct st | `Lifted s -> let lvals = Queries.LS.elements r in - let ass' = List.map (fun lv -> assign_to_global_wrapper ask getg sideg st (Lval.CilLval.to_lval lv) f) lvals in + let ass' = List.map (fun lv -> assign_to_global_wrapper ask getg sideg st (Lval.Exp.to_cil lv) f) lvals in List.fold_right D.join ass' (D.bot ()) ) (* Ignoring all other assigns *) @@ -219,8 +219,7 @@ struct | Lval (Mem e, NoOffset) -> (match ask (Queries.MayPointTo e) with | a when not (Queries.LS.is_top a || Queries.LS.mem (dummyFunDec.svar, `NoOffset) a) && (Queries.LS.cardinal a) = 1 -> - let lval = Lval.CilLval.to_lval (Queries.LS.choose a) in - Lval lval + Lval.Exp.to_cil_exp (Queries.LS.choose a) (* It would be possible to do better here, exploiting e.g. that the things pointed to are known to be equal *) (* see: https://github.com/goblint/analyzer/pull/742#discussion_r879099745 *) | _ -> Lval (Mem e, NoOffset)) @@ -454,7 +453,7 @@ struct |> List.map Cil.var | Some rs -> Queries.LS.elements rs - |> List.map Lval.CilLval.to_lval + |> List.map Lval.Exp.to_cil in List.fold_left (fun st lval -> invalidate_one ask ctx st lval @@ -508,7 +507,7 @@ struct let s = ask.f (Queries.MayPointTo e) in match s with | `Top -> [] - | `Lifted _ -> List.map (Lval.CilLval.to_lval) (Queries.LS.elements s) + | `Lifted _ -> List.map Lval.Exp.to_cil (Queries.LS.elements s) in let shallow_addrs = LibraryDesc.Accesses.find desc.accs { kind = Write; deep = false } args in let deep_addrs = LibraryDesc.Accesses.find desc.accs { kind = Write; deep = true } args in diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 122cbe1402..1d57fb22e1 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1352,9 +1352,7 @@ struct (* ignore @@ printf "EvalStr `Address: %a -> %s (must %i, may %i)\n" d_plainexp e (VD.short 80 (`Address a)) (List.length @@ AD.to_var_must a) (List.length @@ AD.to_var_may a); *) begin match unrollType (Cilfacade.typeOf e) with | TPtr(TInt(IChar, _), _) -> - let v, offs = Q.LS.choose @@ addrToLvalSet a in - let ciloffs = Lval.CilLval.to_ciloffs offs in - let lval = Var v, ciloffs in + let lval = Lval.Exp.to_cil @@ Q.LS.choose @@ addrToLvalSet a in (try `Lifted (Bytes.to_string (Hashtbl.find char_array lval)) with Not_found -> Queries.Result.top q) | _ -> (* what about ISChar and IUChar? *) @@ -2322,7 +2320,7 @@ struct let ask = (Analyses.ask_of_ctx ctx) in Q.LS.fold (fun (v, o) st -> if CPA.mem v fun_st.cpa then - let lval = Lval.CilLval.to_lval (v,o) in + let lval = Lval.Exp.to_cil (v,o) in let address = eval_lv ask ctx.global st lval in let lval_type = (AD.get_type address) in if M.tracing then M.trace "taintPC" "updating %a; type: %a\n" Lval.CilLval.pretty (v, o) d_type lval_type; diff --git a/src/analyses/condVars.ml b/src/analyses/condVars.ml index abe9f61ae2..937142b650 100644 --- a/src/analyses/condVars.ml +++ b/src/analyses/condVars.ml @@ -45,7 +45,7 @@ module Domain = struct if mem k d && V.cardinal (find k d) = 1 then let s = find k d in match V.choose s with - | Lval (Var v, offs) -> get (v, Lval.CilLval.of_ciloffs offs) d (* transitive lookup *) + | Lval (Var v, offs) -> get (v, Offset.Exp.of_cil offs) d (* transitive lookup *) | _ -> Some s else None let get_elt k d = Option.map V.choose @@ get k d diff --git a/src/analyses/extractPthread.ml b/src/analyses/extractPthread.ml index 8aec79f29f..91bb2f4589 100644 --- a/src/analyses/extractPthread.ml +++ b/src/analyses/extractPthread.ml @@ -1127,8 +1127,8 @@ module Spec : Analyses.MCPSpec = struct let funs_ls = let ls = ctx.ask (Queries.ReachableFrom func) in Queries.LS.filter - (fun (v, o) -> - let lval = (Var v, Lval.CilLval.to_ciloffs o) in + (fun lv -> + let lval = Lval.Exp.to_cil lv in isFunctionType (typeOfLval lval)) ls in diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index c5f5beeaaf..554d6f858b 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -289,7 +289,7 @@ struct let on_lvals ls = let ls = LS.filter (fun (g,_) -> g.vglob || has_escaped g) ls in let f (var, offs) = - let coffs = Lval.CilLval.to_ciloffs offs in + let coffs = Offset.Exp.to_cil offs in if CilType.Varinfo.equal var dummyFunDec.svar then old_access None (Some coffs) else diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index 099dc1bd62..481ccbf60b 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -116,7 +116,7 @@ struct let conf = if reach then conf - 20 else conf in let conf = if includes_uk then conf - 10 else conf in let f (var, offs) = - let coffs = Lval.CilLval.to_ciloffs offs in + let coffs = Offset.Exp.to_cil offs in if CilType.Varinfo.equal var dummyFunDec.svar then add_access conf None (Some coffs) else diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml index ed3f0a9a56..068698bf45 100644 --- a/src/analyses/spec.ml +++ b/src/analyses/spec.ml @@ -239,7 +239,7 @@ struct in let m = SpecCheck.check ctx get_key matches in let key_from_exp = function - | Lval (Var v,o) -> Some (v, Lval.CilLval.of_ciloffs o) + | Lval (Var v,o) -> Some (v, Offset.Exp.of_cil o) | _ -> None in match key_from_exp (Lval lval), key_from_exp (stripCasts rval) with (* TODO for now we just care about Lval assignments -> should use Queries.MayPointTo *) diff --git a/src/analyses/symbLocks.ml b/src/analyses/symbLocks.ml index 489fbda918..2f55185e9e 100644 --- a/src/analyses/symbLocks.ml +++ b/src/analyses/symbLocks.ml @@ -184,7 +184,7 @@ struct (match ctx.ask (Queries.Regions e) with | ls when not (Queries.LS.is_top ls || Queries.LS.is_empty ls) -> let add_exp x xs = - try Queries.ES.add (Lval.CilLval.to_exp x) xs + try Queries.ES.add (Lval.Exp.to_cil_exp x) xs with Lattice.BotValue -> xs in begin try Queries.LS.fold add_exp ls (Queries.ES.singleton e) diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index 7e310d9784..b9671ac921 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -369,7 +369,7 @@ struct | Lval rlval -> begin match ask (Queries.MayPointTo (mkAddrOf rlval)) with | rv when not (Queries.LS.is_top rv) && Queries.LS.cardinal rv = 1 -> - let rv = Lval.CilLval.to_exp (Queries.LS.choose rv) in + let rv = Lval.Exp.to_cil_exp (Queries.LS.choose rv) in if is_local lv && Exp.is_global_var rv = Some false then D.add_eq (rv,Lval lv) st else st @@ -437,7 +437,7 @@ struct if Queries.LS.is_top tainted || not (ctx.ask (Queries.MustBeSingleThreaded {since_start = true})) then D.top () else - let taint_exp = Queries.ES.of_list (List.map (fun lv -> Lval (Lval.CilLval.to_lval lv)) (Queries.LS.elements tainted)) in + let taint_exp = Queries.ES.of_list (List.map Lval.Exp.to_cil_exp (Queries.LS.elements tainted)) in D.filter (fun exp -> not (Queries.ES.mem exp taint_exp)) ctx.local in let d = D.meet au d_local in @@ -458,7 +458,7 @@ struct each expression in st was checked for reachability from es/rs using very conservative but also unsound reachable_from. It is unknown, why that was necessary. *) Queries.LS.fold (fun lval st -> - remove ask (Lval.CilLval.to_lval lval) st + remove ask (Lval.Exp.to_cil lval) st ) rs st let unknown_fn ctx lval f args = diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 5bd533d5ce..1c6c699867 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -457,13 +457,28 @@ struct Pretty.dprintf "%a not leq %a" pretty x pretty y end - -module CilLval = +module Exp = struct include Printable.StdLeaf - type t = CilType.Varinfo.t * (CilType.Fieldinfo.t, Basetype.CilExp.t) offs [@@deriving eq, ord, hash] + type t = CilType.Varinfo.t * Offset.Exp.t [@@deriving eq, ord, hash] - let name () = "simplified lval" + let name () = "lval with exp indices" + + let show ((v, o): t): string = CilType.Varinfo.show v ^ Offset.Exp.show o + include Printable.SimpleShow ( + struct + type nonrec t = t + let show = show + end + ) + + let to_cil ((v, o): t): lval = (Var v, Offset.Exp.to_cil o) + let to_cil_exp lv = Lval (to_cil lv) +end + +module CilLval = +struct + include Exp let class_tag (v,o) = match v with @@ -472,44 +487,5 @@ struct | _ when Cilfacade.is_varinfo_formal v -> `Parameter | _ -> `Local - (* TODO: Offset *) - let rec short_offs (o: (fieldinfo, exp) offs) a = - match o with - | `NoOffset -> a - | `Field (f,o) -> short_offs o (a^"."^f.fname) - | `Index (e,o) when CilType.Exp.equal e Offset.any_index_exp -> short_offs o (a^"[?]") - | `Index (e,o) -> short_offs o (a^"["^CilType.Exp.show e^"]") - - (* TODO: Offset *) - let rec of_ciloffs x = - match x with - | NoOffset -> `NoOffset - | Index (i,o) -> `Index (i, of_ciloffs o) - | Field (f,o) -> `Field (f, of_ciloffs o) - - (* TODO: Offset *) - let rec to_ciloffs x = - match x with - | `NoOffset -> NoOffset - | `Index (i,o) -> Index (i, to_ciloffs o) - | `Field (f,o) -> Field (f, to_ciloffs o) - - let to_lval (v,o) = Var v, to_ciloffs o - let to_exp (v,o) = Lval (Var v, to_ciloffs o) - - (* TODO: Offset *) - let rec has_index_offs = - function - | `NoOffset -> false - | `Index _ -> true - | `Field (_,o) -> has_index_offs o - let has_index (v,o) = has_index_offs o - - let show (v,o) = short_offs o v.vname - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) + let to_exp = to_cil_exp (* TODO: remove *) end diff --git a/src/cdomains/lvalMapDomain.ml b/src/cdomains/lvalMapDomain.ml index 5a8f31764a..7815833607 100644 --- a/src/cdomains/lvalMapDomain.ml +++ b/src/cdomains/lvalMapDomain.ml @@ -274,8 +274,8 @@ struct (* getting keys from Cil Lvals *) let key_from_lval lval = match lval with (* TODO try to get a Lval.CilLval from Cil.Lval *) - | Var v1, o1 -> v1, Lval.CilLval.of_ciloffs o1 - | Mem Lval(Var v1, o1), o2 -> v1, Lval.CilLval.of_ciloffs (addOffset o1 o2) + | Var v1, o1 -> v1, Offset.Exp.of_cil o1 + | Mem Lval(Var v1, o1), o2 -> v1, Offset.Exp.of_cil (addOffset o1 o2) (* | Mem exp, o1 -> failwith "not implemented yet" (* TODO use query_lv *) *) | _ -> Cilfacade.create_var @@ Cil.makeVarinfo false ("?"^CilType.Lval.show lval) Cil.voidType, `NoOffset (* TODO *) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 5429b5fe40..59b0374a3d 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -40,6 +40,28 @@ struct let equal_to _ _ = `Top let to_int _ = None end + + module Exp: Printable with type t = exp = + struct + include CilType.Exp + + (* Override output *) + let pretty () x = + if equal x any_index_exp then + Pretty.text "?" + else + dn_exp () x + + include Printable.SimplePretty ( + struct + type nonrec t = t + let pretty = pretty + end + ) + + let equal_to _ _ = `Top (* TODO: more precise for definite indices *) + let to_int _ = None (* TODO: more precise for definite indices *) + end end module MakePrintable (Idx: Index.Printable) = @@ -142,3 +164,18 @@ struct | `Field (f,o) -> `Field (f, of_offs o) | `Index (i,o) -> `Index ((), of_offs o) end + +module Exp = +struct + include MakePrintable (Index.Exp) + + let rec of_cil: offset -> t = function + | NoOffset -> `NoOffset + | Index (i,o) -> `Index (i, of_cil o) + | Field (f,o) -> `Field (f, of_cil o) + + let rec to_cil: t -> offset = function + | `NoOffset -> NoOffset + | `Index (i,o) -> Index (i, to_cil o) + | `Field (f,o) -> Field (f, to_cil o) +end diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index e67be76ea5..d03b2dcb16 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -99,11 +99,11 @@ struct | Lval (Var _,_) | AddrOf (Var _,_) | StartOf (Var _,_) -> exp - | Lval (Mem e,o) when simple_eq e q -> Lval (Var v, addOffset o (Lval.CilLval.to_ciloffs offs)) + | Lval (Mem e,o) when simple_eq e q -> Lval (Var v, addOffset o (Offset.Exp.to_cil offs)) | Lval (Mem e,o) -> Lval (Mem (replace_base (v,offs) q e), o) - | AddrOf (Mem e,o) when simple_eq e q -> AddrOf (Var v, addOffset o (Lval.CilLval.to_ciloffs offs)) + | AddrOf (Mem e,o) when simple_eq e q -> AddrOf (Var v, addOffset o (Offset.Exp.to_cil offs)) | AddrOf (Mem e,o) -> AddrOf (Mem (replace_base (v,offs) q e), o) - | StartOf (Mem e,o) when simple_eq e q -> StartOf (Var v, addOffset o (Lval.CilLval.to_ciloffs offs)) + | StartOf (Mem e,o) when simple_eq e q -> StartOf (Var v, addOffset o (Offset.Exp.to_cil offs)) | StartOf (Mem e,o) -> StartOf (Mem (replace_base (v,offs) q e), o) | CastE (t,e) -> CastE (t, replace_base (v,offs) q e) From f5bff82c7fab82edb191db615d9b881197ff6506 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 16:24:04 +0300 Subject: [PATCH 312/518] Use Offset module in Access --- src/cdomains/offset.ml | 5 ++++ src/domains/access.ml | 56 +++++++++--------------------------------- 2 files changed, 16 insertions(+), 45 deletions(-) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 59b0374a3d..6ea9127821 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -163,6 +163,11 @@ struct | `NoOffset -> `NoOffset | `Field (f,o) -> `Field (f, of_offs o) | `Index (i,o) -> `Index ((), of_offs o) + + let rec of_cil: offset -> t = function + | NoOffset -> `NoOffset + | Index (i,o) -> `Index ((), of_cil o) + | Field (f,o) -> `Field (f, of_cil o) end module Exp = diff --git a/src/domains/access.ml b/src/domains/access.ml index 076e78aeb3..255dfc18cc 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -52,49 +52,29 @@ let reset () = Hashtbl.clear typeIncl -(* TODO: Offset *) -type offs = [`NoOffset | `Index of offs | `Field of CilType.Fieldinfo.t * offs] [@@deriving eq, ord, hash] - -(* TODO: Offset *) -let rec remove_idx : offset -> offs = function - | NoOffset -> `NoOffset - | Index (_,o) -> `Index (remove_idx o) - | Field (f,o) -> `Field (f, remove_idx o) - -(* TODO: Offset *) -let rec addOffs os1 os2 : offs = - match os1 with - | `NoOffset -> os2 - | `Index os -> `Index (addOffs os os2) - | `Field (f,os) -> `Field (f, addOffs os os2) - -(* TODO: Offset *) -let rec d_offs () : offs -> doc = function - | `NoOffset -> nil - | `Index o -> dprintf "[?]%a" d_offs o - | `Field (f,o) -> dprintf ".%s%a" f.fname d_offs o +type offs = Offset.Unit.t [@@deriving eq, ord, hash] type acc_typ = [ `Type of CilType.Typ.t | `Struct of CilType.Compinfo.t * offs ] [@@deriving eq, ord, hash] let d_acct () = function | `Type t -> dprintf "(%a)" d_type t - | `Struct (s,o) -> dprintf "(struct %s)%a" s.cname d_offs o + | `Struct (s,o) -> dprintf "(struct %s)%a" s.cname Offset.Unit.pretty o let d_memo () (t, lv) = match lv with - | Some (v,o) -> dprintf "%a%a@@%a" Basetype.Variables.pretty v d_offs o CilType.Location.pretty v.vdecl + | Some (v,o) -> dprintf "%a%a@@%a" Basetype.Variables.pretty v Offset.Unit.pretty o CilType.Location.pretty v.vdecl | None -> dprintf "%a" d_acct t let rec get_type (fb: typ) : exp -> acc_typ = function | AddrOf (h,o) | StartOf (h,o) -> let rec f htyp = match htyp with - | TComp (ci,_) -> `Struct (ci,remove_idx o) + | TComp (ci,_) -> `Struct (ci, Offset.Unit.of_cil o) | TNamed (ti,_) -> f ti.ttype | _ -> `Type fb in begin match o with - | Field (f, on) -> `Struct (f.fcomp, remove_idx o) + | Field (f, on) -> `Struct (f.fcomp, Offset.Unit.of_cil o) | NoOffset | Index _ -> begin match h with | Var v -> f (v.vtype) @@ -164,7 +144,7 @@ let type_from_type_offset : acc_typ -> typ = function let rec type_from_offs (t,o) = match o with | `NoOffset -> t - | `Index os -> type_from_offs (deref t, os) + | `Index ((), os) -> type_from_offs (deref t, os) | `Field (f,os) -> type_from_offs (f.ftype, os) in unrollType (type_from_offs (TComp (s, []), o)) @@ -181,18 +161,18 @@ let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (va in List.concat_map one_field ci.cfields | TArray (t,_,_) -> - List.map (fun x -> `Index x) (dist_fields t) + List.map (fun x -> `Index ((), x)) (dist_fields t) | _ -> [`NoOffset] in match ty with | `Struct (s,os2) -> let add_lv os = match lv with - | Some (v, os1) -> Some (v, addOffs os1 os) + | Some (v, os1) -> Some (v, Offset.Unit.add_offset os1 os) | None -> None in begin try let oss = dist_fields (type_from_type_offset ty) in - List.iter (fun os -> add_one side e kind conf (`Struct (s,addOffs os2 os)) (add_lv os) a) oss + List.iter (fun os -> add_one side e kind conf (`Struct (s, Offset.Unit.add_offset os2 os)) (add_lv os) a) oss with Failure _ -> add_one side e kind conf ty lv a end @@ -320,7 +300,7 @@ let add side e kind conf vo oo a = (* let loc = !Tracing.current_loc in *) (* ignore (printf "add %a %b -- %a\n" d_exp e w d_loc loc); *) match vo, oo with - | Some v, Some o -> add_struct side e kind conf ty (Some (v, remove_idx o)) a + | Some v, Some o -> add_struct side e kind conf ty (Some (v, Offset.Unit.of_cil o)) a | _ -> if !unsound && isArithmeticType (type_from_type_offset ty) then add_struct side e kind conf ty None a @@ -374,21 +354,7 @@ struct end ) end -module O = -struct - include Printable.StdLeaf - type t = offs [@@deriving eq, ord, hash] - - let name () = "offs" - - let pretty = d_offs - include Printable.SimplePretty ( - struct - type nonrec t = t - let pretty = pretty - end - ) -end +module O = Offset.Unit module LV = Printable.Prod (CilType.Varinfo) (O) module LVOpt = Printable.Option (LV) (struct let name = "NONE" end) From 5cc72091d1e85d571fd5d3fbc7b4d90cd81c7664 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 16:48:19 +0300 Subject: [PATCH 313/518] Move more functions to Offset module --- src/analyses/base.ml | 18 ++---------------- src/cdomains/addressDomain.ml | 2 -- src/cdomains/lval.ml | 13 +------------ src/cdomains/offset.ml | 12 +++++++++++- src/cdomains/valueDomain.ml | 6 +++--- src/domains/access.ml | 8 +------- 6 files changed, 18 insertions(+), 41 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 1d57fb22e1..0914e3a73b 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -404,22 +404,12 @@ struct | _, `Bot -> `Bot | _ -> VD.top () - (* TODO: move to Offset *) - (* Auxiliary function to append an additional offset to a given offset. *) - let rec add_offset ofs add = - match ofs with - | `NoOffset -> add - | `Field (fld, `NoOffset) -> `Field (fld, add) - | `Field (fld, ofs) -> `Field (fld, add_offset ofs add) - | `Index (exp, `NoOffset) -> `Index (exp, add) - | `Index (exp, ofs) -> `Index (exp, add_offset ofs add) - (* TODO: move to Lval *) (* We need the previous function with the varinfo carried along, so we can * map it on the address sets. *) let add_offset_varinfo add ad = match Addr.to_var_offset ad with - | Some (x,ofs) -> Addr.from_var_offset (x, add_offset ofs add) + | Some (x,ofs) -> Addr.from_var_offset (x, Addr.Offs.add_offset ofs add) | None -> ad @@ -904,11 +894,7 @@ struct * to its first element [&a[0]]. *) | StartOf lval -> let array_ofs = `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset) in - let array_start ad = - match Addr.to_var_offset ad with - | Some (x, offs) -> Addr.from_var_offset (x, add_offset offs array_ofs) - | None -> ad - in + let array_start = add_offset_varinfo array_ofs in `Address (AD.map array_start (eval_lv a gs st lval)) | CastE (t, Const (CStr (x,e))) -> (* VD.top () *) eval_rv a gs st (Const (CStr (x,e))) (* TODO safe? *) | CastE (t, exp) -> diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 30143697d7..eb8f613036 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -57,8 +57,6 @@ struct type field = Addr.field type idx = Idx.t - (* TODO: Offset *) - type offs = [`NoOffset | `Field of (field * offs) | `Index of (idx * offs)] let null_ptr = singleton Addr.NullPtr let unknown_ptr = singleton Addr.UnknownPtr diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 1c6c699867..5689d1b2fe 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -199,21 +199,10 @@ struct | StrPtr None -> raise (Lattice.Unsupported "Cannot express unknown string pointer as expression.") | NullPtr -> integer 0 | UnknownPtr -> raise Lattice.TopValue - (* TODO: Offset *) - let rec add_offsets x y = match x with - | `NoOffset -> y - | `Index (i,x) -> `Index (i, add_offsets x y) - | `Field (f,x) -> `Field (f, add_offsets x y) (* TODO: unused *) let add_offset x o = match x with - | Addr (v, u) -> Addr (v, add_offsets u o) + | Addr (v, u) -> Addr (v, Offs.add_offset u o) | x -> x - (* TODO: Offset *) - let rec remove_offset = function - | `NoOffset -> `NoOffset - | `Index (_,`NoOffset) | `Field (_,`NoOffset) -> `NoOffset - | `Index (i,o) -> `Index (i, remove_offset o) - | `Field (f,o) -> `Field (f, remove_offset o) let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) end diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 6ea9127821..de77ad7afc 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -110,18 +110,28 @@ struct | `Index (i,o) -> Idx.to_int i <> None && is_definite o (* append offset o2 to o1 *) - (* TODO: unused *) let rec add_offset o1 o2 = match o1 with | `NoOffset -> o2 | `Field (f1,o1) -> `Field (f1,add_offset o1 o2) | `Index (i1,o1) -> `Index (i1,add_offset o1 o2) + let rec remove_offset = function + | `NoOffset -> `NoOffset + | `Index (_,`NoOffset) | `Field (_,`NoOffset) -> `NoOffset + | `Index (i,o) -> `Index (i, remove_offset o) + | `Field (f,o) -> `Field (f, remove_offset o) + let rec to_cil_offset (x:t) = match x with | `NoOffset -> NoOffset | `Field(f,o) -> Field(f, to_cil_offset o) | `Index(i,o) -> NoOffset (* array domain can not deal with this -> leads to being handeled as access to unknown part *) + + let rec contains_index = function + | `NoOffset -> false + | `Field (_, os) -> contains_index os + | `Index _ -> true end module MakeLattice (Idx: IntDomain.Z) = diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index a29a88adca..ae8d3c347c 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -361,7 +361,7 @@ struct M.tracel "casta" "cast to bigger size\n"; if d = Some false then err "Ptr-cast to type of incompatible size!" else if o = `NoOffset then err "Ptr-cast to outer type, but no offset to remove." - else if Addr.is_zero_offset o then adjust_offs v (Addr.remove_offset o) (Some true) + else if Addr.is_zero_offset o then adjust_offs v (Addr.Offs.remove_offset o) (Some true) else err "Ptr-cast to outer type, but possibly from non-zero offset." | _ -> (* cast to smaller/inner type *) M.tracel "casta" "cast to smaller size\n"; @@ -370,13 +370,13 @@ struct (* struct to its first field *) | TComp ({cfields = fi::_; _}, _), _ -> M.tracel "casta" "cast struct to its first field\n"; - adjust_offs v (Addr.add_offsets o (`Field (fi, `NoOffset))) (Some false) + adjust_offs v (Addr.Offs.add_offset o (`Field (fi, `NoOffset))) (Some false) (* array of the same type but different length, e.g. assign array (with length) to array-ptr (no length) *) | TArray (t1, _, _), TArray (t2, _, _) when typ_eq t1 t2 -> o (* array to its first element *) | TArray _, _ -> M.tracel "casta" "cast array to its first element\n"; - adjust_offs v (Addr.add_offsets o (`Index (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset))) (Some false) + adjust_offs v (Addr.Offs.add_offset o (`Index (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset))) (Some false) | _ -> err @@ Format.sprintf "Cast to neither array index nor struct field. is_zero_offset: %b" (Addr.is_zero_offset o) end in diff --git a/src/domains/access.ml b/src/domains/access.ml index 255dfc18cc..24ddf67558 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -184,12 +184,6 @@ let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (va let add_propagate side e kind conf ty ls a = (* ignore (printf "%a:\n" d_exp e); *) - (* TODO: Offset *) - let rec only_fields = function - | `NoOffset -> true - | `Field (_,os) -> only_fields os - | `Index _ -> false - in let struct_inv (f:offs) = let fi = match f with @@ -208,7 +202,7 @@ let add_propagate side e kind conf ty ls a = in add_struct side e kind conf ty None a; match ty with - | `Struct (c,os) when only_fields os && os <> `NoOffset -> + | `Struct (c,os) when Offset.Unit.contains_index os && os <> `NoOffset -> (* ignore (printf " * type is a struct\n"); *) struct_inv os | _ -> From dd48921e806f284371bccee55dc695bd73b407ab Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 17:23:05 +0300 Subject: [PATCH 314/518] Move offset conversions to Offset module --- src/analyses/base.ml | 17 ++--------------- src/analyses/commonPriv.ml | 9 +-------- src/analyses/malloc_null.ml | 18 ++++-------------- src/analyses/mutexAnalysis.ml | 14 +------------- src/analyses/mutexEventsAnalysis.ml | 10 +--------- src/analyses/pthreadSignals.ml | 9 +-------- src/analyses/uninit.ml | 15 +++------------ src/cdomains/offset.ml | 20 +++++++++++++++++++- src/cdomains/preValueDomain.ml | 2 +- 9 files changed, 33 insertions(+), 81 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 0914e3a73b..0cef74f651 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -612,21 +612,8 @@ struct %> f (ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.base.context.interval_set" ~removeAttr:"base.no-interval_set" ~keepAttr:"base.interval_set" fd) drop_intervalSet (* TODO: Lval *) - let convertToQueryLval x = - let rec offsNormal o = - let ik = Cilfacade.ptrdiff_ikind () in - let toInt i = - match IdxDom.to_int @@ ID.cast_to ik i with - | Some x -> Const (CInt (x,ik, None)) - | _ -> Offset.any_index_exp - in - match o with - | `NoOffset -> `NoOffset - | `Field (f,o) -> `Field (f,offsNormal o) - | `Index (i,o) -> `Index (toInt i,offsNormal o) - in - match x with - | ValueDomain.AD.Addr.Addr (v,o) ->[v,offsNormal o] + let convertToQueryLval = function + | ValueDomain.AD.Addr.Addr (v,o) -> [v, Addr.Offs.to_exp o] | _ -> [] let addrToLvalSet a = diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index af6cf9aaa5..f838c9a12a 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -125,13 +125,6 @@ struct module MustLockset = SetDomain.Reverse (Lockset) - (* TODO: Lval *) - let rec conv_offset = function - | `NoOffset -> `NoOffset - | `Field (f, o) -> `Field (f, conv_offset o) - (* TODO: better indices handling *) - | `Index (_, o) -> `Index (IdxDom.top (), conv_offset o) - let current_lockset (ask: Q.ask): Lockset.t = (* TODO: remove this global_init workaround *) if !AnalysisState.global_initialization then @@ -139,7 +132,7 @@ struct else let ls = ask.f Queries.MustLockset in Q.LS.fold (fun (var, offs) acc -> - Lockset.add (Lock.from_var_offset (var, conv_offset offs)) acc + Lockset.add (Lock.from_var_offset (var, Lock.Offs.of_exp offs)) acc ) ls (Lockset.empty ()) (* TODO: reversed SetDomain.Hoare *) diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index f151cca096..2a2e14079b 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -16,16 +16,6 @@ struct module C = ValueDomain.AddrSetDomain module P = IdentityP (D) - (* TODO: Lval *) - (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain - element) answers with Lval.any_index_exp on all non-concrete cases. *) - let rec conv_offset x = - match x with - | `NoOffset -> `NoOffset - | `Index (Const (CInt (i,ik,s)),o) -> `Index (IntDomain.of_const (i,ik,s), conv_offset o) - | `Index (_,o) -> `Index (IdxDom.top (), conv_offset o) - | `Field (f,o) -> `Field (f, conv_offset o) - (* Addr set functions: *) @@ -58,7 +48,7 @@ struct begin match a.f (Queries.MayPointTo (mkAddrOf (Var v,offs))) with | a when not (Queries.LS.is_top a) && not (Queries.LS.mem (dummyFunDec.svar,`NoOffset) a) -> - Queries.LS.iter (fun (v,o) -> warn_lval st (v, conv_offset o)) a + Queries.LS.iter (fun (v,o) -> warn_lval st (v, Offs.of_exp o)) a | _ -> () end | _ -> () @@ -118,7 +108,7 @@ struct let do_exp e = match ask.f (Queries.ReachableFrom e) with | a when not (Queries.LS.is_top a) -> - let to_extra (v,o) xs = AD.from_var_offset (v,(conv_offset o)) :: xs in + let to_extra (v,o) xs = AD.from_var_offset (v, Offs.of_exp o) :: xs in Queries.LS.fold to_extra (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) [] (* Ignore soundness warnings, as invalidation proper will raise them. *) | _ -> [] @@ -139,7 +129,7 @@ struct | a when Queries.LS.cardinal a = 1 && not (Queries.LS.mem (dummyFunDec.svar,`NoOffset) a) -> let v, o = Queries.LS.choose a in - Some (Var v, conv_offset o) + Some (Var v, Offs.of_exp o) | _ -> None let get_concrete_exp (exp:exp) gl (st:D.t) = @@ -152,7 +142,7 @@ struct match ask.f (Queries.MayPointTo (mkAddrOf lv)) with | a when not (Queries.LS.is_top a) && not (Queries.LS.mem (dummyFunDec.svar,`NoOffset) a) -> let one_addr_might (v,o) = - D.exists (fun x -> GobOption.exists (fun x -> is_prefix_of (v, conv_offset o) x) (Addr.to_var_offset x)) st + D.exists (fun x -> GobOption.exists (fun x -> is_prefix_of (v, Offs.of_exp o) x) (Addr.to_var_offset x)) st in Queries.LS.exists one_addr_might a | _ -> false diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 554d6f858b..93c114e1d4 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -148,18 +148,6 @@ struct num_mutexes := 0; sum_protected := 0 - (* TODO: Lval *) - let rec conv_offset_inv = function - | `NoOffset -> `NoOffset - | `Field (f, o) -> `Field (f, conv_offset_inv o) - | `Index (i, o) -> - let i_exp = - match ValueDomain.IndexDomain.to_int i with - | Some i -> Const (CInt (i, Cilfacade.ptrdiff_ikind (), Some (Z.to_string i))) - | None -> Offset.any_index_exp - in - `Index (i_exp, conv_offset_inv o) - let query ctx (type a) (q: a Queries.t): a Queries.result = (* get the set of mutexes protecting the variable v in the given mode *) let protecting ~write mode v = GProtecting.get ~write mode (G.protecting (ctx.global (V.protecting v))) in @@ -195,7 +183,7 @@ struct let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in let ls = Mutexes.fold (fun addr ls -> match Addr.to_var_offset addr with - | Some (var, offs) -> Queries.LS.add (var, conv_offset_inv offs) ls + | Some (var, offs) -> Queries.LS.add (var, Addr.Offs.to_exp offs) ls | None -> ls ) held_locks (Queries.LS.empty ()) in diff --git a/src/analyses/mutexEventsAnalysis.ml b/src/analyses/mutexEventsAnalysis.ml index 4b24e784f6..54ae92d8bb 100644 --- a/src/analyses/mutexEventsAnalysis.ml +++ b/src/analyses/mutexEventsAnalysis.ml @@ -19,16 +19,8 @@ struct let name () = "mutexEvents" (* TODO: Lval *) - (* Currently we care only about concrete indexes. *) - let rec conv_offset x = - match x with - | `NoOffset -> `NoOffset - | `Index (Const (CInt (i,_,s)),o) -> `Index (IntDomain.of_const (i,Cilfacade.ptrdiff_ikind (),s), conv_offset o) - | `Index (_,o) -> `Index (ValueDomain.IndexDomain.top (), conv_offset o) - | `Field (f,o) -> `Field (f, conv_offset o) - let eval_exp_addr (a: Queries.ask) exp = - let gather_addr (v,o) b = ValueDomain.Addr.from_var_offset (v,conv_offset o) :: b in + let gather_addr (v,o) b = ValueDomain.Addr.from_var_offset (v, Addr.Offs.of_exp o) :: b in match a.f (Queries.MayPointTo exp) with | a when Queries.LS.is_top a -> [Addr.UnknownPtr] diff --git a/src/analyses/pthreadSignals.ml b/src/analyses/pthreadSignals.ml index 2a17f47837..f31f5cfa4e 100644 --- a/src/analyses/pthreadSignals.ml +++ b/src/analyses/pthreadSignals.ml @@ -18,15 +18,8 @@ struct module G = SetDomain.ToppedSet (MHP) (struct let topname = "All Threads" end) (* TODO: Lval *) - let rec conv_offset x = - match x with - | `NoOffset -> `NoOffset - | `Index (Const (CInt (i,_,s)),o) -> `Index (IntDomain.of_const (i,Cilfacade.ptrdiff_ikind (),s), conv_offset o) - | `Index (_,o) -> `Index (ValueDomain.IndexDomain.top (), conv_offset o) - | `Field (f,o) -> `Field (f, conv_offset o) - let eval_exp_addr (a: Queries.ask) exp = - let gather_addr (v,o) b = ValueDomain.Addr.from_var_offset (v,conv_offset o) :: b in + let gather_addr (v,o) b = ValueDomain.Addr.from_var_offset (v, ValueDomain.Addr.Offs.of_exp o) :: b in match a.f (Queries.MayPointTo exp) with | a when not (Queries.LS.is_top a) && not (Queries.LS.mem (dummyFunDec.svar,`NoOffset) a) -> Queries.LS.fold gather_addr (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) [] diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 9b1db639df..956ada1ce2 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -30,19 +30,10 @@ struct let exitstate v : D.t = D.empty () (* TODO: Lval *) - (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain - element) answers with Lval.any_index_exp on all non-concrete cases. *) - let rec conv_offset x = - match x with - | `NoOffset -> `NoOffset - | `Index (Const (CInt (i,ik,s)),o) -> `Index (IntDomain.of_const (i,ik,s), conv_offset o) - | `Index (_,o) -> `Index (IdxDom.top (), conv_offset o) - | `Field (f,o) -> `Field (f, conv_offset o) - let access_address (ask: Queries.ask) write lv = match ask.f (Queries.MayPointTo (AddrOf lv)) with | a when not (Queries.LS.is_top a) -> - let to_extra (v,o) xs = (v, Base.Offs.from_offset (conv_offset o), write) :: xs in + let to_extra (v,o) xs = (v, Base.Offs.from_offset (Addr.Offs.of_exp o), write) :: xs in Queries.LS.fold to_extra a [] | _ -> M.info ~category:Unsound "Access to unknown address could be global"; [] @@ -192,7 +183,7 @@ struct match a.f (Queries.MayPointTo (AddrOf lv)) with | a when Queries.LS.cardinal a = 1 -> begin let var, ofs = Queries.LS.choose a in - init_vo var (conv_offset ofs) + init_vo var (Addr.Offs.of_exp ofs) end | _ -> st @@ -217,7 +208,7 @@ struct let do_exp e = match ask.f (Queries.ReachableFrom e) with | a when not (Queries.LS.is_top a) -> - let to_extra (v,o) xs = AD.from_var_offset (v,(conv_offset o)) :: xs in + let to_extra (v,o) xs = AD.from_var_offset (v, Addr.Offs.of_exp o) :: xs in Queries.LS.fold to_extra (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) [] (* Ignore soundness warnings, as invalidation proper will raise them. *) | _ -> [] diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index de77ad7afc..e08388859b 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -122,12 +122,22 @@ struct | `Index (i,o) -> `Index (i, remove_offset o) | `Field (f,o) -> `Field (f, remove_offset o) - let rec to_cil_offset (x:t) = + let rec to_cil_offset (x:t) = (* TODO: rename/move *) match x with | `NoOffset -> NoOffset | `Field(f,o) -> Field(f, to_cil_offset o) | `Index(i,o) -> NoOffset (* array domain can not deal with this -> leads to being handeled as access to unknown part *) + let rec to_exp: t -> exp offs = function + | `NoOffset -> `NoOffset + | `Index (i,o) -> + let i_exp = match Idx.to_int i with + | Some i -> Const (CInt (i, Cilfacade.ptrdiff_ikind (), Some (Z.to_string i))) + | None -> any_index_exp + in + `Index (i_exp, to_exp o) + | `Field (f,o) -> `Field (f, to_exp o) + let rec contains_index = function | `NoOffset -> false | `Field (_, os) -> contains_index os @@ -162,6 +172,14 @@ struct | `Index (x, o) -> `Index (Idx.top (), drop_ints o) | `Field (x, o) -> `Field (x, drop_ints o) | `NoOffset -> `NoOffset + + (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain + element) answers with any_index_exp on all non-concrete cases. *) + let rec of_exp: exp offs -> t = function + | `NoOffset -> `NoOffset + | `Index (Const (CInt (i,ik,s)),o) -> `Index (Idx.of_int ik i, of_exp o) + | `Index (_,o) -> `Index (Idx.top (), of_exp o) + | `Field (f,o) -> `Field (f, of_exp o) end module Unit = diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml index 6097778ecb..3d4dd6b5c4 100644 --- a/src/cdomains/preValueDomain.ml +++ b/src/cdomains/preValueDomain.ml @@ -1,5 +1,5 @@ module ID = IntDomain.IntDomTuple module FD = FloatDomain.FloatDomTupleImpl -module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind) +module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind) (* TODO: add ptrdiff cast into to_int? *) module AD = AddressDomain.AddressSet (IndexDomain) module Addr = Lval.NormalLat (IndexDomain) From c6648e6e66b1afe9b1317258d5a2d056f85ab0eb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 17:44:27 +0300 Subject: [PATCH 315/518] Add top_indices to Offset modules --- src/analyses/region.ml | 9 ++------- src/cdomains/lval.ml | 2 +- src/cdomains/offset.ml | 14 ++++++++------ src/cdomains/symbLocksDomain.ml | 1 + 4 files changed, 12 insertions(+), 14 deletions(-) diff --git a/src/analyses/region.ml b/src/analyses/region.ml index 6f4b0335d2..f0706af6e1 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -82,13 +82,8 @@ struct Some (Lvals.empty ()) | Memory {exp = e; _} -> (* TODO: remove regions that cannot be reached from the var*) - (* TODO: Offset *) - let rec unknown_index = function - | `NoOffset -> `NoOffset - | `Field (f, os) -> `Field (f, unknown_index os) - | `Index (i, os) -> `Index (Offset.any_index_exp, unknown_index os) (* forget specific indices *) - in - Option.map (Lvals.of_list % List.map (Tuple2.map2 unknown_index)) (get_region ctx e) + (* forget specific indices *) + Option.map (Lvals.of_list % List.map (Tuple2.map2 Offset.Exp.top_indices)) (get_region ctx e) (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 5689d1b2fe..82850d5c7d 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -253,7 +253,7 @@ struct | _ -> x = y let drop_ints = function - | Addr (x, o) -> Addr (x, Offs.drop_ints o) + | Addr (x, o) -> Addr (x, Offs.top_indices o) | x -> x let join_string_ptr x y = match x, y with diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index e08388859b..2f2c4e0198 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -29,6 +29,7 @@ struct include Printable.S val equal_to: IntOps.BigIntOps.t -> t -> [`Eq | `Neq | `Top] val to_int: t -> IntOps.BigIntOps.t option + val top: unit -> t end module type Lattice = IntDomain.Z @@ -36,7 +37,7 @@ struct module Unit: Printable with type t = unit = struct - include Printable.Unit + include Lattice.Unit let equal_to _ _ = `Top let to_int _ = None end @@ -61,6 +62,7 @@ struct let equal_to _ _ = `Top (* TODO: more precise for definite indices *) let to_int _ = None (* TODO: more precise for definite indices *) + let top () = any_index_exp end end @@ -142,6 +144,11 @@ struct | `NoOffset -> false | `Field (_, os) -> contains_index os | `Index _ -> true + + let rec top_indices = function + | `Index (x, o) -> `Index (Idx.top (), top_indices o) + | `Field (x, o) -> `Field (x, top_indices o) + | `NoOffset -> `NoOffset end module MakeLattice (Idx: IntDomain.Z) = @@ -168,11 +175,6 @@ struct let widen x y = merge `Widen x y let narrow x y = merge `Narrow x y - let rec drop_ints = function - | `Index (x, o) -> `Index (Idx.top (), drop_ints o) - | `Field (x, o) -> `Field (x, drop_ints o) - | `NoOffset -> `NoOffset - (* NB! Currently we care only about concrete indexes. Base (seeing only a int domain element) answers with any_index_exp on all non-concrete cases. *) let rec of_exp: exp offs -> t = function diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index d03b2dcb16..b97c541efe 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -302,6 +302,7 @@ struct let equal_to _ _ = `Top let to_int _ = None + let top () = Unknown end include Lval.Normal (Idx) From 22f5673397ce047f458f5449c1ed574851626ff2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 17:50:52 +0300 Subject: [PATCH 316/518] Add readable type signatures to Offset --- src/cdomains/offset.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 2f2c4e0198..8393f53652 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -87,7 +87,7 @@ struct | `Field (x, o) -> if is_first_field x then cmp_zero_offset o else `MustNonzero - let rec show = function + let rec show: t -> string = function | `NoOffset -> "" | `Index (x,o) -> "[" ^ (Idx.show x) ^ "]" ^ (show o) | `Field (x,o) -> "." ^ (x.fname) ^ (show o) @@ -106,19 +106,19 @@ struct let from_offset x = x - let rec is_definite = function + let rec is_definite: t -> bool = function | `NoOffset -> true | `Field (f,o) -> is_definite o | `Index (i,o) -> Idx.to_int i <> None && is_definite o (* append offset o2 to o1 *) - let rec add_offset o1 o2 = + let rec add_offset (o1: t) (o2: t): t = match o1 with | `NoOffset -> o2 | `Field (f1,o1) -> `Field (f1,add_offset o1 o2) | `Index (i1,o1) -> `Index (i1,add_offset o1 o2) - let rec remove_offset = function + let rec remove_offset: t -> t = function | `NoOffset -> `NoOffset | `Index (_,`NoOffset) | `Field (_,`NoOffset) -> `NoOffset | `Index (i,o) -> `Index (i, remove_offset o) @@ -140,12 +140,12 @@ struct `Index (i_exp, to_exp o) | `Field (f,o) -> `Field (f, to_exp o) - let rec contains_index = function + let rec contains_index: t -> bool = function | `NoOffset -> false | `Field (_, os) -> contains_index os | `Index _ -> true - let rec top_indices = function + let rec top_indices: t -> t = function | `Index (x, o) -> `Index (Idx.top (), top_indices o) | `Field (x, o) -> `Field (x, top_indices o) | `NoOffset -> `NoOffset From 62c591e8629fea79b4eb10cebb03f831504a428e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 17:53:04 +0300 Subject: [PATCH 317/518] Add pointless from_offset identity function --- src/analyses/uninit.ml | 2 +- src/cdomains/offset.ml | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 956ada1ce2..4eda2c5a9b 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -33,7 +33,7 @@ struct let access_address (ask: Queries.ask) write lv = match ask.f (Queries.MayPointTo (AddrOf lv)) with | a when not (Queries.LS.is_top a) -> - let to_extra (v,o) xs = (v, Base.Offs.from_offset (Addr.Offs.of_exp o), write) :: xs in + let to_extra (v,o) xs = (v, Addr.Offs.of_exp o, write) :: xs in Queries.LS.fold to_extra a [] | _ -> M.info ~category:Unsound "Access to unknown address could be global"; [] diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 8393f53652..a5c71ae4a0 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -104,8 +104,6 @@ struct let name () = "Offset" - let from_offset x = x - let rec is_definite: t -> bool = function | `NoOffset -> true | `Field (f,o) -> is_definite o From d66f89a8ea8838d9f21ac7b37430d420235e82d6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 18:34:40 +0300 Subject: [PATCH 318/518] Use Offset module for region domain --- src/cdomains/lval.ml | 85 +++++++++++++----------------------- src/cdomains/musteqDomain.ml | 19 ++++---- src/cdomains/regionDomain.ml | 14 +++--- 3 files changed, 48 insertions(+), 70 deletions(-) diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 82850d5c7d..85fa22ddae 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -354,93 +354,70 @@ struct module F = CilType.Fieldinfo module I = Basetype.CilExp module FI = Printable.Either (F) (I) - include Printable.Liszt (FI) - let rec show x = match x with - | [] -> "" - | (`Left x :: xs) -> "." ^ F.show x ^ show xs - | (`Right x :: xs) -> "[" ^ I.show x ^ "]" ^ show xs + include Offset.Exp - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) + let listify: offset -> t = of_cil + let to_offs': t -> t = Fun.id - let rec printInnerXml f = function - | [] -> () - | (`Left x :: xs) -> - BatPrintf.fprintf f ".%s%a" (F.show x) printInnerXml xs - | (`Right x :: xs) -> - BatPrintf.fprintf f "[%s]%a" (I.show x) printInnerXml xs - let printXml f x = BatPrintf.fprintf f "\n\n%a\n\n\n" printInnerXml x + let rec kill v (fds: t): t = match fds with + | `Index (x, xs) when I.occurs v x -> `NoOffset + | `Index (x, xs) -> `Index (x, kill v xs) + | `Field (x, xs) -> `Field (x, kill v xs) + | `NoOffset -> `NoOffset - let rec listify ofs: t = + let rec replace x exp ofs = match ofs with - | NoOffset -> [] - | Field (x,ofs) -> `Left x :: listify ofs - | Index (i,ofs) -> `Right i :: listify ofs - - let rec to_offs' (ofs:t) = match ofs with - | (`Left x::xs) -> `Field (x, to_offs' xs) - | (`Right x::xs) -> `Index (x, to_offs' xs) - | [] -> `NoOffset - - let rec kill v (fds: t): t = match fds with - | (`Right x::xs) when I.occurs v x -> [] - | (x::xs) -> x :: kill v xs - | [] -> [] - - let replace x exp ofs = - let f o = match o with - | `Right e -> `Right (I.replace x exp e) - | x -> x - in - List.map f ofs + | `NoOffset -> `NoOffset + | `Field (f, o) -> `Field (f, replace x exp o) + | `Index (e, o) -> `Index (I.replace x exp e, replace x exp o) - let top () = [] - let is_top x = x = [] + let top () = `NoOffset + let is_top x = x = `NoOffset let bot () = failwith "Bottom offset list!" let is_bot x = false let rec leq x y = match x,y with - | _, [] -> true - | x::xs, y::ys when FI.equal x y -> leq xs ys + | _, `NoOffset -> true + | `Index (x, xs), `Index (y, ys) when I.equal x y -> leq xs ys + | `Field (x, xs), `Field (y, ys) when F.equal x y -> leq xs ys | _ -> false let rec meet x y = match x,y with - | [], x | x, [] -> x - | x::xs, y::ys when FI.equal x y -> x :: meet xs ys + | `NoOffset, x | x, `NoOffset -> x + | `Index (x, xs), `Index (y, ys) when I.equal x y -> `Index (x, meet xs ys) + | `Field (x, xs), `Field (y, ys) when F.equal x y -> `Field (x, meet xs ys) | _ -> failwith "Arguments do not meet" let narrow = meet let rec join x y = match x,y with - | x::xs, y::ys when FI.equal x y -> x :: join xs ys - | _ -> [] + | `Index (x, xs), `Index (y, ys) when I.equal x y -> `Index (x, join xs ys) + | `Field (x, xs), `Field (y, ys) when F.equal x y -> `Field (x, join xs ys) + | _ -> `NoOffset let widen = join let rec collapse x y = match x,y with - | [], x | x, [] -> true - | x :: xs, y :: ys when FI.equal x y -> collapse xs ys - | `Left x::xs, `Left y::ys -> false - | `Right x::xs, `Right y::ys -> true + | `NoOffset, x | x, `NoOffset -> true + | `Index (x, xs), `Index (y, ys) when I.equal x y -> collapse xs ys + | `Field (x, xs), `Field (y, ys) when F.equal x y -> collapse xs ys + | `Field (x, xs), `Field (y, ys) -> false + | `Index (x, xs), `Index (y, ys) -> true | _ -> failwith "Type mismatch!" (* TODO: use the type information to do this properly. Currently, this assumes * there are no nested arrays, so all indexing is eliminated. *) let rec real_region (fd:t) typ: bool = match fd with - | [] -> true - | `Left _ :: xs -> real_region xs typ - | `Right i :: _ -> false + | `NoOffset -> true + | `Field (_, xs) -> real_region xs typ + | `Index (i, _) -> false let pretty_diff () ((x:t),(y:t)): Pretty.doc = Pretty.dprintf "%a not leq %a" pretty x pretty y diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index 13acbca5fe..d0cbf788d5 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -9,16 +9,17 @@ struct include Lval.Fields let rec prefix x y = match x,y with - | (x::xs), (y::ys) when FI.equal x y -> prefix xs ys - | [], ys -> Some ys + | `Index (x, xs), `Index (y, ys) when I.equal x y -> prefix xs ys + | `Field (x, xs), `Field (y, ys) when F.equal x y -> prefix xs ys + | `NoOffset, ys -> Some ys | _ -> None - let append x y: t = x @ y + let append x y: t = add_offset x y let rec occurs v fds = match fds with - | (`Left x::xs) -> occurs v xs - | (`Right x::xs) -> I.occurs v x || occurs v xs - | [] -> false + | `Field (x, xs) -> occurs v xs + | `Index (x, xs) -> I.occurs v x || occurs v xs + | `NoOffset -> false end module EquAddr = @@ -65,7 +66,7 @@ struct in fold f d (add_old (x,y) fd d) in - if fd = [] then add_closure (y,x) [] (add_closure (x,y) [] d) + if fd = `NoOffset then add_closure (y,x) `NoOffset (add_closure (x,y) `NoOffset d) else add_closure (x,y) fd d let kill x d = @@ -96,7 +97,7 @@ struct let eval_rv rv: EquAddr.t option = match rv with - | Lval (Var x, NoOffset) -> Some (x, []) + | Lval (Var x, NoOffset) -> Some (x, `NoOffset) | AddrOf (Var x, ofs) | AddrOf (Mem (Lval (Var x, NoOffset)), ofs) -> Some (x, F.listify ofs) | _ -> None @@ -106,7 +107,7 @@ struct | Var x, NoOffset -> Some x | _ -> None - let add_eq (x,y) d = add (x,y) [] d + let add_eq (x,y) d = add (x,y) `NoOffset d let assign lval rval st = match lval with diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index 9788beec61..b45b750ca0 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -17,7 +17,7 @@ struct let pretty () x = Pretty.text (show x) let printXml f (v,fi) = - BatPrintf.fprintf f "\n\n%s%a\n\n\n" (XmlUtil.escape (V.show v)) F.printInnerXml fi + BatPrintf.fprintf f "\n\n%s%a\n\n\n" (XmlUtil.escape (V.show v)) F.printXml fi (* Indicates if the two var * offset pairs should collapse or not. *) let collapse (v1,f1) (v2,f2) = V.equal v1 v2 && F.collapse f1 f2 @@ -119,7 +119,7 @@ struct let is_global (v,fd) = v.vglob - let remove v (p,m) = p, RegMap.remove (v,[]) m + let remove v (p,m) = p, RegMap.remove (v, `NoOffset) m let remove_vars (vs: varinfo list) (cp:t): t = List.fold_right remove vs cp @@ -142,7 +142,7 @@ struct type eval_t = (bool * elt * F.t) option let eval_exp exp: eval_t = - let offsornot offs = if (get_bool "exp.region-offsets") then F.listify offs else [] in + let offsornot offs = if (get_bool "exp.region-offsets") then F.listify offs else `NoOffset in (* The intuition for the offset computations is that we keep the static _suffix_ of an * access path. These can be used to partition accesses when fields do not overlap. * This means that for pointer dereferences and when obtaining the value from an lval @@ -150,7 +150,7 @@ struct * unknown in the region. *) let rec eval_rval deref rval = match rval with - | Lval lval -> BatOption.map (fun (deref, v, offs) -> (deref, v, [])) (eval_lval deref lval) + | Lval lval -> BatOption.map (fun (deref, v, offs) -> (deref, v, `NoOffset)) (eval_lval deref lval) | AddrOf lval -> eval_lval deref lval | CastE (typ, exp) -> eval_rval deref exp | BinOp (MinusPI, p, i, typ) @@ -159,7 +159,7 @@ struct | _ -> None and eval_lval deref lval = match lval with - | (Var x, offs) -> Some (deref, (x, offsornot offs), []) + | (Var x, offs) -> Some (deref, (x, offsornot offs), `NoOffset) | (Mem exp,offs) -> match eval_rval true exp with | Some (deref, v, _) -> Some (deref, v, offsornot offs) @@ -193,7 +193,7 @@ struct if VF.equal x y then st else let (p,m) = st in begin let append_offs_y = RS.map (function - | `Left (v, offs) -> `Left (v, offs @ offs_y) + | `Left (v, offs) -> `Left (v, F.add_offset offs offs_y) | `Right () -> `Right () ) in @@ -228,7 +228,7 @@ struct | _ -> p,m let related_globals (deref_vfd: eval_t) (p,m: t): elt list = - let add_o o2 (v,o) = (v,o@o2) in + let add_o o2 (v,o) = (v, F.add_offset o o2) in match deref_vfd with | Some (true, vfd, os) -> let vfd_class = From d831e87b25e92ece14332b0ced7f90830d8f0e5b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 May 2023 18:49:56 +0300 Subject: [PATCH 319/518] Clean up region domain offsets --- src/analyses/region.ml | 3 +-- src/cdomains/lval.ml | 17 ++--------------- src/cdomains/musteqDomain.ml | 10 ++++------ src/cdomains/offset.ml | 8 +++++--- src/cdomains/regionDomain.ml | 2 +- 5 files changed, 13 insertions(+), 27 deletions(-) diff --git a/src/analyses/region.ml b/src/analyses/region.ml index f0706af6e1..c9642a3344 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -27,8 +27,7 @@ struct match st with | `Lifted reg -> let ev = Reg.eval_exp exp in - let to_exp (v,f) = (v,Lval.Fields.to_offs' f) in - List.map to_exp (Reg.related_globals ev (part,reg)) + Reg.related_globals ev (part,reg) | `Top -> Messages.info ~category:Unsound "Region state is broken :("; [] | `Bot -> [] diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 85fa22ddae..7830fcc974 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -353,25 +353,16 @@ module Fields = struct module F = CilType.Fieldinfo module I = Basetype.CilExp - module FI = Printable.Either (F) (I) include Offset.Exp - let listify: offset -> t = of_cil - let to_offs': t -> t = Fun.id - - let rec kill v (fds: t): t = match fds with | `Index (x, xs) when I.occurs v x -> `NoOffset | `Index (x, xs) -> `Index (x, kill v xs) | `Field (x, xs) -> `Field (x, kill v xs) | `NoOffset -> `NoOffset - let rec replace x exp ofs = - match ofs with - | `NoOffset -> `NoOffset - | `Field (f, o) -> `Field (f, replace x exp o) - | `Index (e, o) -> `Index (I.replace x exp e, replace x exp o) + let replace x exp = map_indices (I.replace x exp) let top () = `NoOffset let is_top x = x = `NoOffset @@ -413,11 +404,7 @@ struct (* TODO: use the type information to do this properly. Currently, this assumes * there are no nested arrays, so all indexing is eliminated. *) - let rec real_region (fd:t) typ: bool = - match fd with - | `NoOffset -> true - | `Field (_, xs) -> real_region xs typ - | `Index (i, _) -> false + let real_region (fd:t) typ: bool = not (contains_index fd) let pretty_diff () ((x:t),(y:t)): Pretty.doc = Pretty.dprintf "%a not leq %a" pretty x pretty y diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index d0cbf788d5..0ae959172f 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -14,8 +14,6 @@ struct | `NoOffset, ys -> Some ys | _ -> None - let append x y: t = add_offset x y - let rec occurs v fds = match fds with | `Field (x, xs) -> occurs v xs | `Index (x, xs) -> I.occurs v x || occurs v xs @@ -84,7 +82,7 @@ struct if List.exists (EquAddr.equal (v,fd)) addrs then addrs else let f (x,y) fd' acc = if V.equal v x then - helper (y, F.append fd' fd) acc + helper (y, F.add_offset fd' fd) acc else if V.equal v y then (match F.prefix fd' fd with | Some rest -> helper (x,rest) acc @@ -99,7 +97,7 @@ struct match rv with | Lval (Var x, NoOffset) -> Some (x, `NoOffset) | AddrOf (Var x, ofs) - | AddrOf (Mem (Lval (Var x, NoOffset)), ofs) -> Some (x, F.listify ofs) + | AddrOf (Mem (Lval (Var x, NoOffset)), ofs) -> Some (x, F.of_cil ofs) | _ -> None let eval_lv lv = @@ -118,9 +116,9 @@ struct | Lval (Var y, NoOffset) when y.vname.[0] = '{' -> st | AddrOf (Var y, NoOffset) when y.vname.[0] = '{' -> st | Lval (Var y, NoOffset) -> add_eq (x,y) st - | AddrOf (Var y, ofs) -> add (x,y) (F.listify ofs) st + | AddrOf (Var y, ofs) -> add (x,y) (F.of_cil ofs) st | AddrOf (Mem (Lval (Var y, NoOffset)), ofs) -> - add (x,y) (F.listify ofs) st + add (x,y) (F.of_cil ofs) st | _ -> st end | _ -> st diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index a5c71ae4a0..0aa5b69c60 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -143,10 +143,12 @@ struct | `Field (_, os) -> contains_index os | `Index _ -> true - let rec top_indices: t -> t = function - | `Index (x, o) -> `Index (Idx.top (), top_indices o) - | `Field (x, o) -> `Field (x, top_indices o) + let rec map_indices g: t -> t = function | `NoOffset -> `NoOffset + | `Field (f, o) -> `Field (f, map_indices g o) + | `Index (i, o) -> `Index (g i, map_indices g o) + + let top_indices = map_indices (fun _ -> Idx.top ()) end module MakeLattice (Idx: IntDomain.Z) = diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index b45b750ca0..2a00adeb89 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -142,7 +142,7 @@ struct type eval_t = (bool * elt * F.t) option let eval_exp exp: eval_t = - let offsornot offs = if (get_bool "exp.region-offsets") then F.listify offs else `NoOffset in + let offsornot offs = if (get_bool "exp.region-offsets") then F.of_cil offs else `NoOffset in (* The intuition for the offset computations is that we keep the static _suffix_ of an * access path. These can be used to partition accesses when fields do not overlap. * This means that for pointer dereferences and when obtaining the value from an lval From 9b3ca6edb27a0c6c1e2cb1cd9e2dd666112c1117 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 30 May 2023 17:58:57 +0200 Subject: [PATCH 320/518] Add example highlighting problem --- tests/regression/40-threadid/04-recover.c | 38 +++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 tests/regression/40-threadid/04-recover.c diff --git a/tests/regression/40-threadid/04-recover.c b/tests/regression/40-threadid/04-recover.c new file mode 100644 index 0000000000..a5cba83d74 --- /dev/null +++ b/tests/regression/40-threadid/04-recover.c @@ -0,0 +1,38 @@ +// PARAM: --set ana.activated[+] threadJoins +#include +#include + +// not marked as a wrapper this time +int my_pthread_create( + pthread_t *restrict thread, + const pthread_attr_t *restrict attr, + void *(*start_routine)(void *), + void *restrict arg +) { + return pthread_create(thread, attr, start_routine, arg); +} + + +int g = 0; +pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&A); + g = 1; + pthread_mutex_unlock(&A); + return NULL; +} + +int main() { + pthread_t id1; + my_pthread_create(&id1, NULL, t_fun, 0); + pthread_t id2; + my_pthread_create(&id2, NULL, t_fun, 0); + + pthread_join(id1, NULL); + + + g = 2; // RACE + + return 0; +} From 4f28ce92ccd6db317b7510c06eeca3dda46e5f5d Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 31 May 2023 09:31:56 +0200 Subject: [PATCH 321/518] Add set of multiply encountered ids to include all threads in created. --- src/cdomains/threadIdDomain.ml | 37 ++++++++++++++++------- tests/regression/40-threadid/04-recover.c | 2 +- 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/src/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml index c075df4a5f..a081835b34 100644 --- a/src/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -36,7 +36,7 @@ sig val threadenter: t * D.t -> Node.t -> int option -> varinfo -> t list val threadspawn: D.t -> Node.t -> int option -> varinfo -> D.t - (** If it is possible to get a list of unique thread create thus far, get it *) + (** If it is possible to get a list of threads created thus far, get it *) val created: t -> D.t -> (t list) option end @@ -124,11 +124,14 @@ struct let show x = GobPretty.sprint pretty x - module D = - struct + module D = Lattice.Prod (struct + include S + let name () = "created (once)" + end) (struct include S - let name () = "created" - end + let name () = "created (multiple times)" + end) + let is_unique (_, s) = S.is_empty s @@ -160,7 +163,7 @@ struct else ([base_tid], S.empty ()) - let threadenter ((p, _ ) as current, cs) (n: Node.t) i v = + let threadenter ((p, _ ) as current, (cs,_)) (n: Node.t) i v = let ni = Base.threadenter n i v in let ((p', s') as composed) = compose current ni in if is_unique composed && S.mem ni cs then @@ -168,12 +171,24 @@ struct else [composed] - let created current cs = - let els = D.elements cs in - Some (List.map (compose current) els) + let created ((p, _ ) as current) (cs, cms) = + let els = S.elements cs in + let map_one e = + let ((p', s') as composed) = compose current e in + if is_unique composed && S.mem e cms then + (* Also construct the non-unique version that was spawned as e was encountered multiple times *) + [(p, S.singleton e); composed] + else + [composed] + in + Some (List.concat_map map_one els) - let threadspawn cs l i v = - S.add (Base.threadenter l i v) cs + let threadspawn (cs,cms) l i v = + let e = Base.threadenter l i v in + if S.mem e cs then + (cs, S.add e cms) + else + (S.add e cs, cms) let is_main = function | ([fl], s) when S.is_empty s && Base.is_main fl -> true diff --git a/tests/regression/40-threadid/04-recover.c b/tests/regression/40-threadid/04-recover.c index a5cba83d74..2c2110fea8 100644 --- a/tests/regression/40-threadid/04-recover.c +++ b/tests/regression/40-threadid/04-recover.c @@ -2,7 +2,7 @@ #include #include -// not marked as a wrapper this time +// not marked as a wrapper int my_pthread_create( pthread_t *restrict thread, const pthread_attr_t *restrict attr, From 587db3db4fabea686e633eedfa9d6a4236e01fe7 Mon Sep 17 00:00:00 2001 From: Nathan Schmidt Date: Wed, 31 May 2023 10:39:37 +0200 Subject: [PATCH 322/518] Handle null byte in string correctly for all functions --- src/cdomains/addressDomain.ml | 10 ++--- src/cdomains/lval.ml | 22 ++++++---- .../01-string_literals.c | 5 --- .../73-strings/02-string_literals_with_null.c | 44 +++++++++++++++++++ .../03-string_basics.c} | 0 5 files changed, 63 insertions(+), 18 deletions(-) rename tests/regression/{71-strings => 73-strings}/01-string_literals.c (95%) create mode 100644 tests/regression/73-strings/02-string_literals_with_null.c rename tests/regression/{71-strings/02-string_basics.c => 73-strings/03-string_basics.c} (100%) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index c6c2a56767..9e67069291 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -118,8 +118,8 @@ struct let substring_extraction haystack needle = (* map all StrPtr elements in input address sets to contained strings *) - let haystack' = List.map Addr.to_string (elements haystack) in - let needle' = List.map Addr.to_string (elements needle) in + let haystack' = List.map Addr.to_c_string (elements haystack) in + let needle' = List.map Addr.to_c_string (elements needle) in (* helper functions *) let extract_lval_string = function @@ -144,8 +144,8 @@ struct let string_comparison x y n = let f = match n with - | Some num -> Addr.to_n_string num - | None -> Addr.to_string in + | Some num -> Addr.to_n_c_string num + | None -> Addr.to_c_string in (* map all StrPtr elements in input address sets to contained strings / n-substrings *) let x' = List.map f (elements x) in @@ -172,7 +172,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_string (elements dest)) then + if List.exists Option.is_some (List.map Addr.to_c_string (elements 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 diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 2f7736c3ce..a396e25fac 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -256,8 +256,17 @@ struct let to_string = function | StrPtr (Some x) -> Some x | _ -> None - let to_n_string n = function - | StrPtr (Some x) -> + (* only keep part before first null byte *) + let to_c_string = function + | StrPtr (Some x) -> + begin match String.split_on_char '\x00' x with + | s::_ -> Some s + | [] -> None + end + | _ -> None + let to_n_c_string n x = + match to_c_string x with + | Some x -> if n > String.length x then Some x else if n < 0 then @@ -265,12 +274,9 @@ struct else Some (String.sub x 0 n) | _ -> None - let to_string_length = function - | StrPtr (Some x) -> - begin match String.split_on_char '\x00' x with - | s::_ -> Some (String.length s) - | [] -> None - end + let to_string_length x = + match to_c_string x with + | Some x -> Some (String.length x) | _ -> None (* exception if the offset can't be followed completely *) diff --git a/tests/regression/71-strings/01-string_literals.c b/tests/regression/73-strings/01-string_literals.c similarity index 95% rename from tests/regression/71-strings/01-string_literals.c rename to tests/regression/73-strings/01-string_literals.c index 190760bca0..36e4ed121c 100644 --- a/tests/regression/71-strings/01-string_literals.c +++ b/tests/regression/73-strings/01-string_literals.c @@ -2,7 +2,6 @@ #include #include -#include char* hello_world() { return "Hello world!"; @@ -22,7 +21,6 @@ int main() { char* s1 = "abcde"; char* s2 = "abcdfg"; char* s3 = hello_world(); - char* edge_case = "hello\0world"; int i = strlen(s1); __goblint_check(i == 5); @@ -33,9 +31,6 @@ int main() { i = strlen(s3); __goblint_check(i == 12); - i = strlen(edge_case); - __goblint_check(i == 5); - i = strcmp(s1, s2); __goblint_check(i < 0); diff --git a/tests/regression/73-strings/02-string_literals_with_null.c b/tests/regression/73-strings/02-string_literals_with_null.c new file mode 100644 index 0000000000..75d000bbb8 --- /dev/null +++ b/tests/regression/73-strings/02-string_literals_with_null.c @@ -0,0 +1,44 @@ +// PARAM: --disable ana.base.limit-string-addresses --enable ana.int.interval + +#include +#include + +int main() { + char* s1 = "hello\0 world\0!"; + char* s2 = "hello"; + char* s3 = "hello world!"; + char* s4 = "\0 i am the empty string"; + + int i = strlen(s1); + __goblint_check(i == 5); + + i = strcmp(s1, s2); + __goblint_check(i == 0); + + i = strcmp(s3, s1); + __goblint_check(i > 0); + + i = strcmp(s4, ""); + __goblint_check(i == 0); + + i = strncmp(s1, s3, 5); + __goblint_check(i == 0); + + i = strncmp(s2, s1, 7); + __goblint_check(i == 0); + + char* cmp = strstr(s3, s1); + i = strcmp(cmp, "hello world!"); + __goblint_check(i == 0); + + cmp = strstr(s1, "world"); + __goblint_check(cmp == NULL); + + cmp = strstr(s1, s4); + i = strcmp(cmp, s1); + __goblint_check(i == 0); + i = strcmp(cmp, "hello"); + __goblint_check(i == 0); + + return 0; +} \ No newline at end of file diff --git a/tests/regression/71-strings/02-string_basics.c b/tests/regression/73-strings/03-string_basics.c similarity index 100% rename from tests/regression/71-strings/02-string_basics.c rename to tests/regression/73-strings/03-string_basics.c From 18e4eacb657a375f7d0e42aae8836737246039a1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 May 2023 11:45:13 +0300 Subject: [PATCH 323/518] Move Lval.Fields to MusteqDomain --- src/cdomains/lockDomain.ml | 1 - src/cdomains/lval.ml | 61 ------------------------------------ src/cdomains/musteqDomain.ml | 58 +++++++++++++++++++++++++++++++++- src/cdomains/regionDomain.ml | 2 +- 4 files changed, 58 insertions(+), 64 deletions(-) diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 1904f3daf4..162a23e9bc 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -2,7 +2,6 @@ module Addr = ValueDomain.Addr module Offs = ValueDomain.Offs -module Equ = MusteqDomain.Equ module Exp = CilType.Exp module IdxDom = ValueDomain.IndexDomain diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 7830fcc974..4f0468f3b1 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -349,67 +349,6 @@ struct end end -module Fields = -struct - module F = CilType.Fieldinfo - module I = Basetype.CilExp - - include Offset.Exp - - let rec kill v (fds: t): t = match fds with - | `Index (x, xs) when I.occurs v x -> `NoOffset - | `Index (x, xs) -> `Index (x, kill v xs) - | `Field (x, xs) -> `Field (x, kill v xs) - | `NoOffset -> `NoOffset - - let replace x exp = map_indices (I.replace x exp) - - let top () = `NoOffset - let is_top x = x = `NoOffset - let bot () = failwith "Bottom offset list!" - let is_bot x = false - - let rec leq x y = - match x,y with - | _, `NoOffset -> true - | `Index (x, xs), `Index (y, ys) when I.equal x y -> leq xs ys - | `Field (x, xs), `Field (y, ys) when F.equal x y -> leq xs ys - | _ -> false - - let rec meet x y = - match x,y with - | `NoOffset, x | x, `NoOffset -> x - | `Index (x, xs), `Index (y, ys) when I.equal x y -> `Index (x, meet xs ys) - | `Field (x, xs), `Field (y, ys) when F.equal x y -> `Field (x, meet xs ys) - | _ -> failwith "Arguments do not meet" - - let narrow = meet - - let rec join x y = - match x,y with - | `Index (x, xs), `Index (y, ys) when I.equal x y -> `Index (x, join xs ys) - | `Field (x, xs), `Field (y, ys) when F.equal x y -> `Field (x, join xs ys) - | _ -> `NoOffset - - let widen = join - - let rec collapse x y = - match x,y with - | `NoOffset, x | x, `NoOffset -> true - | `Index (x, xs), `Index (y, ys) when I.equal x y -> collapse xs ys - | `Field (x, xs), `Field (y, ys) when F.equal x y -> collapse xs ys - | `Field (x, xs), `Field (y, ys) -> false - | `Index (x, xs), `Index (y, ys) -> true - | _ -> failwith "Type mismatch!" - - (* TODO: use the type information to do this properly. Currently, this assumes - * there are no nested arrays, so all indexing is eliminated. *) - let real_region (fd:t) typ: bool = not (contains_index fd) - - let pretty_diff () ((x:t),(y:t)): Pretty.doc = - Pretty.dprintf "%a not leq %a" pretty x pretty y -end - module Exp = struct include Printable.StdLeaf diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index 0ae959172f..45a12aa9df 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -6,7 +6,63 @@ open Pretty module V = Basetype.Variables module F = struct - include Lval.Fields + module F = CilType.Fieldinfo + module I = Basetype.CilExp + + include Offset.Exp + + let rec kill v (fds: t): t = match fds with + | `Index (x, xs) when I.occurs v x -> `NoOffset + | `Index (x, xs) -> `Index (x, kill v xs) + | `Field (x, xs) -> `Field (x, kill v xs) + | `NoOffset -> `NoOffset + + let replace x exp = map_indices (I.replace x exp) + + let top () = `NoOffset + let is_top x = x = `NoOffset + let bot () = failwith "Bottom offset list!" + let is_bot x = false + + let rec leq x y = + match x,y with + | _, `NoOffset -> true + | `Index (x, xs), `Index (y, ys) when I.equal x y -> leq xs ys + | `Field (x, xs), `Field (y, ys) when F.equal x y -> leq xs ys + | _ -> false + + let rec meet x y = + match x,y with + | `NoOffset, x | x, `NoOffset -> x + | `Index (x, xs), `Index (y, ys) when I.equal x y -> `Index (x, meet xs ys) + | `Field (x, xs), `Field (y, ys) when F.equal x y -> `Field (x, meet xs ys) + | _ -> failwith "Arguments do not meet" + + let narrow = meet + + let rec join x y = + match x,y with + | `Index (x, xs), `Index (y, ys) when I.equal x y -> `Index (x, join xs ys) + | `Field (x, xs), `Field (y, ys) when F.equal x y -> `Field (x, join xs ys) + | _ -> `NoOffset + + let widen = join + + let rec collapse x y = + match x,y with + | `NoOffset, x | x, `NoOffset -> true + | `Index (x, xs), `Index (y, ys) when I.equal x y -> collapse xs ys + | `Field (x, xs), `Field (y, ys) when F.equal x y -> collapse xs ys + | `Field (x, xs), `Field (y, ys) -> false + | `Index (x, xs), `Index (y, ys) -> true + | _ -> failwith "Type mismatch!" + + (* TODO: use the type information to do this properly. Currently, this assumes + * there are no nested arrays, so all indexing is eliminated. *) + let real_region (fd:t) typ: bool = not (contains_index fd) + + let pretty_diff () ((x:t),(y:t)): Pretty.doc = + Pretty.dprintf "%a not leq %a" pretty x pretty y let rec prefix x y = match x,y with | `Index (x, xs), `Index (y, ys) when I.equal x y -> prefix xs ys diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index 2a00adeb89..f16a4f8d9a 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -5,7 +5,7 @@ open GobConfig module V = Basetype.Variables module B = Printable.UnitConf (struct let name = "•" end) -module F = Lval.Fields +module F = MusteqDomain.F module VF = struct From 5c5f5e1cdc519b3c76a3f6a413daf3dba4aa5578 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 May 2023 11:47:59 +0300 Subject: [PATCH 324/518] Deduplicate RegionDomain.VF --- src/cdomains/musteqDomain.ml | 19 +++++++++++++++---- src/cdomains/regionDomain.ml | 24 +----------------------- 2 files changed, 16 insertions(+), 27 deletions(-) diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index 45a12aa9df..bb58767519 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -76,14 +76,25 @@ struct | `NoOffset -> false end -module EquAddr = +module VF = struct include Printable.ProdSimple (V) (F) let show (v,fd) = let v_str = V.show v in let fd_str = F.show fd in v_str ^ fd_str - let pretty () x = text (show x) + let pretty () x = Pretty.text (show x) + + let printXml f (v,fi) = + BatPrintf.fprintf f "\n\n%s%a\n\n\n" (XmlUtil.escape (V.show v)) F.printXml fi + + (* Indicates if the two var * offset pairs should collapse or not. *) + let collapse (v1,f1) (v2,f2) = V.equal v1 v2 && F.collapse f1 f2 + let leq (v1,f1) (v2,f2) = V.equal v1 v2 && F.leq f1 f2 + (* Joins the fields, assuming the vars are equal. *) + let join (v1,f1) (v2,f2) = (v1,F.join f1 f2) + let kill x (v,f) = v, F.kill x f + let replace x exp (v,fd) = v, F.replace x exp fd let prefix (v1,fd1: t) (v2,fd2: t): F.t option = if V.equal v1 v2 then F.prefix fd1 fd2 else None @@ -135,7 +146,7 @@ struct (* Function to find all addresses equal to { vfd } in { eq }. *) let other_addrs vfd eq = let rec helper (v,fd) addrs = - if List.exists (EquAddr.equal (v,fd)) addrs then addrs else + if List.exists (VF.equal (v,fd)) addrs then addrs else let f (x,y) fd' acc = if V.equal v x then helper (y, F.add_offset fd' fd) acc @@ -149,7 +160,7 @@ struct in helper vfd [] - let eval_rv rv: EquAddr.t option = + let eval_rv rv: VF.t option = match rv with | Lval (Var x, NoOffset) -> Some (x, `NoOffset) | AddrOf (Var x, ofs) diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index f16a4f8d9a..012db6526f 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -2,31 +2,9 @@ open GoblintCil open GobConfig +open MusteqDomain -module V = Basetype.Variables module B = Printable.UnitConf (struct let name = "•" end) -module F = MusteqDomain.F - -module VF = -struct - include Printable.ProdSimple (V) (F) - let show (v,fd) = - let v_str = V.show v in - let fd_str = F.show fd in - v_str ^ fd_str - let pretty () x = Pretty.text (show x) - - let printXml f (v,fi) = - BatPrintf.fprintf f "\n\n%s%a\n\n\n" (XmlUtil.escape (V.show v)) F.printXml fi - - (* Indicates if the two var * offset pairs should collapse or not. *) - let collapse (v1,f1) (v2,f2) = V.equal v1 v2 && F.collapse f1 f2 - let leq (v1,f1) (v2,f2) = V.equal v1 v2 && F.leq f1 f2 - (* Joins the fields, assuming the vars are equal. *) - let join (v1,f1) (v2,f2) = (v1,F.join f1 f2) - let kill x (v,f) = v, F.kill x f - let replace x exp (v,fd) = v, F.replace x exp fd -end module VFB = struct From c46b85b7b8c376ad9dab4cfd2177fb0ac0844475 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 31 May 2023 10:52:00 +0200 Subject: [PATCH 325/518] Allow for path-sensitive threadid analysis --- src/analyses/threadId.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index c7c33aa470..ff47cf10b8 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -34,6 +34,7 @@ struct module D = Lattice.Prod3 (N) (ThreadLifted) (TD) module C = D + module P = IdentityP (D) let tids = ref (Hashtbl.create 20) From 640ee7983a0038f5d2cbdcb0b92753272e964800 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 May 2023 12:12:39 +0300 Subject: [PATCH 326/518] Extract Lval.MakePrintable --- src/cdomains/lval.ml | 43 ++++++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 19 deletions(-) diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 4f0468f3b1..fd040c0370 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -7,6 +7,30 @@ module M = Messages type ('f, 'i) offs = 'i Offset.t [@@deriving eq, ord, hash] +module MakePrintable (Offs: Printable.S) = +struct + include Printable.StdLeaf + type t = CilType.Varinfo.t * Offs.t [@@deriving eq, ord, hash] + + let name () = Format.sprintf "lval (%s)" (Offs.name ()) + + let show ((v, o): t): string = CilType.Varinfo.show v ^ Offs.show o + include Printable.SimpleShow ( + struct + type nonrec t = t + let show = show + end + ) +end + +module Exp = +struct + include MakePrintable (Offset.Exp) + + let to_cil ((v, o): t): lval = (Var v, Offset.Exp.to_cil o) + let to_cil_exp lv = Lval (to_cil lv) +end + module OffsetLatWithSemanticEqual (Idx: Offset.Index.Lattice) = struct @@ -349,25 +373,6 @@ struct end end -module Exp = -struct - include Printable.StdLeaf - type t = CilType.Varinfo.t * Offset.Exp.t [@@deriving eq, ord, hash] - - let name () = "lval with exp indices" - - let show ((v, o): t): string = CilType.Varinfo.show v ^ Offset.Exp.show o - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - - let to_cil ((v, o): t): lval = (Var v, Offset.Exp.to_cil o) - let to_cil_exp lv = Lval (to_cil lv) -end - module CilLval = struct include Exp From ac38f4c38e9dc181def4249158ca795b12d806b6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 May 2023 12:19:55 +0300 Subject: [PATCH 327/518] Move offset semantic_equal to Offset module --- src/cdomains/lval.ml | 43 +----------------------------------------- src/cdomains/offset.ml | 38 ++++++++++++++++++++++++++++++++++++- 2 files changed, 38 insertions(+), 43 deletions(-) diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index fd040c0370..4de48405b0 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -32,47 +32,6 @@ struct end -module OffsetLatWithSemanticEqual (Idx: Offset.Index.Lattice) = -struct - include Offset.MakeLattice (Idx) - - let ikind () = Cilfacade.ptrdiff_ikind () - - let offset_to_index_offset typ offs = - let idx_of_int x = - Idx.of_int (ikind ()) (Z.of_int x) - in - let rec offset_to_index_offset ?typ offs = match offs with - | `NoOffset -> idx_of_int 0 - | `Field (field, o) -> - let field_as_offset = Field (field, NoOffset) in - let bits_offset, _size = GoblintCil.bitsOffset (TComp (field.fcomp, [])) field_as_offset in - let bits_offset = idx_of_int bits_offset in - let remaining_offset = offset_to_index_offset ~typ:field.ftype o in - Idx.add bits_offset remaining_offset - | `Index (x, o) -> - let (item_typ, item_size_in_bits) = - match Option.map unrollType typ with - | Some TArray(item_typ, _, _) -> - let item_size_in_bits = bitsSizeOf item_typ in - (Some item_typ, idx_of_int item_size_in_bits) - | _ -> - (None, Idx.top ()) - in - let bits_offset = Idx.mul item_size_in_bits x in - let remaining_offset = offset_to_index_offset ?typ:item_typ o in - Idx.add bits_offset remaining_offset - in - offset_to_index_offset ~typ offs - - let semantic_equal ~xtyp ~xoffs ~ytyp ~yoffs = - let x_index = offset_to_index_offset xtyp xoffs in - let y_index = offset_to_index_offset ytyp yoffs in - if M.tracing then M.tracel "addr" "xoffs=%a xtyp=%a xindex=%a yoffs=%a ytyp=%a yindex=%a\n" pretty xoffs d_plaintype xtyp Idx.pretty x_index pretty yoffs d_plaintype ytyp Idx.pretty y_index; - Idx.to_bool (Idx.eq x_index y_index) - -end - module type S = sig type field @@ -243,7 +202,7 @@ end module NormalLat (Idx: Offset.Index.Lattice) = struct include Normal (Idx) - module Offs = OffsetLatWithSemanticEqual (Idx) + module Offs = Offset.MakeLattice (Idx) (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) let semantic_equal x y = match x, y with diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 0aa5b69c60..d1222a1bf4 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -2,6 +2,9 @@ open GoblintCil +module M = Messages + + (** Special index expression for some unknown index. Weakly updates array in assignment. Used for exp.fast_global_inits. *) @@ -151,7 +154,7 @@ struct let top_indices = map_indices (fun _ -> Idx.top ()) end -module MakeLattice (Idx: IntDomain.Z) = +module MakeLattice (Idx: Index.Lattice) = struct include MakePrintable (Idx) @@ -182,6 +185,39 @@ struct | `Index (Const (CInt (i,ik,s)),o) -> `Index (Idx.of_int ik i, of_exp o) | `Index (_,o) -> `Index (Idx.top (), of_exp o) | `Field (f,o) -> `Field (f, of_exp o) + + let offset_to_index_offset typ (offs: t): Idx.t = + let idx_of_int x = + Idx.of_int (Cilfacade.ptrdiff_ikind ()) (Z.of_int x) + in + let rec offset_to_index_offset ?typ offs = match offs with + | `NoOffset -> idx_of_int 0 + | `Field (field, o) -> + let field_as_offset = Field (field, NoOffset) in + let bits_offset, _size = GoblintCil.bitsOffset (TComp (field.fcomp, [])) field_as_offset in + let bits_offset = idx_of_int bits_offset in + let remaining_offset = offset_to_index_offset ~typ:field.ftype o in + Idx.add bits_offset remaining_offset + | `Index (x, o) -> + let (item_typ, item_size_in_bits) = + match Option.map unrollType typ with + | Some TArray(item_typ, _, _) -> + let item_size_in_bits = bitsSizeOf item_typ in + (Some item_typ, idx_of_int item_size_in_bits) + | _ -> + (None, Idx.top ()) + in + let bits_offset = Idx.mul item_size_in_bits x in + let remaining_offset = offset_to_index_offset ?typ:item_typ o in + Idx.add bits_offset remaining_offset + in + offset_to_index_offset ~typ offs + + let semantic_equal ~xtyp ~xoffs ~ytyp ~yoffs = + let x_index = offset_to_index_offset xtyp xoffs in + let y_index = offset_to_index_offset ytyp yoffs in + if M.tracing then M.tracel "addr" "xoffs=%a xtyp=%a xindex=%a yoffs=%a ytyp=%a yindex=%a\n" pretty xoffs d_plaintype xtyp Idx.pretty x_index pretty yoffs d_plaintype ytyp Idx.pretty y_index; + Idx.to_bool (Idx.eq x_index y_index) end module Unit = From 4f8cdf3397a8ac52a592991cd3ce316c9b5fd2f0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 May 2023 12:54:55 +0300 Subject: [PATCH 328/518] Add TODO test for must mutex unlocking --- .../05-lval_ls/19-idxunknown_unlock_precise.c | 40 +++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 tests/regression/05-lval_ls/19-idxunknown_unlock_precise.c diff --git a/tests/regression/05-lval_ls/19-idxunknown_unlock_precise.c b/tests/regression/05-lval_ls/19-idxunknown_unlock_precise.c new file mode 100644 index 0000000000..4b62b52cff --- /dev/null +++ b/tests/regression/05-lval_ls/19-idxunknown_unlock_precise.c @@ -0,0 +1,40 @@ +// PARAM: --enable ana.int.interval +// TODO because queries don't pass lvalue index intervals +extern int __VERIFIER_nondet_int(); +extern void abort(void); +void assume_abort_if_not(int cond) { + if(!cond) {abort();} +} + +#include +#include + +int data; +pthread_mutexattr_t mutexattr; +pthread_mutex_t m[10]; + +void *t_fun(void *arg) { + pthread_mutex_lock(&m[4]); + data++; // TODO NORACE + pthread_mutex_unlock(&m[4]); + return NULL; +} + +int main() { + pthread_mutexattr_init(&mutexattr); + pthread_mutexattr_settype(&mutexattr, PTHREAD_MUTEX_ERRORCHECK); + for (int i = 0; i < 10; i++) + pthread_mutex_init(&m[i], &mutexattr); + + int i = __VERIFIER_nondet_int(); + __goblint_assume(5 <= i); + __goblint_assume(i < 10); + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + pthread_mutex_lock(&m[4]); + pthread_mutex_unlock(&m[i]); // no UB because ERRORCHECK + data++; // TODO NORACE + pthread_mutex_unlock(&m[4]); + return 0; +} + From 81c2d6b060c2f1323da87c0d19910e280d10f508 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 May 2023 13:00:07 +0300 Subject: [PATCH 329/518] Document uselessness of Lockdomain.Lockset.may_be_same_offset --- src/cdomains/lockDomain.ml | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 162a23e9bc..f52fda9528 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -44,15 +44,11 @@ struct include SetDomain.Reverse(SetDomain.ToppedSet (Lock) (struct let topname = "All mutexes" end)) - (* TODO: Offset *) let rec may_be_same_offset of1 of2 = - match of1, of2 with - | `NoOffset , `NoOffset -> true - | `Field (x1,y1) , `Field (x2,y2) -> CilType.Compinfo.equal x1.fcomp x2.fcomp && may_be_same_offset y1 y2 (* TODO: why not fieldinfo equal? *) - | `Index (x1,y1) , `Index (x2,y2) - -> ((IdxDom.to_int x1 = None) || (IdxDom.to_int x2 = None)) - || IdxDom.equal x1 x2 && may_be_same_offset y1 y2 - | _ -> false + (* Only reached with definite of2 and indefinite of1. *) + (* TODO: Currently useless, because MayPointTo query doesn't return index offset ranges, so not enough information to ever return false. *) + (* TODO: Use Addr.Offs.semantic_equal. *) + true let add (addr,rw) set = match (Addr.to_var_offset addr) with From efc68a74d09322dd9944fc9f9317636cf5cfc412 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 May 2023 13:05:44 +0300 Subject: [PATCH 330/518] Extract Offset.MakePrintable.to_cil --- src/cdomains/offset.ml | 11 +++++++++++ src/cdomains/valueDomain.ml | 13 ++----------- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index d1222a1bf4..6822e5064b 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -141,6 +141,16 @@ struct `Index (i_exp, to_exp o) | `Field (f,o) -> `Field (f, to_exp o) + let rec to_cil: t -> offset = function + | `NoOffset -> NoOffset + | `Index (i,o) -> + let i_exp = match Idx.to_int i with + | Some i -> Const (CInt (i, Cilfacade.ptrdiff_ikind (), Some (Z.to_string i))) + | None -> any_index_exp + in + Index (i_exp, to_cil o) + | `Field (f,o) -> Field (f, to_cil o) + let rec contains_index: t -> bool = function | `NoOffset -> false | `Field (_, os) -> contains_index os @@ -245,6 +255,7 @@ struct | Index (i,o) -> `Index (i, of_cil o) | Field (f,o) -> `Field (f, of_cil o) + (* Overrides MakePrintable.to_cil. *) let rec to_cil: t -> offset = function | `NoOffset -> NoOffset | `Index (i,o) -> Index (i, to_cil o) diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index ae8d3c347c..020727be8e 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -1261,17 +1261,8 @@ struct | Addr.UnknownPtr -> None | Addr.Addr (vi, offs) when Addr.Offs.is_definite offs -> - (* TODO: Offset *) - let rec offs_to_offset = function - | `NoOffset -> NoOffset - | `Field (f, offs) -> Field (f, offs_to_offset offs) - | `Index (i, offs) -> - (* Addr.Offs.is_definite implies Idx.to_int returns Some *) - let i_definite = BatOption.get (IndexDomain.to_int i) in - let i_exp = Cil.(kinteger64 ILongLong (IntOps.BigIntOps.to_int64 i_definite)) in - Index (i_exp, offs_to_offset offs) - in - let offset = offs_to_offset offs in + (* Addr.Offs.is_definite implies to_cil doesn't contain Offset.any_index_exp. *) + let offset = Addr.Offs.to_cil offs in let cast_to_void_ptr e = Cilfacade.mkCast ~e ~newt:(TPtr (TVoid [], [])) From d0d77695aa9e07f4d90b5453a72881078f778707 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 May 2023 16:36:55 +0300 Subject: [PATCH 331/518] Update Goblint_lib documentation --- src/analyses/mutexTypeAnalysis.ml | 2 +- src/cdomains/mutexAttrDomain.ml | 2 ++ src/goblint_lib.ml | 4 +++- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index feb7fb413e..3ce2fc3308 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -1,4 +1,4 @@ -(** An analysis tracking the type of a mutex. *) +(** An analysis tracking the type of a mutex ([pthreadMutexType]). *) open GoblintCil open Analyses diff --git a/src/cdomains/mutexAttrDomain.ml b/src/cdomains/mutexAttrDomain.ml index 76669fa3a0..748ede0ff5 100644 --- a/src/cdomains/mutexAttrDomain.ml +++ b/src/cdomains/mutexAttrDomain.ml @@ -1,3 +1,5 @@ +(** Mutex attribute type domain. *) + module MutexKind = struct include Printable.StdLeaf diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index ea0d0420a1..19fef9ed19 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -79,7 +79,6 @@ module CondVars = CondVars Analyses related to the heap. *) -module MallocWrapperAnalysis = MallocWrapperAnalysis module Region = Region module MallocFresh = MallocFresh module Malloc_null = Malloc_null @@ -94,6 +93,7 @@ module Malloc_null = Malloc_null module MutexEventsAnalysis = MutexEventsAnalysis module LocksetAnalysis = LocksetAnalysis +module MutexTypeAnalysis = MutexTypeAnalysis module MutexAnalysis = MutexAnalysis module MayLocks = MayLocks module SymbLocks = SymbLocks @@ -153,6 +153,7 @@ module Spec = Spec Analyses which only support other analyses. *) module AccessAnalysis = AccessAnalysis +module WrapperFunctionAnalysis = WrapperFunctionAnalysis module TaintPartialContexts = TaintPartialContexts module UnassumeAnalysis = UnassumeAnalysis module ExpRelation = ExpRelation @@ -212,6 +213,7 @@ module AffineEqualityDomain = AffineEqualityDomain (** {3 Concurrency} *) +module MutexAttrDomain = MutexAttrDomain module LockDomain = LockDomain module SymbLocksDomain = SymbLocksDomain module DeadlockDomain = DeadlockDomain From 160a55f7118659bfb7887008d4766f0261039838 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 31 May 2023 18:27:57 +0200 Subject: [PATCH 332/518] Remove polymorphic variants for VD.Compound --- src/analyses/base.ml | 440 ++++++++--------- src/analyses/baseInvariant.ml | 152 +++--- src/cdomains/baseDomain.ml | 2 +- src/cdomains/valueDomain.ml | 904 +++++++++++++++++----------------- 4 files changed, 750 insertions(+), 748 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index d28d3765e1..a299710809 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -105,9 +105,9 @@ struct if Lazy.force array_domain_annotation_enabled then let rec pointedArrayMap = function | [] -> VarMap.empty - | (info,value)::xs -> + | (info,(value:VD.t))::xs -> match value with - | `Address t when hasAttribute "goblint_array_domain" info.vattr -> + | Address t when hasAttribute "goblint_array_domain" info.vattr -> let possibleVars = List.to_seq (PreValueDomain.AD.to_var_may t) in Seq.fold_left (fun map arr -> VarMap.add arr (info.vattr) map) (pointedArrayMap xs) @@ Seq.filter (fun info -> isArrayType info.vtype) possibleVars | _ -> pointedArrayMap xs @@ -189,17 +189,17 @@ struct | _ -> (fun c -> FD.top_of (FD.get_fkind c)) (* Evaluating Cil's unary operators. *) - let evalunop op typ = function - | `Int v1 -> `Int (ID.cast_to (Cilfacade.get_ikind typ) (unop_ID op v1)) - | `Float v -> `Float (unop_FD op v) - | `Address a when op = LNot -> + let evalunop op typ: value -> value = function + | Int v1 -> Int (ID.cast_to (Cilfacade.get_ikind typ) (unop_ID op v1)) + | Float v -> Float (unop_FD op v) + | Address a when op = LNot -> if AD.is_null a then - `Int (ID.of_bool (Cilfacade.get_ikind typ) true) + Int (ID.of_bool (Cilfacade.get_ikind typ) true) else if AD.is_not_null a then - `Int (ID.of_bool (Cilfacade.get_ikind typ) false) + Int (ID.of_bool (Cilfacade.get_ikind typ) false) else - `Int (ID.top_of (Cilfacade.get_ikind typ)) - | `Bot -> `Bot + Int (ID.top_of (Cilfacade.get_ikind typ)) + | Bot -> Bot | _ -> VD.top () let binop_ID (result_ik: Cil.ikind) = function @@ -299,47 +299,47 @@ struct | Some (x, o) -> Addr.from_var_offset (x, addToOffset n (Some x.vtype) o) | None -> default addr in - let addToAddrOp p n = + let addToAddrOp p (n:ID.t):value = match op with (* For array indexing e[i] and pointer addition e + i we have: *) | IndexPI | PlusPI -> - `Address (AD.map (addToAddr n) p) + Address (AD.map (addToAddr n) p) (* Pointer subtracted by a value (e-i) is very similar *) (* Cast n to the (signed) ptrdiff_ikind, then add the its negated value. *) | MinusPI -> let n = ID.neg (ID.cast_to (Cilfacade.ptrdiff_ikind ()) n) in - `Address (AD.map (addToAddr n) p) - | Mod -> `Int (ID.top_of (Cilfacade.ptrdiff_ikind ())) (* we assume that address is actually casted to int first*) - | _ -> `Address AD.top_ptr + Address (AD.map (addToAddr n) p) + | Mod -> Int (ID.top_of (Cilfacade.ptrdiff_ikind ())) (* we assume that address is actually casted to int first*) + | _ -> Address AD.top_ptr in (* The main function! *) match a1,a2 with (* For the integer values, we apply the int domain operator *) - | `Int v1, `Int v2 -> + | Int v1, Int v2 -> let result_ik = Cilfacade.get_ikind t in - `Int (ID.cast_to result_ik (binop_ID result_ik op v1 v2)) + Int (ID.cast_to result_ik (binop_ID result_ik op v1 v2)) (* For the float values, we apply the float domain operators *) - | `Float v1, `Float v2 when is_int_returning_binop_FD op -> + | Float v1, Float v2 when is_int_returning_binop_FD op -> let result_ik = Cilfacade.get_ikind t in - `Int (ID.cast_to result_ik (int_returning_binop_FD op v1 v2)) - | `Float v1, `Float v2 -> `Float (binop_FD (Cilfacade.get_fkind t) op v1 v2) + Int (ID.cast_to result_ik (int_returning_binop_FD op v1 v2)) + | Float v1, Float v2 -> Float (binop_FD (Cilfacade.get_fkind t) op v1 v2) (* For address +/- value, we try to do some elementary ptr arithmetic *) - | `Address p, `Int n - | `Int n, `Address p when op=Eq || op=Ne -> + | Address p, Int n + | Int n, Address p when op=Eq || op=Ne -> let ik = Cilfacade.get_ikind t in - `Int (match ID.to_bool n, AD.to_bool p with + Int (match ID.to_bool n, AD.to_bool p with | Some a, Some b -> ID.of_bool ik (op=Eq && a=b || op=Ne && a<>b) | _ -> bool_top ik) - | `Address p, `Int n -> + | Address p, Int n -> addToAddrOp p n - | `Address p, `Top -> + | Address p, Top -> (* same as previous, but with Unknown instead of int *) (* TODO: why does this even happen in zstd-thread-pool-add? *) let n = ID.top_of (Cilfacade.ptrdiff_ikind ()) in (* pretend to have unknown ptrdiff int instead *) addToAddrOp p n (* If both are pointer values, we can subtract them and well, we don't * bother to find the result in most cases, but it's an integer. *) - | `Address p1, `Address p2 -> begin + | Address p1, Address p2 -> begin let ik = Cilfacade.get_ikind t in let eq x y = if AD.is_definite x && AD.is_definite y then @@ -368,7 +368,7 @@ struct (* when subtracting pointers to arrays, per 6.5.6 of C-standard if we subtract two pointers to the same array, the difference *) (* between them is the difference in subscript *) begin - let rec calculateDiffFromOffset x y = + let rec calculateDiffFromOffset x y:value = match x, y with | `Field ((xf:Cil.fieldinfo), xo), `Field((yf:Cil.fieldinfo), yo) when CilType.Fieldinfo.equal xf yf -> @@ -377,31 +377,31 @@ struct begin let diff = ValueDomain.IndexDomain.sub i j in match ValueDomain.IndexDomain.to_int diff with - | Some z -> `Int(ID.of_int ik z) - | _ -> `Int (ID.top_of ik) + | Some z -> Int(ID.of_int ik z) + | _ -> Int (ID.top_of ik) end | `Index (xi, xo), `Index(yi, yo) when xi = yi -> (* TODO: ID.equal? *) calculateDiffFromOffset xo yo - | _ -> `Int (ID.top_of ik) + | _ -> Int (ID.top_of ik) in if AD.is_definite p1 && AD.is_definite p2 then match Addr.to_var_offset (AD.choose p1), Addr.to_var_offset (AD.choose p2) with | Some (x, xo), Some (y, yo) when CilType.Varinfo.equal x y -> calculateDiffFromOffset xo yo | _, _ -> - `Int (ID.top_of ik) + Int (ID.top_of ik) else - `Int (ID.top_of ik) + Int (ID.top_of ik) end | Eq -> - `Int (if AD.is_bot (AD.meet p1 p2) then ID.of_int ik BI.zero else match eq p1 p2 with Some x when x -> ID.of_int ik BI.one | _ -> bool_top ik) + Int (if AD.is_bot (AD.meet p1 p2) then ID.of_int ik BI.zero else match eq p1 p2 with Some x when x -> ID.of_int ik BI.one | _ -> bool_top ik) | Ne -> - `Int (if AD.is_bot (AD.meet p1 p2) then ID.of_int ik BI.one else match eq p1 p2 with Some x when x -> ID.of_int ik BI.zero | _ -> bool_top ik) + Int (if AD.is_bot (AD.meet p1 p2) then ID.of_int ik BI.one else match eq p1 p2 with Some x when x -> ID.of_int ik BI.zero | _ -> bool_top ik) | _ -> VD.top () end (* For other values, we just give up! *) - | `Bot, _ -> `Bot - | _, `Bot -> `Bot + | Bot, _ -> Bot + | _, Bot -> Bot | _ -> VD.top () (* Auxiliary function to append an additional offset to a given offset. *) @@ -471,7 +471,7 @@ struct let v = VD.eval_offset (Queries.to_value_domain_ask a) (fun x -> get a gs st x exp) var offs exp (Some (Var x, Offs.to_cil_offset offs)) x.vtype in if M.tracing then M.tracec "get" "var = %a, %a = %a\n" VD.pretty var AD.pretty (AD.from_var_offset (x, offs)) VD.pretty v; if full then v else match v with - | `Blob (c,s,_) -> c + | Blob (c,s,_) -> c | x -> x in let f = function @@ -483,11 +483,11 @@ struct | _ -> assert false end | Addr.UnknownPtr -> top (* top may be more precise than VD.top, e.g. for address sets, such that known addresses are kept for soundness *) - | Addr.StrPtr _ -> `Int (ID.top_of IChar) + | Addr.StrPtr _ -> Int (ID.top_of IChar) in (* We form the collecting function by joining *) - let c x = match x with (* If address type is arithmetic, and our value is an int, we cast to the correct ik *) - | `Int _ when Cil.isArithmeticType at -> VD.cast at x + let c (x:value) = match x with (* If address type is arithmetic, and our value is an int, we cast to the correct ik *) + | Int _ when Cil.isArithmeticType at -> VD.cast at x | _ -> x in let f x a = VD.join (c @@ f x) a in (* Finally we join over all the addresses in the set. *) @@ -504,14 +504,14 @@ struct (* From a list of values, presumably arguments to a function, simply extract * the pointer arguments. *) let get_ptrs (vals: value list): address list = - let f x acc = match x with - | `Address adrs when AD.is_top adrs -> + let f (x:value) acc = match x with + | Address adrs when AD.is_top adrs -> M.info ~category:Unsound "Unknown address given as function argument"; acc - | `Address adrs when AD.to_var_may adrs = [] -> acc - | `Address adrs -> + | Address adrs when AD.to_var_may adrs = [] -> acc + | Address adrs -> let typ = AD.get_type adrs in if isFunctionType typ then acc else adrs :: acc - | `Top -> M.info ~category:Unsound "Unknown value type given as function argument"; acc + | Top -> M.info ~category:Unsound "Unknown value type given as function argument"; acc | _ -> acc in List.fold_right f vals [] @@ -520,26 +520,26 @@ struct let empty = AD.empty () in if M.tracing then M.trace "reachability" "Checking value %a\n" VD.pretty value; match value with - | `Top -> + | Top -> if VD.is_immediate_type t then () else M.info ~category:Unsound "Unknown value in %s could be an escaped pointer address!" description; empty - | `Bot -> (*M.debug ~category:Analyzer "A bottom value when computing reachable addresses!";*) empty - | `Address adrs when AD.is_top adrs -> + | Bot -> (*M.debug ~category:Analyzer "A bottom value when computing reachable addresses!";*) empty + | Address adrs when AD.is_top adrs -> M.info ~category:Unsound "Unknown address in %s has escaped." description; AD.remove Addr.NullPtr adrs (* return known addresses still to be a bit more sane (but still unsound) *) (* The main thing is to track where pointers go: *) - | `Address adrs -> AD.remove Addr.NullPtr adrs + | Address adrs -> AD.remove Addr.NullPtr adrs (* Unions are easy, I just ingore the type info. *) - | `Union (f,e) -> reachable_from_value ask gs st e t description + | Union (f,e) -> reachable_from_value ask gs st e t description (* For arrays, we ask to read from an unknown index, this will cause it * join all its values. *) - | `Array a -> reachable_from_value ask gs st (ValueDomain.CArrays.get (Queries.to_value_domain_ask ask) a (None, ValueDomain.ArrIdxDomain.top ())) t description - | `Blob (e,_,_) -> reachable_from_value ask gs st e t description - | `Struct s -> ValueDomain.Structs.fold (fun k v acc -> AD.join (reachable_from_value ask gs st v t description) acc) s empty - | `Int _ -> empty - | `Float _ -> empty - | `MutexAttr _ -> empty - | `Thread _ -> empty (* thread IDs are abstract and nothing known can be reached from them *) - | `JmpBuf _ -> empty (* Jump buffers are abstract and nothing known can be reached from them *) - | `Mutex -> empty (* mutexes are abstract and nothing known can be reached from them *) + | Array a -> reachable_from_value ask gs st (ValueDomain.CArrays.get (Queries.to_value_domain_ask ask) a (None, ValueDomain.ArrIdxDomain.top ())) t description + | Blob (e,_,_) -> reachable_from_value ask gs st e t description + | Struct s -> ValueDomain.Structs.fold (fun k v acc -> AD.join (reachable_from_value ask gs st v t description) acc) s empty + | Int _ -> empty + | Float _ -> empty + | MutexAttr _ -> empty + | Thread _ -> empty (* thread IDs are abstract and nothing known can be reached from them *) + | JmpBuf _ -> empty (* Jump buffers are abstract and nothing known can be reached from them *) + | Mutex -> empty (* mutexes are abstract and nothing known can be reached from them *) (* Get the list of addresses accessable immediately from a given address, thus * all pointers within a structure should be considered, but we don't follow @@ -579,34 +579,34 @@ struct let drop_non_ptrs (st:CPA.t) : CPA.t = if CPA.is_top st then st else let rec replace_val = function - | `Address _ as v -> v - | `Blob (v,s,o) -> + | VD.Address _ as v -> v + | Blob (v,s,o) -> begin match replace_val v with - | `Blob (`Top,_,_) - | `Top -> `Top - | t -> `Blob (t,s,o) + | Blob (Top,_,_) + | Top -> Top + | t -> Blob (t,s,o) end - | `Struct s -> `Struct (ValueDomain.Structs.map replace_val s) - | _ -> `Top + | Struct s -> Struct (ValueDomain.Structs.map replace_val s) + | _ -> Top in CPA.map replace_val st let drop_ints (st:CPA.t) : CPA.t = if CPA.is_top st then st else - let rec replace_val = function - | `Int _ -> `Top - | `Array n -> `Array (ValueDomain.CArrays.map replace_val n) - | `Struct n -> `Struct (ValueDomain.Structs.map replace_val n) - | `Union (f,v) -> `Union (f,replace_val v) - | `Blob (n,s,o) -> `Blob (replace_val n,s,o) - | `Address x -> `Address (ValueDomain.AD.map ValueDomain.Addr.drop_ints x) + let rec replace_val: value -> value = function + | Int _ -> Top + | Array n -> Array (ValueDomain.CArrays.map replace_val n) + | Struct n -> Struct (ValueDomain.Structs.map replace_val n) + | Union (f,v) -> Union (f,replace_val v) + | Blob (n,s,o) -> Blob (replace_val n,s,o) + | Address x -> Address (ValueDomain.AD.map ValueDomain.Addr.drop_ints x) | x -> x in CPA.map replace_val st - let drop_interval = CPA.map (function `Int x -> `Int (ID.no_interval x) | x -> x) + let drop_interval = CPA.map (function Int x -> Int (ID.no_interval x) | x -> x) - let drop_intervalSet = CPA.map (function `Int x -> `Int (ID.no_intervalSet x) | x -> x ) + let drop_intervalSet = CPA.map (function Int x -> Int (ID.no_intervalSet x) | x -> x ) let context (fd: fundec) (st: store): store = let f keep drop_fn (st: store) = if keep then st else { st with cpa = drop_fn st.cpa} in @@ -663,25 +663,25 @@ struct in let rec reachable_from_value (value: value) = match value with - | `Top -> (empty, TS.top (), true) - | `Bot -> (empty, TS.bot (), false) - | `Address adrs when AD.is_top adrs -> (empty,TS.bot (), true) - | `Address adrs -> (adrs,TS.bot (), AD.has_unknown adrs) - | `Union (t,e) -> with_field (reachable_from_value e) t - | `Array a -> reachable_from_value (ValueDomain.CArrays.get (Queries.to_value_domain_ask (Analyses.ask_of_ctx ctx)) a (None, ValueDomain.ArrIdxDomain.top ())) - | `Blob (e,_,_) -> reachable_from_value e - | `Struct s -> + | Top -> (empty, TS.top (), true) + | Bot -> (empty, TS.bot (), false) + | Address adrs when AD.is_top adrs -> (empty,TS.bot (), true) + | Address adrs -> (adrs,TS.bot (), AD.has_unknown adrs) + | Union (t,e) -> with_field (reachable_from_value e) t + | Array a -> reachable_from_value (ValueDomain.CArrays.get (Queries.to_value_domain_ask (Analyses.ask_of_ctx ctx)) a (None, ValueDomain.ArrIdxDomain.top ())) + | Blob (e,_,_) -> reachable_from_value e + | Struct s -> let join_tr (a1,t1,_) (a2,t2,_) = AD.join a1 a2, TS.join t1 t2, false in let f k v = join_tr (with_type k.ftype (reachable_from_value v)) in ValueDomain.Structs.fold f s (empty, TS.bot (), false) - | `Int _ -> (empty, TS.bot (), false) - | `Float _ -> (empty, TS.bot (), false) - | `MutexAttr _ -> (empty, TS.bot (), false) - | `Thread _ -> (empty, TS.bot (), false) (* TODO: is this right? *) - | `JmpBuf _ -> (empty, TS.bot (), false) (* TODO: is this right? *) - | `Mutex -> (empty, TS.bot (), false) (* TODO: is this right? *) + | Int _ -> (empty, TS.bot (), false) + | Float _ -> (empty, TS.bot (), false) + | MutexAttr _ -> (empty, TS.bot (), false) + | Thread _ -> (empty, TS.bot (), false) (* TODO: is this right? *) + | JmpBuf _ -> (empty, TS.bot (), false) (* TODO: is this right? *) + | Mutex -> (empty, TS.bot (), false) (* TODO: is this right? *) in reachable_from_value (get (Analyses.ask_of_ctx ctx) ctx.global ctx.local adr None) in @@ -722,7 +722,7 @@ struct and eval_rv_ask_evalint a gs st exp = let eval_next () = eval_rv_no_ask_evalint a gs st exp in if M.tracing then M.traceli "evalint" "base eval_rv_ask_evalint %a\n" d_exp exp; - let r = + let r:value = match Cilfacade.typeOf exp with | typ when Cil.isIntegralType typ && not (Cil.isConstant exp) -> (* don't EvalInt integer constants, base can do them precisely itself *) if M.tracing then M.traceli "evalint" "base ask EvalInt %a\n" d_exp exp; @@ -730,9 +730,9 @@ struct if M.tracing then M.traceu "evalint" "base ask EvalInt %a -> %a\n" d_exp exp Queries.ID.pretty a; begin match a with | `Bot -> eval_next () (* Base EvalInt returns bot on incorrect type (e.g. pthread_t); ignore and continue. *) - (* | x -> Some (`Int x) *) - | `Lifted x -> `Int x (* cast should be unnecessary, EvalInt should guarantee right ikind already *) - | `Top -> `Int (ID.top_of (Cilfacade.get_ikind typ)) (* query cycle *) + (* | x -> Some (Int x) *) + | `Lifted x -> Int x (* cast should be unnecessary, EvalInt should guarantee right ikind already *) + | `Top -> Int (ID.top_of (Cilfacade.get_ikind typ)) (* query cycle *) end | exception Cilfacade.TypeOfError _ (* Bug: typeOffset: Field on a non-compound *) | _ -> eval_next () @@ -785,15 +785,15 @@ struct | Const (CChr x) -> eval_rv a gs st (Const (charConstToInt x)) (* char becomes int, see Cil doc/ISO C 6.4.4.4.10 *) | Const (CInt (num,ikind,str)) -> (match str with Some x -> M.tracel "casto" "CInt (%s, %a, %s)\n" (Z.to_string num) d_ikind ikind x | None -> ()); - `Int (ID.cast_to ikind (IntDomain.of_const (num,ikind,str))) - | Const (CReal (_,fkind, Some str)) when not (Cilfacade.isComplexFKind fkind) -> `Float (FD.of_string fkind str) (* prefer parsing from string due to higher precision *) - | Const (CReal (num, fkind, None)) when not (Cilfacade.isComplexFKind fkind) -> `Float (FD.of_const fkind num) + Int (ID.cast_to ikind (IntDomain.of_const (num,ikind,str))) + | Const (CReal (_,fkind, Some str)) when not (Cilfacade.isComplexFKind fkind) -> Float (FD.of_string fkind str) (* prefer parsing from string due to higher precision *) + | Const (CReal (num, fkind, None)) when not (Cilfacade.isComplexFKind fkind) -> Float (FD.of_const fkind num) (* String literals *) - | Const (CStr (x,_)) -> `Address (AD.from_string x) (* normal 8-bit strings, type: char* *) + | Const (CStr (x,_)) -> Address (AD.from_string x) (* normal 8-bit strings, type: char* *) | Const (CWStr (xs,_) as c) -> (* wide character strings, type: wchar_t* *) let x = CilType.Constant.show c in (* escapes, see impl. of d_const in cil.ml *) let x = String.sub x 2 (String.length x - 3) in (* remove surrounding quotes: L"foo" -> foo *) - `Address (AD.from_string x) (* `Address (AD.str_ptr ()) *) + Address (AD.from_string x) (* Address (AD.str_ptr ()) *) | Const _ -> VD.top () (* Variables and address expressions *) | Lval lv -> @@ -805,7 +805,7 @@ struct let a2 = eval_rv a gs st e2 in let extra_is_safe = match evalbinop_base a st op t1 a1 t2 a2 typ with - | `Int i -> ID.to_bool i = Some true + | Int i -> ID.to_bool i = Some true | _ | exception IntDomain.IncompatibleIKinds _ -> false in @@ -841,33 +841,33 @@ struct else None in - let eqs_value = + let eqs_value: value option = let* eqs = split exp in let* (e, es) = find_common eqs in let v = eval_rv a gs st e in (* value of common exp *) let vs = List.map (eval_rv a gs st) es in (* values of other sides *) let ik = Cilfacade.get_ikind typ in match v with - | `Address a -> + | Address a -> (* get definite addrs from vs *) - let rec to_definite_ad = function + let rec to_definite_ad: value list -> AD.t = function | [] -> AD.empty () - | `Address a :: vs when AD.is_definite a -> + | Address a :: vs when AD.is_definite a -> AD.union a (to_definite_ad vs) | _ :: vs -> to_definite_ad vs in let definite_ad = to_definite_ad vs in if AD.leq a definite_ad then (* other sides cover common address *) - Some (`Int (ID.of_bool ik true)) + Some (VD.Int (ID.of_bool ik true)) else (* TODO: detect disjoint cases using may: https://github.com/goblint/analyzer/pull/757#discussion_r898105918 *) None - | `Int i -> + | Int i -> let module BISet = IntDomain.BISet in (* get definite ints from vs *) - let rec to_int_set = function + let rec to_int_set: value list -> BISet.t = function | [] -> BISet.empty () - | `Int i :: vs -> + | Int i :: vs -> begin match ID.to_int i with | Some i' -> BISet.add i' (to_int_set vs) | None -> to_int_set vs @@ -879,7 +879,7 @@ struct let incl_set = BISet.of_list incl_list in let int_set = to_int_set vs in if BISet.leq incl_set int_set then (* other sides cover common int *) - Some (`Int (ID.of_bool ik true)) + Some (VD.Int (ID.of_bool ik true)) else (* TODO: detect disjoint cases using may: https://github.com/goblint/analyzer/pull/757#discussion_r898105918 *) None | _ -> @@ -896,7 +896,7 @@ struct let a1 = eval_rv a gs st arg1 in evalunop op typ a1 (* The &-operator: we create the address abstract element *) - | AddrOf lval -> `Address (eval_lv a gs st lval) + | AddrOf lval -> Address (eval_lv a gs st lval) (* CIL's very nice implicit conversion of an array name [a] to a pointer * to its first element [&a[0]]. *) | StartOf lval -> @@ -906,7 +906,7 @@ struct | Some (x, offs) -> Addr.from_var_offset (x, add_offset offs array_ofs) | None -> ad in - `Address (AD.map array_start (eval_lv a gs st lval)) + Address (AD.map array_start (eval_lv a gs st lval)) | CastE (t, Const (CStr (x,e))) -> (* VD.top () *) eval_rv a gs st (Const (CStr (x,e))) (* TODO safe? *) | CastE (t, exp) -> let v = eval_rv a gs st exp in @@ -996,7 +996,7 @@ struct let r = evalbinop_base a st op t1 a1 t2 a2 t in if Cil.isIntegralType t then ( match r with - | `Int i when ID.to_int i <> None -> r (* Avoid fallback, cannot become any more precise. *) + | Int i when ID.to_int i <> None -> r (* Avoid fallback, cannot become any more precise. *) | _ -> (* Fallback to MustBeEqual query, could get extra precision from exprelation/var_eq. *) let must_be_equal () = @@ -1007,21 +1007,21 @@ struct match op with | MinusA when must_be_equal () -> let ik = Cilfacade.get_ikind t in - `Int (ID.of_int ik BI.zero) + Int (ID.of_int ik BI.zero) | MinusPI (* TODO: untested *) | MinusPP when must_be_equal () -> let ik = Cilfacade.ptrdiff_ikind () in - `Int (ID.of_int ik BI.zero) + Int (ID.of_int ik BI.zero) (* Eq case is unnecessary: Q.must_be_equal reconstructs BinOp (Eq, _, _, _) and repeats EvalInt query for that, yielding a top from query cycle and never being must equal *) | Le | Ge when must_be_equal () -> let ik = Cilfacade.get_ikind t in - `Int (ID.of_bool ik true) + Int (ID.of_bool ik true) | Ne | Lt | Gt when must_be_equal () -> let ik = Cilfacade.get_ikind t in - `Int (ID.of_bool ik false) + Int (ID.of_bool ik false) | _ -> r (* Fallback didn't help. *) ) else @@ -1036,11 +1036,11 @@ struct (* Used also for thread creation: *) and eval_tv a (gs:glob_fun) st (exp:exp): AD.t = match (eval_rv a gs st exp) with - | `Address x -> x + | Address x -> x | _ -> failwith "Problems evaluating expression to function calls!" and eval_int a gs st exp = match eval_rv a gs st exp with - | `Int x -> x + | Int x -> x | _ -> ID.top_of (Cilfacade.get_ikind_exp exp) (* A function to convert the offset to our abstract representation of * offsets, i.e. evaluate the index expression to the integer domain. *) @@ -1053,10 +1053,10 @@ struct `Index (IdxDom.top (), convert_offset a gs st ofs) | Index (exp, ofs) -> match eval_rv a gs st exp with - | `Int i -> `Index (iDtoIdx i, convert_offset a gs st ofs) - | `Address add -> `Index (AD.to_int (module IdxDom) add, convert_offset a gs st ofs) - | `Top -> `Index (IdxDom.top (), convert_offset a gs st ofs) - | `Bot -> `Index (IdxDom.bot (), convert_offset a gs st ofs) + | Int i -> `Index (iDtoIdx i, convert_offset a gs st ofs) + | Address add -> `Index (AD.to_int (module IdxDom) add, convert_offset a gs st ofs) + | Top -> `Index (IdxDom.top (), convert_offset a gs st ofs) + | Bot -> `Index (IdxDom.bot (), convert_offset a gs st ofs) | _ -> failwith "Index not an integer value" (* Evaluation of lvalues to our abstract address domain. *) and eval_lv (a: Q.ask) (gs:glob_fun) st (lval:lval): AD.t = @@ -1071,13 +1071,13 @@ struct * and then add the subfield to it: { (x,field.subfield) }. *) | Mem n, ofs -> begin match (eval_rv a gs st n) with - | `Address adr -> + | Address adr -> (if AD.is_null adr then M.error ~category:M.Category.Behavior.Undefined.nullpointer_dereference ~tags:[CWE 476] "Must dereference NULL pointer" else if AD.may_be_null adr then M.warn ~category:M.Category.Behavior.Undefined.nullpointer_dereference ~tags:[CWE 476] "May dereference NULL pointer"); AD.map (add_offset_varinfo (convert_offset a gs st ofs)) adr - | `Bot -> AD.bot () + | Bot -> AD.bot () | _ -> M.debug ~category:Analyzer "Failed evaluating %a to lvalue" d_lval lval; AD.unknown_ptr @@ -1100,9 +1100,9 @@ struct let query_evalint ask gs st e = if M.tracing then M.traceli "evalint" "base query_evalint %a\n" d_exp e; let r = match eval_rv_no_ask_evalint ask gs st e with - | `Int i -> `Lifted i (* cast should be unnecessary, eval_rv should guarantee right ikind already *) - | `Bot -> Queries.ID.top () (* out-of-scope variables cause bot, but query result should then be unknown *) - | `Top -> Queries.ID.top () (* some float computations cause top (57-float/01-base), but query result should then be unknown *) + | Int i -> `Lifted i (* cast should be unnecessary, eval_rv should guarantee right ikind already *) + | Bot -> Queries.ID.top () (* out-of-scope variables cause bot, but query result should then be unknown *) + | Top -> Queries.ID.top () (* some float computations cause top (57-float/01-base), but query result should then be unknown *) | v -> M.debug ~category:Analyzer "Base EvalInt %a query answering bot instead of %a" d_exp e VD.pretty v; Queries.ID.bot () | exception (IntDomain.ArithmeticOnIntegerBot _) when not !AnalysisState.should_warn -> Queries.ID.top () (* for some privatizations, values can intermediately be bot because side-effects have not happened yet *) in @@ -1127,7 +1127,7 @@ struct and ask asked = { Queries.f = fun (type a) (q: a Queries.t) -> query asked q } (* our version of ask *) and gs = function `Left _ -> `Lifted1 (Priv.G.top ()) | `Right _ -> `Lifted2 (VD.top ()) in (* the expression is guaranteed to not contain globals *) match (eval_rv (ask Queries.Set.empty) gs st exp) with - | `Int x -> ValueDomain.ID.to_int x + | Int x -> ValueDomain.ID.to_int x | _ -> None let eval_funvar ctx fval: varinfo list = @@ -1146,7 +1146,7 @@ struct [dummyFunDec.svar] (** Evaluate expression as address. - Avoids expensive Apron EvalInt if the `Int result would be useless to us anyway. *) + Avoids expensive Apron EvalInt if the Int result would be useless to us anyway. *) let eval_rv_address ask gs st e = (* no way to do eval_rv with expected type, so filter expression beforehand *) match Cilfacade.typeOf e with @@ -1243,11 +1243,11 @@ struct end | Q.EvalJumpBuf e -> begin match eval_rv_address (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with - | `Address jmp_buf -> + | Address jmp_buf -> if AD.mem Addr.UnknownPtr jmp_buf then M.warn ~category:Imprecise "Jump buffer %a may contain unknown pointers." d_exp e; begin match get ~top:(VD.bot ()) (Analyses.ask_of_ctx ctx) ctx.global ctx.local jmp_buf None with - | `JmpBuf (x, copied) -> + | JmpBuf (x, copied) -> if copied then M.warn ~category:(Behavior (Undefined Other)) "The jump buffer %a contains values that were copied here instead of being set by setjmp. This is Undefined Behavior." d_exp e; x @@ -1260,12 +1260,12 @@ struct | Q.EvalMutexAttr e -> begin let e:exp = Lval (Cil.mkMem ~addr:e ~off:NoOffset) in match eval_rv (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with - | `MutexAttr a -> a + | MutexAttr a -> a | v -> MutexAttrDomain.top () end | Q.EvalLength e -> begin match eval_rv_address (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with - | `Address a -> + | Address a -> let slen = Seq.map String.length (List.to_seq (AD.to_string a)) in let lenOf = function | TArray (_, l, _) -> (try Some (lenOfArray l) with LenOfArray -> None) @@ -1275,7 +1275,7 @@ struct let d = Seq.fold_left ID.join (ID.bot_of (Cilfacade.ptrdiff_ikind ())) (Seq.map (ID.of_int (Cilfacade.ptrdiff_ikind ()) %BI.of_int) (Seq.append slen alen)) in (* ignore @@ printf "EvalLength %a = %a\n" d_exp e ID.pretty d; *) `Lifted d - | `Bot -> Queries.Result.bot q (* TODO: remove *) + | Bot -> Queries.Result.bot q (* TODO: remove *) | _ -> Queries.Result.top q end | Q.EvalValue e -> @@ -1284,37 +1284,37 @@ struct let p = eval_rv_address (Analyses.ask_of_ctx ctx) ctx.global ctx.local e in (* ignore @@ printf "BlobSize %a MayPointTo %a\n" d_plainexp e VD.pretty p; *) match p with - | `Address a -> + | Address a -> let r = get ~full:true (Analyses.ask_of_ctx ctx) ctx.global ctx.local a None in (* ignore @@ printf "BlobSize %a = %a\n" d_plainexp e VD.pretty r; *) (match r with - | `Blob (_,s,_) -> `Lifted s + | Blob (_,s,_) -> `Lifted s | _ -> Queries.Result.top q) | _ -> Queries.Result.top q end | Q.MayPointTo e -> begin match eval_rv_address (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with - | `Address a -> + | Address a -> let s = addrToLvalSet a in if AD.mem Addr.UnknownPtr a then Q.LS.add (dummyFunDec.svar, `NoOffset) s else s - | `Bot -> Queries.Result.bot q (* TODO: remove *) + | Bot -> Queries.Result.bot q (* TODO: remove *) | _ -> Queries.Result.top q end | Q.EvalThread e -> begin let v = eval_rv (Analyses.ask_of_ctx ctx) ctx.global ctx.local e in (* ignore (Pretty.eprintf "evalthread %a (%a): %a" d_exp e d_plainexp e VD.pretty v); *) match v with - | `Thread a -> a - | `Bot -> Queries.Result.bot q (* TODO: remove *) + | Thread a -> a + | Bot -> Queries.Result.bot q (* TODO: remove *) | _ -> Queries.Result.top q end | Q.ReachableFrom e -> begin match eval_rv_address (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with - | `Top -> Queries.Result.top q - | `Bot -> Queries.Result.bot q (* TODO: remove *) - | `Address a -> + | Top -> Queries.Result.top q + | Bot -> Queries.Result.bot q (* TODO: remove *) + | Address a -> let a' = AD.remove Addr.UnknownPtr a in (* run reachable_vars without unknown just to be safe *) let xs = List.map addrToLvalSet (reachable_vars (Analyses.ask_of_ctx ctx) [a'] ctx.global ctx.local) in let addrs = List.fold_left (Q.LS.join) (Q.LS.empty ()) xs in @@ -1326,27 +1326,27 @@ struct end | Q.ReachableUkTypes e -> begin match eval_rv_address (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with - | `Top -> Queries.Result.top q - | `Bot -> Queries.Result.bot q (* TODO: remove *) - | `Address a when AD.is_top a || AD.mem Addr.UnknownPtr a -> + | Top -> Queries.Result.top q + | Bot -> Queries.Result.bot q (* TODO: remove *) + | Address a when AD.is_top a || AD.mem Addr.UnknownPtr a -> Q.TS.top () - | `Address a -> + | Address a -> reachable_top_pointers_types ctx a | _ -> Q.TS.empty () end | Q.EvalStr e -> begin match eval_rv_address (Analyses.ask_of_ctx ctx) ctx.global ctx.local e with (* exactly one string in the set (works for assignments of string constants) *) - | `Address a when List.compare_length_with (AD.to_string a) 1 = 0 -> (* exactly one string *) + | Address a when List.compare_length_with (AD.to_string a) 1 = 0 -> (* exactly one string *) `Lifted (List.hd (AD.to_string a)) (* check if we have an array of chars that form a string *) (* TODO return may-points-to-set of strings *) - | `Address a when List.compare_length_with (AD.to_string a) 1 > 0 -> (* oh oh *) + | Address a when List.compare_length_with (AD.to_string a) 1 > 0 -> (* oh oh *) M.debug "EvalStr (%a) returned %a" d_exp e AD.pretty a; Queries.Result.top q - | `Address a when List.compare_length_with (AD.to_var_may a) 1 = 0 -> (* some other address *) + | Address a when List.compare_length_with (AD.to_var_may a) 1 = 0 -> (* some other address *) (* Cil.varinfo * (AD.Addr.field, AD.Addr.idx) Lval.offs *) - (* ignore @@ printf "EvalStr `Address: %a -> %s (must %i, may %i)\n" d_plainexp e (VD.short 80 (`Address a)) (List.length @@ AD.to_var_must a) (List.length @@ AD.to_var_may a); *) + (* ignore @@ printf "EvalStr Address: %a -> %s (must %i, may %i)\n" d_plainexp e (VD.short 80 (Address a)) (List.length @@ AD.to_var_must a) (List.length @@ AD.to_var_may a); *) begin match unrollType (Cilfacade.typeOf e) with | TPtr(TInt(IChar, _), _) -> let v, offs = Q.LS.choose @@ addrToLvalSet a in @@ -1386,15 +1386,15 @@ struct Dep.add var vMapNew dep in match value with - | `Array _ - | `Struct _ - | `Union _ -> + | Array _ + | Struct _ + | Union _ -> begin let vars_in_partitioning = VD.affecting_vars value in let dep_new = List.fold_left (fun dep var -> add_one_dep x var dep) st.deps vars_in_partitioning in { st with deps = dep_new } end - (* `Blob cannot contain arrays *) + (* Blob cannot contain arrays *) | _ -> st (** [set st addr val] returns a state where [addr] is set to [val] @@ -1449,7 +1449,7 @@ struct end else if get_bool "exp.globs_are_top" then begin if M.tracing then M.tracel "set" ~var:firstvar "update_one_addr: BAD? exp.globs_are_top is set \n"; - { st with cpa = CPA.add x `Top st.cpa } + { st with cpa = CPA.add x Top st.cpa } end else (* Check if we need to side-effect this one. We no longer generate * side-effects here, but the code still distinguishes these cases. *) @@ -1601,9 +1601,9 @@ struct * Auxillary functions **************************************************************************) - let is_some_bot x = + let is_some_bot (x:value) = match x with - | `Bot -> false (* HACK: bot is here due to typing conflict (we do not cast appropriately) *) + | Bot -> false (* HACK: bot is here due to typing conflict (we do not cast appropriately) *) | _ -> VD.is_bot_value x module InvariantEval = @@ -1639,7 +1639,7 @@ struct let set_savetop ~ctx ?lval_raw ?rval_raw ask (gs:glob_fun) st adr lval_t v : store = if M.tracing then M.tracel "set" "savetop %a %a %a\n" AD.pretty adr d_type lval_t VD.pretty v; match v with - | `Top -> set ~ctx ask gs st adr lval_t (VD.top_value (AD.get_type adr)) ?lval_raw ?rval_raw + | Top -> set ~ctx ask gs st adr lval_t (VD.top_value (AD.get_type adr)) ?lval_raw ?rval_raw | v -> set ~ctx ask gs st adr lval_t v ?lval_raw ?rval_raw @@ -1697,7 +1697,7 @@ struct AD.is_top xs || AD.exists not_local xs in (match rval_val, lval_val with - | `Address adrs, lval + | Address adrs, lval when (not !AnalysisState.global_initialization) && get_bool "kernel" && not_local lval && not (AD.is_top adrs) -> let find_fps e xs = match Addr.to_var_must e with | Some x -> x :: xs @@ -1715,12 +1715,12 @@ struct so no explicit check is required here (unlike in set) *) let current_val = if Cil.isIntegralType v.vtype then begin assert (offs = NoOffset); - `Bot + VD.Bot end else eval_rv_keep_bot (Analyses.ask_of_ctx ctx) ctx.global ctx.local (Lval (Var v, NoOffset)) in begin match current_val with - | `Bot -> (* current value is VD `Bot *) + | Bot -> (* current value is VD Bot *) begin match Addr.to_var_offset (AD.choose lval_val) with | Some (x,offs) -> let t = v.vtype in @@ -1755,7 +1755,7 @@ struct (* First we want to see, if we can determine a dead branch: *) match valu with (* For a boolean value: *) - | `Int value -> + | Int value -> if M.tracing then M.traceu "branch" "Expression %a evaluated to %a\n" d_exp exp ID.pretty value; begin match ID.to_bool value with | Some v -> @@ -1770,11 +1770,11 @@ struct refine () (* like fallback below *) end (* for some reason refine () can refine these, but not raise Deadcode in struct *) - | `Address ad when tv && AD.is_null ad -> + | Address ad when tv && AD.is_null ad -> raise Deadcode - | `Address ad when not tv && AD.is_not_null ad -> + | Address ad when not tv && AD.is_not_null ad -> raise Deadcode - | `Bot -> + | Bot -> if M.tracing then M.traceu "branch" "The branch %B is dead!\n" tv; raise Deadcode (* Otherwise we try to impose an invariant: *) @@ -1849,7 +1849,7 @@ struct collect_funargs ask ~warn gs st exps else ( let mpt e = match eval_rv_address ask gs st e with - | `Address a -> AD.remove NullPtr a + | Address a -> AD.remove NullPtr a | _ -> AD.empty () in List.map mpt exps @@ -2048,7 +2048,7 @@ struct let dest_a, dest_typ = addr_type_of_exp dest in let value = match eval_ch with - | `Int i when ID.to_int i = Some Z.zero -> + | Int i when ID.to_int i = Some Z.zero -> VD.zero_init_value dest_typ | _ -> VD.top_value dest_typ @@ -2114,15 +2114,15 @@ struct let dest_typ = get_type dst_lval in let dest_a = eval_lv (Analyses.ask_of_ctx ctx) gs st dst_lval in match eval_rv (Analyses.ask_of_ctx ctx) gs st mtyp with - | `Int x -> + | Int x -> begin match ID.to_int x with | Some z -> if M.tracing then M.tracel "attr" "setting\n"; - set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.of_int z)) - | None -> set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.top ())) + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.of_int z)) + | None -> set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) end - | _ -> set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (`MutexAttr (ValueDomain.MutexAttr.top ())) + | _ -> set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (MutexAttr (ValueDomain.MutexAttr.top ())) end | Identity e, _ -> begin match lv with @@ -2134,7 +2134,7 @@ struct let apply_unary fk float_fun x = let eval_x = eval_rv (Analyses.ask_of_ctx ctx) gs st x in begin match eval_x with - | `Float float_x -> float_fun (FD.cast_to fk float_x) + | Float float_x -> float_fun (FD.cast_to fk float_x) | _ -> failwith ("non-floating-point argument in call to function "^f.vname) end in @@ -2142,38 +2142,38 @@ struct let eval_x = eval_rv (Analyses.ask_of_ctx ctx) gs st x in let eval_y = eval_rv (Analyses.ask_of_ctx ctx) gs st y in begin match eval_x, eval_y with - | `Float float_x, `Float float_y -> float_fun (FD.cast_to fk float_x) (FD.cast_to fk float_y) + | Float float_x, Float float_y -> float_fun (FD.cast_to fk float_x) (FD.cast_to fk float_y) | _ -> failwith ("non-floating-point argument in call to function "^f.vname) end in - let result = + let result:value = begin match fun_args with - | Nan (fk, str) when Cil.isPointerType (Cilfacade.typeOf str) -> `Float (FD.nan_of fk) + | Nan (fk, str) when Cil.isPointerType (Cilfacade.typeOf str) -> Float (FD.nan_of fk) | Nan _ -> failwith ("non-pointer argument in call to function "^f.vname) - | Inf fk -> `Float (FD.inf_of fk) - | Isfinite x -> `Int (ID.cast_to IInt (apply_unary FDouble FD.isfinite x)) - | Isinf x -> `Int (ID.cast_to IInt (apply_unary FDouble FD.isinf x)) - | Isnan x -> `Int (ID.cast_to IInt (apply_unary FDouble FD.isnan x)) - | Isnormal x -> `Int (ID.cast_to IInt (apply_unary FDouble FD.isnormal x)) - | Signbit x -> `Int (ID.cast_to IInt (apply_unary FDouble FD.signbit x)) - | Ceil (fk,x) -> `Float (apply_unary fk FD.ceil x) - | Floor (fk,x) -> `Float (apply_unary fk FD.floor x) - | Fabs (fk, x) -> `Float (apply_unary fk FD.fabs x) - | Acos (fk, x) -> `Float (apply_unary fk FD.acos x) - | Asin (fk, x) -> `Float (apply_unary fk FD.asin x) - | Atan (fk, x) -> `Float (apply_unary fk FD.atan x) - | Atan2 (fk, y, x) -> `Float (apply_binary fk (fun y' x' -> FD.atan (FD.div y' x')) y x) - | Cos (fk, x) -> `Float (apply_unary fk FD.cos x) - | Sin (fk, x) -> `Float (apply_unary fk FD.sin x) - | Tan (fk, x) -> `Float (apply_unary fk FD.tan x) - | Isgreater (x,y) -> `Int(ID.cast_to IInt (apply_binary FDouble FD.gt x y)) - | Isgreaterequal (x,y) -> `Int(ID.cast_to IInt (apply_binary FDouble FD.ge x y)) - | Isless (x,y) -> `Int(ID.cast_to IInt (apply_binary FDouble FD.lt x y)) - | Islessequal (x,y) -> `Int(ID.cast_to IInt (apply_binary FDouble FD.le x y)) - | Islessgreater (x,y) -> `Int(ID.logor (ID.cast_to IInt (apply_binary FDouble FD.lt x y)) (ID.cast_to IInt (apply_binary FDouble FD.gt x y))) - | Isunordered (x,y) -> `Int(ID.cast_to IInt (apply_binary FDouble FD.unordered x y)) - | Fmax (fd, x ,y) -> `Float (apply_binary fd FD.fmax x y) - | Fmin (fd, x ,y) -> `Float (apply_binary fd FD.fmin x y) + | Inf fk -> Float (FD.inf_of fk) + | Isfinite x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isfinite x)) + | Isinf x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isinf x)) + | Isnan x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnan x)) + | Isnormal x -> Int (ID.cast_to IInt (apply_unary FDouble FD.isnormal x)) + | Signbit x -> Int (ID.cast_to IInt (apply_unary FDouble FD.signbit x)) + | Ceil (fk,x) -> Float (apply_unary fk FD.ceil x) + | Floor (fk,x) -> Float (apply_unary fk FD.floor x) + | Fabs (fk, x) -> Float (apply_unary fk FD.fabs x) + | Acos (fk, x) -> Float (apply_unary fk FD.acos x) + | Asin (fk, x) -> Float (apply_unary fk FD.asin x) + | Atan (fk, x) -> Float (apply_unary fk FD.atan x) + | Atan2 (fk, y, x) -> Float (apply_binary fk (fun y' x' -> FD.atan (FD.div y' x')) y x) + | Cos (fk, x) -> Float (apply_unary fk FD.cos x) + | Sin (fk, x) -> Float (apply_unary fk FD.sin x) + | Tan (fk, x) -> Float (apply_unary fk FD.tan x) + | Isgreater (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.gt x y)) + | Isgreaterequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.ge x y)) + | Isless (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.lt x y)) + | Islessequal (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.le x y)) + | Islessgreater (x,y) -> Int(ID.logor (ID.cast_to IInt (apply_binary FDouble FD.lt x y)) (ID.cast_to IInt (apply_binary FDouble FD.gt x y))) + | Isunordered (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.unordered x y)) + | Fmax (fd, x ,y) -> Float (apply_binary fd FD.fmax x y) + | Fmin (fd, x ,y) -> Float (apply_binary fd FD.fmin x y) end in begin match lv with @@ -2187,10 +2187,10 @@ struct | ThreadJoin { thread = id; ret_var }, _ -> let st' = match (eval_rv (Analyses.ask_of_ctx ctx) gs st ret_var) with - | `Int n when GobOption.exists (BI.equal BI.zero) (ID.to_int n) -> st - | `Address ret_a -> + | Int n when GobOption.exists (BI.equal BI.zero) (ID.to_int n) -> st + | Address ret_a -> begin match eval_rv (Analyses.ask_of_ctx ctx) gs st id with - | `Thread a -> + | Thread a -> let v = List.fold VD.join (VD.bot ()) (List.map (fun x -> G.thread (ctx.global (V.thread x))) (ValueDomain.Threads.elements a)) in (* TODO: is this type right? *) set ~ctx (Analyses.ask_of_ctx ctx) gs st ret_a (Cilfacade.typeOf ret_var) v @@ -2212,8 +2212,8 @@ struct else AD.from_var (heap_var ctx) in (* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ctx.ask gs st size); *) - set_many ~ctx (Analyses.ask_of_ctx ctx) gs st [(heap_var, TVoid [], `Blob (VD.bot (), eval_int (Analyses.ask_of_ctx ctx) gs st size, true)); - (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), `Address heap_var)] + set_many ~ctx (Analyses.ask_of_ctx ctx) gs st [(heap_var, TVoid [], Blob (VD.bot (), eval_int (Analyses.ask_of_ctx ctx) gs st size, true)); + (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), Address heap_var)] | _ -> st end | Calloc { count = n; size }, _ -> @@ -2227,8 +2227,8 @@ struct let ik = Cilfacade.ptrdiff_ikind () in let blobsize = ID.mul (ID.cast_to ik @@ eval_int (Analyses.ask_of_ctx ctx) gs st size) (ID.cast_to ik @@ eval_int (Analyses.ask_of_ctx ctx) gs st n) 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 (Analyses.ask_of_ctx ctx) gs st [(add_null (AD.from_var heap_var), TVoid [], `Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.one) (`Blob (VD.bot (), blobsize, false)))); - (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), `Address (add_null (AD.from_var_offset (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset)))))] + set_many ~ctx (Analyses.ask_of_ctx ctx) gs st [(add_null (AD.from_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.one) (Blob (VD.bot (), blobsize, false)))); + (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.from_var_offset (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset)))))] | _ -> st end | Realloc { ptr = p; size }, _ -> @@ -2238,16 +2238,16 @@ struct let p_rv = eval_rv ask gs st p in let p_addr = match p_rv with - | `Address a -> a + | Address a -> a (* TODO: don't we already have logic for this? *) - | `Int i when ID.to_int i = Some BI.zero -> AD.null_ptr - | `Int i -> AD.top_ptr + | Int i when ID.to_int i = Some BI.zero -> AD.null_ptr + | Int i -> AD.top_ptr | _ -> AD.top_ptr (* TODO: why does this ever happen? *) in 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 ask gs st p_addr' None in (* implicitly includes join of malloc value (VD.bot) *) let size_int = eval_int ask gs st size in - let heap_val = `Blob (p_addr_get, size_int, true) in (* copy old contents with new size *) + let heap_val:value = Blob (p_addr_get, size_int, true) in (* copy old contents with new size *) let heap_addr = AD.from_var (heap_var ctx) in let heap_addr' = if get_bool "sem.malloc.fail" then @@ -2258,7 +2258,7 @@ struct let lv_addr = eval_lv ask gs st lv in set_many ~ctx ask gs st [ (heap_addr, TVoid [], heap_val); - (lv_addr, Cilfacade.typeOfLval lv, `Address heap_addr'); + (lv_addr, Cilfacade.typeOfLval lv, Address heap_addr'); ] (* TODO: free (i.e. invalidate) old blob if successful? *) | None -> st @@ -2267,8 +2267,8 @@ struct | Setjmp { env }, _ -> let ask = Analyses.ask_of_ctx ctx in let st' = match eval_rv ask gs st env with - | `Address jmp_buf -> - let value = `JmpBuf (ValueDomain.JmpBufs.Bufs.singleton (Target (ctx.prev_node, ctx.control_context ())), false) in + | Address jmp_buf -> + let value = VD.JmpBuf (ValueDomain.JmpBufs.Bufs.singleton (Target (ctx.prev_node, ctx.control_context ())), false) in let r = set ~ctx ask gs st jmp_buf (Cilfacade.typeOf env) value in if M.tracing then M.tracel "setjmp" "setting setjmp %a on %a -> %a\n" d_exp env D.pretty st D.pretty r; r @@ -2276,22 +2276,22 @@ struct in begin match lv with | Some lv -> - set ~ctx ask gs st' (eval_lv ask ctx.global st lv) (Cilfacade.typeOfLval lv) (`Int (ID.of_int IInt BI.zero)) + set ~ctx ask gs st' (eval_lv ask ctx.global st lv) (Cilfacade.typeOfLval lv) (Int (ID.of_int IInt BI.zero)) | None -> st' end | Longjmp {env; value}, _ -> let ask = Analyses.ask_of_ctx ctx in - let ensure_not_zero rv = match rv with - | `Int i -> + let ensure_not_zero (rv:value) = match rv with + | Int i -> begin match ID.to_bool i with | Some true -> rv | Some false -> M.error "Must: Longjmp with a value of 0 is silently changed to 1"; - `Int (ID.of_int (ID.ikind i) Z.one) + Int (ID.of_int (ID.ikind i) Z.one) | None -> M.warn "May: Longjmp with a value of 0 is silently changed to 1"; let ik = ID.ikind i in - `Int (ID.join (ID.meet i (ID.of_excl_list ik [Z.zero])) (ID.of_int ik Z.one)) + Int (ID.join (ID.meet i (ID.of_excl_list ik [Z.zero])) (ID.of_int ik Z.one)) end | _ -> M.warn ~category:Program "Arguments to longjmp are strange!"; @@ -2326,7 +2326,7 @@ struct match (CPA.find_opt v (fun_st.cpa)), lval_type with | None, _ -> st (* partitioned arrays cannot be copied by individual lvalues, so if tainted just copy the whole callee value for the array variable *) - | Some (`Array a), _ when (CArrays.domain_of_t a) = PartitionedDomain -> {st with cpa = CPA.add v (`Array a) st.cpa} + | Some (Array a), _ when (CArrays.domain_of_t a) = PartitionedDomain -> {st with cpa = CPA.add v (Array a) st.cpa} (* "get" returned "unknown" when applied to a void type, so special case void types. This caused problems with some sv-comps (e.g. regtest 64 11) *) | Some voidVal, TVoid _ -> {st with cpa = CPA.add v voidVal st.cpa} | _, _ -> begin @@ -2592,7 +2592,7 @@ struct Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) (priv_sideg ctx.sideg) st | Events.AssignSpawnedThread (lval, tid) -> (* TODO: is this type right? *) - set ~ctx (Analyses.ask_of_ctx ctx) ctx.global ctx.local (eval_lv (Analyses.ask_of_ctx ctx) ctx.global ctx.local lval) (Cilfacade.typeOfLval lval) (`Thread (ValueDomain.Threads.singleton tid)) + set ~ctx (Analyses.ask_of_ctx ctx) ctx.global ctx.local (eval_lv (Analyses.ask_of_ctx ctx) ctx.global ctx.local lval) (Cilfacade.typeOfLval lval) (Thread (ValueDomain.Threads.singleton tid)) | Events.Assert exp -> assert_fn ctx exp true | Events.Unassume {exp; uuids} -> diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index fe7a1069ff..5013bba31d 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -54,15 +54,15 @@ struct let is_some_bot x = match x with - | `Bot -> false (* HACK: bot is here due to typing conflict (we do not cast appropriately) *) + | VD.Bot -> false (* HACK: bot is here due to typing conflict (we do not cast appropriately) *) | _ -> VD.is_bot_value x let apply_invariant oldv newv = match oldv, newv with - (* | `Address o, `Address n when AD.mem (Addr.unknown_ptr ()) o && AD.mem (Addr.unknown_ptr ()) n -> *) - (* `Address (AD.join o n) *) - (* | `Address o, `Address n when AD.mem (Addr.unknown_ptr ()) o -> `Address n *) - (* | `Address o, `Address n when AD.mem (Addr.unknown_ptr ()) n -> `Address o *) + (* | Address o, Address n when AD.mem (Addr.unknown_ptr ()) o && AD.mem (Addr.unknown_ptr ()) n -> *) + (* Address (AD.join o n) *) + (* | Address o, Address n when AD.mem (Addr.unknown_ptr ()) o -> Address n *) + (* | Address o, Address n when AD.mem (Addr.unknown_ptr ()) n -> Address o *) | _ -> VD.meet oldv newv let refine_lv_fallback ctx a gs st lval value tv = @@ -132,34 +132,34 @@ struct | Eq, x, value, true -> if M.tracing then M.tracec "invariant" "Yes, %a equals %a\n" d_lval x VD.pretty value; (match value with - | `Int n -> + | Int n -> let ikind = Cilfacade.get_ikind_exp (Lval lval) in - Some (x, `Int (ID.cast_to ikind n)) + Some (x, VD.Int (ID.cast_to ikind n)) | _ -> Some(x, value)) (* The false-branch for x == value: *) | Eq, x, value, false -> begin match value with - | `Int n -> begin + | Int n -> begin match ID.to_int n with | Some n -> (* When x != n, we can return a singleton exclusion set *) if M.tracing then M.tracec "invariant" "Yes, %a is not %s\n" d_lval x (BI.to_string n); let ikind = Cilfacade.get_ikind_exp (Lval lval) in - Some (x, `Int (ID.of_excl_list ikind [n])) + Some (x, Int (ID.of_excl_list ikind [n])) | None -> None end - | `Address n -> begin + | Address n -> begin if M.tracing then M.tracec "invariant" "Yes, %a is not %a\n" d_lval x AD.pretty n; match eval_rv_address a gs st (Lval x) with - | `Address a when AD.is_definite n -> - Some (x, `Address (AD.diff a n)) - | `Top when AD.is_null n -> - Some (x, `Address AD.not_null) + | Address a when AD.is_definite n -> + Some (x, Address (AD.diff a n)) + | Top when AD.is_null n -> + Some (x, Address AD.not_null) | v -> if M.tracing then M.tracec "invariant" "No address invariant for: %a != %a\n" VD.pretty v AD.pretty n; None end - (* | `Address a -> Some (x, value) *) + (* | Address a -> Some (x, value) *) | _ -> (* We can't say anything else, exclusion sets are finite, so not * being in one means an infinite number of values *) @@ -169,7 +169,7 @@ struct | Ne, x, value, _ -> helper Eq x value (not tv) | Lt, x, value, _ -> begin match value with - | `Int n -> begin + | Int n -> begin let ikind = Cilfacade.get_ikind_exp (Lval lval) in let n = ID.cast_to ikind n in let range_from x = if tv then ID.ending ikind (BI.sub x BI.one) else ID.starting ikind x in @@ -177,14 +177,14 @@ struct match limit_from n with | Some n -> if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" d_lval x (BI.to_string n); - Some (x, `Int (range_from n)) + Some (x, Int (range_from n)) | None -> None end | _ -> None end | Le, x, value, _ -> begin match value with - | `Int n -> begin + | Int n -> begin let ikind = Cilfacade.get_ikind_exp (Lval lval) in let n = ID.cast_to ikind n in let range_from x = if tv then ID.ending ikind x else ID.starting ikind (BI.add x BI.one) in @@ -192,7 +192,7 @@ struct match limit_from n with | Some n -> if M.tracing then M.tracec "invariant" "Yes, success! %a is not %s\n\n" d_lval x (BI.to_string n); - Some (x, `Int (range_from n)) + Some (x, Int (range_from n)) | None -> None end | _ -> None @@ -206,9 +206,9 @@ struct if M.tracing then M.traceli "invariant" "assume expression %a is %B\n" d_exp exp tv; let null_val typ = match Cil.unrollType typ with - | TPtr _ -> `Address AD.null_ptr + | TPtr _ -> VD.Address AD.null_ptr | TEnum({ekind=_;_},_) - | _ -> `Int (ID.of_int (Cilfacade.get_ikind typ) BI.zero) + | _ -> Int (ID.of_int (Cilfacade.get_ikind typ) BI.zero) in let rec derived_invariant exp tv = let switchedOp = function Lt -> Gt | Gt -> Lt | Le -> Ge | Ge -> Le | x -> x in (* a op b <=> b (switchedOp op) b *) @@ -220,7 +220,7 @@ struct -> derived_invariant (BinOp (op, c1, c2, t)) tv | BinOp(op, CastE (TInt (ik, _) as t1, Lval x), rval, typ) -> (match eval_rv a gs st (Lval x) with - | `Int v -> + | Int v -> (* This is tricky: It it is not sufficient to check that ID.cast_to_ik v = v * If there is one domain that knows this to be true and the other does not, we * should still impose the invariant. E.g. i -> ([1,5]; Not {0}[byte]) *) @@ -547,12 +547,12 @@ struct with FloatDomain.ArithmeticOnFloatBot _ -> raise Analyses.Deadcode in let eval e st = eval_rv a gs st e in - let eval_bool e st = match eval e st with `Int i -> ID.to_bool i | _ -> None in + let eval_bool e st = match eval e st with Int i -> ID.to_bool i | _ -> None in let rec inv_exp c_typed exp (st:D.t): D.t = (* trying to improve variables in an expression so it is bottom means dead code *) if VD.is_bot_value c_typed then contra st else match exp, c_typed with - | UnOp (LNot, e, _), `Int c -> + | UnOp (LNot, e, _), Int c -> let ikind = Cilfacade.get_ikind_exp e in let c' = match ID.to_bool (unop_ID LNot c) with @@ -563,13 +563,13 @@ struct | Some false -> ID.of_bool ikind false | _ -> ID.top_of ikind in - inv_exp (`Int c') e st - | UnOp (Neg, e, _), `Float c -> inv_exp (`Float (unop_FD Neg c)) e st - | UnOp ((BNot|Neg) as op, e, _), `Int c -> inv_exp (`Int (unop_ID op c)) e st - (* no equivalent for `Float, as VD.is_safe_cast fails for all float types anyways *) - | BinOp((Eq | Ne) as op, CastE (t1, e1), CastE (t2, e2), t), `Int c when typeSig (Cilfacade.typeOf e1) = typeSig (Cilfacade.typeOf e2) && VD.is_safe_cast t1 (Cilfacade.typeOf e1) && VD.is_safe_cast t2 (Cilfacade.typeOf e2) -> - inv_exp (`Int c) (BinOp (op, e1, e2, t)) st - | BinOp (LOr, arg1, arg2, typ) as exp, `Int c -> + inv_exp (Int c') e st + | UnOp (Neg, e, _), Float c -> inv_exp (Float (unop_FD Neg c)) e st + | UnOp ((BNot|Neg) as op, e, _), Int c -> inv_exp (Int (unop_ID op c)) e st + (* no equivalent for Float, as VD.is_safe_cast fails for all float types anyways *) + | BinOp((Eq | Ne) as op, CastE (t1, e1), CastE (t2, e2), t), Int c when typeSig (Cilfacade.typeOf e1) = typeSig (Cilfacade.typeOf e2) && VD.is_safe_cast t1 (Cilfacade.typeOf e1) && VD.is_safe_cast t2 (Cilfacade.typeOf e2) -> + inv_exp (Int c) (BinOp (op, e1, e2, t)) st + | BinOp (LOr, arg1, arg2, typ) as exp, Int c -> (* copied & modified from eval_rv_base... *) let (let*) = Option.bind in (* split nested LOr Eqs to equality pairs, if possible *) @@ -605,25 +605,25 @@ struct let v = eval e st in (* value of common exp *) let vs = List.map (fun e -> eval e st) es in (* values of other sides *) match v with - | `Address _ -> + | Address _ -> (* get definite addrs from vs *) let rec to_definite_ad = function | [] -> AD.empty () - | `Address a :: vs when AD.is_definite a -> + | VD.Address a :: vs when AD.is_definite a -> AD.union a (to_definite_ad vs) | _ :: vs -> AD.top () in let definite_ad = to_definite_ad vs in - let c' = `Address definite_ad in + let c' = VD.Address definite_ad in Some (inv_exp c' e st) - | `Int i -> + | Int i -> let ik = ID.ikind i in let module BISet = IntDomain.BISet in (* get definite ints from vs *) let rec to_int_id = function | [] -> ID.bot_of ik - | `Int i :: vs -> + | VD.Int i :: vs -> begin match ID.to_int i with | Some i' -> ID.join i (to_int_id vs) | None -> ID.top_of ik @@ -632,7 +632,7 @@ struct ID.top_of ik in let int_id = to_int_id vs in - let c' = `Int int_id in + let c' = VD.Int int_id in Some (inv_exp c' e st) | _ -> None @@ -640,88 +640,88 @@ struct begin match eqs_st with | Some st -> st | None when ID.to_bool c = Some true -> - begin match inv_exp (`Int c) arg1 st with + begin match inv_exp (Int c) arg1 st with | st1 -> - begin match inv_exp (`Int c) arg2 st with + begin match inv_exp (Int c) arg2 st with | st2 -> D.join st1 st2 | exception Analyses.Deadcode -> st1 end - | exception Analyses.Deadcode -> inv_exp (`Int c) arg2 st (* Deadcode falls through *) + | exception Analyses.Deadcode -> inv_exp (Int c) arg2 st (* Deadcode falls through *) end | None -> st (* TODO: not bothering to fall back, no other case can refine LOr anyway *) end - | (BinOp (op, e1, e2, _) as e, `Float _) - | (BinOp (op, e1, e2, _) as e, `Int _) -> + | (BinOp (op, e1, e2, _) as e, Float _) + | (BinOp (op, e1, e2, _) as e, Int _) -> let invert_binary_op c pretty c_int c_float = if M.tracing then M.tracel "inv" "binop %a with %a %a %a == %a\n" d_exp e VD.pretty (eval e1 st) d_binop op VD.pretty (eval e2 st) pretty c; (match eval e1 st, eval e2 st with - | `Int a, `Int b -> + | Int a, Int b -> let ikind = Cilfacade.get_ikind_exp e1 in (* both operands have the same type (except for Shiftlt, Shiftrt)! *) let ikres = Cilfacade.get_ikind_exp e in (* might be different from argument types, e.g. for LT, GT, EQ, ... *) let a', b' = inv_bin_int (a, b) ikind (c_int ikres) op in if M.tracing then M.tracel "inv" "binop: %a, c: %a, a': %a, b': %a\n" d_exp e ID.pretty (c_int ikind) ID.pretty a' ID.pretty b'; - let st' = inv_exp (`Int a') e1 st in - let st'' = inv_exp (`Int b') e2 st' in + let st' = inv_exp (Int a') e1 st in + let st'' = inv_exp (Int b') e2 st' in st'' - | `Float a, `Float b -> + | Float a, Float b -> let fkind = Cilfacade.get_fkind_exp e1 in (* both operands have the same type *) let a', b' = inv_bin_float (a, b) (c_float fkind) op in if M.tracing then M.tracel "inv" "binop: %a, c: %a, a': %a, b': %a\n" d_exp e FD.pretty (c_float fkind) FD.pretty a' FD.pretty b'; - let st' = inv_exp (`Float a') e1 st in - let st'' = inv_exp (`Float b') e2 st' in + let st' = inv_exp (Float a') e1 st in + let st'' = inv_exp (Float b') e2 st' in st'' - (* Mixed `Float and `Int cases should never happen, as there are no binary operators with one float and one int parameter ?!*) - | `Int _, `Float _ | `Float _, `Int _ -> failwith "ill-typed program"; - (* | `Address a, `Address b -> ... *) - | a1, a2 -> fallback (GobPretty.sprintf "binop: got abstract values that are not `Int: %a and %a" VD.pretty a1 VD.pretty a2) st) + (* Mixed Float and Int cases should never happen, as there are no binary operators with one float and one int parameter ?!*) + | Int _, Float _ | Float _, Int _ -> failwith "ill-typed program"; + (* | Address a, Address b -> ... *) + | a1, a2 -> fallback (GobPretty.sprintf "binop: got abstract values that are not Int: %a and %a" VD.pretty a1 VD.pretty a2) st) (* use closures to avoid unused casts *) in (match c_typed with - | `Int c -> invert_binary_op c ID.pretty (fun ik -> ID.cast_to ik c) (fun fk -> FD.of_int fk c) - | `Float c -> invert_binary_op c FD.pretty (fun ik -> FD.to_int ik c) (fun fk -> FD.cast_to fk c) + | Int c -> invert_binary_op c ID.pretty (fun ik -> ID.cast_to ik c) (fun fk -> FD.of_int fk c) + | Float c -> invert_binary_op c FD.pretty (fun ik -> FD.to_int ik c) (fun fk -> FD.cast_to fk c) | _ -> failwith "unreachable") - | Lval x, (`Int _ | `Float _ | `Address _) -> (* meet x with c *) + | Lval x, (Int _ | Float _ | Address _) -> (* meet x with c *) let update_lval c x c' pretty = refine_lv ctx a gs st c x c' pretty exp in let t = Cil.unrollType (Cilfacade.typeOfLval x) in (* unroll type to deal with TNamed *) begin match c_typed with - | `Int c -> + | Int c -> let c' = match t with - | TPtr _ -> `Address (AD.of_int (module ID) c) + | TPtr _ -> VD.Address (AD.of_int (module ID) c) | TInt (ik, _) - | TEnum ({ekind = ik; _}, _) -> `Int (ID.cast_to ik c) - | TFloat (fk, _) -> `Float (FD.of_int fk c) - | _ -> `Int c + | TEnum ({ekind = ik; _}, _) -> Int (ID.cast_to ik c) + | TFloat (fk, _) -> Float (FD.of_int fk c) + | _ -> Int c in update_lval c x c' ID.pretty - | `Float c -> + | Float c -> let c' = match t with (* | TPtr _ -> ..., pointer conversion from/to float is not supported *) - | TInt (ik, _) -> `Int (FD.to_int ik c) + | TInt (ik, _) -> VD.Int (FD.to_int ik c) (* this is theoretically possible and should be handled correctly, however i can't imagine an actual piece of c code producing this?! *) - | TEnum ({ekind = ik; _}, _) -> `Int (FD.to_int ik c) - | TFloat (fk, _) -> `Float (FD.cast_to fk c) - | _ -> `Float c + | TEnum ({ekind = ik; _}, _) -> Int (FD.to_int ik c) + | TFloat (fk, _) -> Float (FD.cast_to fk c) + | _ -> Float c in update_lval c x c' FD.pretty - | `Address c -> + | Address c -> let c' = c_typed in (* TODO: need any of the type-matching nonsense? *) update_lval c x c' AD.pretty | _ -> assert false end | Const _ , _ -> st (* nothing to do *) - | CastE ((TFloat (_, _)), e), `Float c -> + | CastE ((TFloat (_, _)), e), Float c -> (match unrollType (Cilfacade.typeOf e), FD.get_fkind c with | TFloat (FLongDouble as fk, _), FFloat | TFloat (FDouble as fk, _), FFloat | TFloat (FLongDouble as fk, _), FDouble | TFloat (fk, _), FLongDouble | TFloat (FDouble as fk, _), FDouble - | TFloat (FFloat as fk, _), FFloat -> inv_exp (`Float (FD.cast_to fk c)) e st + | TFloat (FFloat as fk, _), FFloat -> inv_exp (Float (FD.cast_to fk c)) e st | _ -> fallback ("CastE: incompatible types") st) - | CastE ((TInt (ik, _)) as t, e), `Int c - | CastE ((TEnum ({ekind = ik; _ }, _)) as t, e), `Int c -> (* Can only meet the t part of an Lval in e with c (unless we meet with all overflow possibilities)! Since there is no good way to do this, we only continue if e has no values outside of t. *) + | CastE ((TInt (ik, _)) as t, e), Int c + | CastE ((TEnum ({ekind = ik; _ }, _)) as t, e), Int c -> (* Can only meet the t part of an Lval in e with c (unless we meet with all overflow possibilities)! Since there is no good way to do this, we only continue if e has no values outside of t. *) (match eval e st with - | `Int i -> + | Int i -> if ID.leq i (ID.cast_to ik i) then match unrollType (Cilfacade.typeOf e) with | TInt(ik_e, _) @@ -729,11 +729,11 @@ struct (* let c' = ID.cast_to ik_e c in *) let c' = ID.cast_to ik_e (ID.meet c (ID.cast_to ik (ID.top_of ik_e))) in (* TODO: cast without overflow, is this right for normal invariant? *) if M.tracing then M.tracel "inv" "cast: %a from %a to %a: i = %a; cast c = %a to %a = %a\n" d_exp e d_ikind ik_e d_ikind ik ID.pretty i ID.pretty c d_ikind ik_e ID.pretty c'; - inv_exp (`Int c') e st - | x -> fallback (GobPretty.sprintf "CastE: e did evaluate to `Int, but the type did not match %a" CilType.Typ.pretty t) st + inv_exp (Int c') e st + | x -> fallback (GobPretty.sprintf "CastE: e did evaluate to Int, but the type did not match %a" CilType.Typ.pretty t) st else fallback (GobPretty.sprintf "CastE: %a evaluates to %a which is bigger than the type it is cast to which is %a" d_plainexp e ID.pretty i CilType.Typ.pretty t) st - | v -> fallback (GobPretty.sprintf "CastE: e did not evaluate to `Int, but %a" VD.pretty v) st) + | v -> fallback (GobPretty.sprintf "CastE: e did not evaluate to Int, but %a" VD.pretty v) st) | e, _ -> fallback (GobPretty.sprintf "%a not implemented" d_plainexp e) st in if eval_bool exp st = Some (not tv) then contra st (* we already know that the branch is dead *) @@ -751,7 +751,7 @@ struct else ID.of_excl_list ik [BI.zero] (* Lvals, Casts, arithmetic operations etc. should work with true = non_zero *) in - inv_exp (`Int itv) exp st + inv_exp (Int itv) exp st with Invalid_argument _ -> let fk = Cilfacade.get_fkind_exp exp in let ftv = if not tv then (* false is 0, but true can be anything that is not 0, except for comparisons which yield 1 *) @@ -759,5 +759,5 @@ struct else FD.top_of fk in - inv_exp (`Float ftv) exp st + inv_exp (Float ftv) exp st end diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml index 242d83e708..6950c16889 100644 --- a/src/cdomains/baseDomain.ml +++ b/src/cdomains/baseDomain.ml @@ -160,7 +160,7 @@ module DomWithTrivialExpEval (PrivD: Lattice.S) = DomFunctor (PrivD) (struct | Lval (Var v, NoOffset) -> begin match CPA.find v r.cpa with - | `Int i -> ValueDomain.ID.to_int i + | Int i -> ValueDomain.ID.to_int i | _ -> None end | _ -> None diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 7cba43ecc2..3cac7dec5d 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -76,37 +76,39 @@ end module Threads = ConcDomain.ThreadSet module JmpBufs = JmpBufDomain.JmpBufSetTaint -module rec Compound: S with type t = [ - | `Top - | `Int of ID.t - | `Float of FD.t - | `Address of AD.t - | `Struct of Structs.t - | `Union of Unions.t - | `Array of CArrays.t - | `Blob of Blobs.t - | `Thread of Threads.t - | `JmpBuf of JmpBufs.t - | `Mutex - | `MutexAttr of MutexAttr.t - | `Bot - ] and type offs = (fieldinfo,IndexDomain.t) Lval.offs = +module rec Compound: sig + type t = | Top + | Int of ID.t + | Float of FD.t + | Address of AD.t + | Struct of Structs.t + | Union of Unions.t + | Array of CArrays.t + | Blob of Blobs.t + | Thread of Threads.t + | JmpBuf of JmpBufs.t + | Mutex + | MutexAttr of MutexAttrDomain.t + | Bot + [@@deriving eq, ord, hash] + include S with type t := t and type offs = (fieldinfo,IndexDomain.t) Lval.offs +end = struct - type t = [ - | `Top - | `Int of ID.t - | `Float of FD.t - | `Address of AD.t - | `Struct of Structs.t - | `Union of Unions.t - | `Array of CArrays.t - | `Blob of Blobs.t - | `Thread of Threads.t - | `JmpBuf of JmpBufs.t - | `Mutex - | `MutexAttr of MutexAttrDomain.t - | `Bot - ] [@@deriving eq, ord, hash] + type t = + | Top + | Int of ID.t + | Float of FD.t + | Address of AD.t + | Struct of Structs.t + | Union of Unions.t + | Array of CArrays.t + | Blob of Blobs.t + | Thread of Threads.t + | JmpBuf of JmpBufs.t + | Mutex + | MutexAttr of MutexAttrDomain.t + | Bot + [@@deriving eq, ord, hash] let is_mutexattr_type (t:typ): bool = match t with | TNamed (info, attr) -> info.tname = "pthread_mutexattr_t" @@ -133,101 +135,101 @@ struct let rec bot_value ?(varAttr=[]) (t: typ): t = match t with - | _ when is_mutex_type t -> `Mutex - | t when is_jmp_buf_type t -> `JmpBuf (JmpBufs.bot ()) - | TInt _ -> `Bot (*`Int (ID.bot ()) -- should be lower than any int or address*) - | TFloat _ -> `Bot - | TPtr _ -> `Address (AD.bot ()) - | TComp ({cstruct=true; _} as ci,_) -> `Struct (Structs.create (fun fd -> bot_value ~varAttr:fd.fattr fd.ftype) ci) - | TComp ({cstruct=false; _},_) -> `Union (Unions.bot ()) + | _ when is_mutex_type t -> Mutex + | t when is_jmp_buf_type t -> JmpBuf (JmpBufs.bot ()) + | TInt _ -> Bot (*Int (ID.bot ()) -- should be lower than any int or address*) + | TFloat _ -> Bot + | TPtr _ -> Address (AD.bot ()) + | TComp ({cstruct=true; _} as ci,_) -> Struct (Structs.create (fun fd -> bot_value ~varAttr:fd.fattr fd.ftype) ci) + | TComp ({cstruct=false; _},_) -> Union (Unions.bot ()) | TArray (ai, length, _) -> let typAttr = typeAttrs ai in let len = array_length_idx (IndexDomain.bot ()) length in - `Array (CArrays.make ~varAttr ~typAttr len (bot_value ai)) - | t when is_thread_type t -> `Thread (ConcDomain.ThreadSet.empty ()) - | t when is_mutexattr_type t -> `MutexAttr (MutexAttrDomain.bot ()) - | t when is_jmp_buf_type t -> `JmpBuf (JmpBufs.Bufs.empty (), false) + Array (CArrays.make ~varAttr ~typAttr len (bot_value ai)) + | t when is_thread_type t -> Thread (ConcDomain.ThreadSet.empty ()) + | t when is_mutexattr_type t -> MutexAttr (MutexAttrDomain.bot ()) + | t when is_jmp_buf_type t -> JmpBuf (JmpBufs.Bufs.empty (), false) | TNamed ({ttype=t; _}, _) -> bot_value ~varAttr (unrollType t) - | _ -> `Bot + | _ -> Bot let is_bot_value x = match x with - | `Int x -> ID.is_bot x - | `Float x -> FD.is_bot x - | `Address x -> AD.is_bot x - | `Struct x -> Structs.is_bot x - | `Union x -> Unions.is_bot x - | `Array x -> CArrays.is_bot x - | `Blob x -> Blobs.is_bot x - | `Thread x -> Threads.is_bot x - | `JmpBuf x -> JmpBufs.is_bot x - | `Mutex -> true - | `MutexAttr x -> MutexAttr.is_bot x - | `Bot -> true - | `Top -> false + | Int x -> ID.is_bot x + | Float x -> FD.is_bot x + | Address x -> AD.is_bot x + | Struct x -> Structs.is_bot x + | Union x -> Unions.is_bot x + | Array x -> CArrays.is_bot x + | Blob x -> Blobs.is_bot x + | Thread x -> Threads.is_bot x + | JmpBuf x -> JmpBufs.is_bot x + | Mutex -> true + | MutexAttr x -> MutexAttr.is_bot x + | Bot -> true + | Top -> false let rec init_value ?(varAttr=[]) (t: typ): t = (* top_value is not used here because structs, blob etc will not contain the right members *) match t with - | t when is_mutex_type t -> `Mutex - | t when is_jmp_buf_type t -> `JmpBuf (JmpBufs.top ()) - | t when is_mutexattr_type t -> `MutexAttr (MutexAttrDomain.top ()) - | TInt (ik,_) -> `Int (ID.top_of ik) - | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> `Float (FD.top_of fkind) - | TPtr _ -> `Address AD.top_ptr - | TComp ({cstruct=true; _} as ci,_) -> `Struct (Structs.create (fun fd -> init_value ~varAttr:fd.fattr fd.ftype) ci) - | TComp ({cstruct=false; _},_) -> `Union (Unions.top ()) + | t when is_mutex_type t -> Mutex + | t when is_jmp_buf_type t -> JmpBuf (JmpBufs.top ()) + | t when is_mutexattr_type t -> MutexAttr (MutexAttrDomain.top ()) + | TInt (ik,_) -> Int (ID.top_of ik) + | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> Float (FD.top_of fkind) + | TPtr _ -> Address AD.top_ptr + | TComp ({cstruct=true; _} as ci,_) -> Struct (Structs.create (fun fd -> init_value ~varAttr:fd.fattr fd.ftype) ci) + | TComp ({cstruct=false; _},_) -> Union (Unions.top ()) | TArray (ai, length, _) -> let typAttr = typeAttrs ai in let can_recover_from_top = ArrayDomain.can_recover_from_top (ArrayDomain.get_domain ~varAttr ~typAttr) in let len = array_length_idx (IndexDomain.bot ()) length in - `Array (CArrays.make ~varAttr ~typAttr len (if can_recover_from_top then (init_value ai) else (bot_value ai))) - (* | t when is_thread_type t -> `Thread (ConcDomain.ThreadSet.empty ()) *) + Array (CArrays.make ~varAttr ~typAttr len (if can_recover_from_top then (init_value ai) else (bot_value ai))) + (* | t when is_thread_type t -> Thread (ConcDomain.ThreadSet.empty ()) *) | TNamed ({ttype=t; _}, _) -> init_value ~varAttr t - | _ -> `Top + | _ -> Top let rec top_value ?(varAttr=[]) (t: typ): t = match t with - | _ when is_mutex_type t -> `Mutex - | t when is_jmp_buf_type t -> `JmpBuf (JmpBufs.top ()) - | t when is_mutexattr_type t -> `MutexAttr (MutexAttrDomain.top ()) - | TInt (ik,_) -> `Int (ID.(cast_to ik (top_of ik))) - | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> `Float (FD.top_of fkind) - | TPtr _ -> `Address AD.top_ptr - | TComp ({cstruct=true; _} as ci,_) -> `Struct (Structs.create (fun fd -> top_value ~varAttr:fd.fattr fd.ftype) ci) - | TComp ({cstruct=false; _},_) -> `Union (Unions.top ()) + | _ when is_mutex_type t -> Mutex + | t when is_jmp_buf_type t -> JmpBuf (JmpBufs.top ()) + | t when is_mutexattr_type t -> MutexAttr (MutexAttrDomain.top ()) + | TInt (ik,_) -> Int (ID.(cast_to ik (top_of ik))) + | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> Float (FD.top_of fkind) + | TPtr _ -> Address AD.top_ptr + | TComp ({cstruct=true; _} as ci,_) -> Struct (Structs.create (fun fd -> top_value ~varAttr:fd.fattr fd.ftype) ci) + | TComp ({cstruct=false; _},_) -> Union (Unions.top ()) | TArray (ai, length, _) -> let typAttr = typeAttrs ai in let can_recover_from_top = ArrayDomain.can_recover_from_top (ArrayDomain.get_domain ~varAttr ~typAttr) in let len = array_length_idx (IndexDomain.top ()) length in - `Array (CArrays.make ~varAttr ~typAttr len (if can_recover_from_top then (top_value ai) else (bot_value ai))) + Array (CArrays.make ~varAttr ~typAttr len (if can_recover_from_top then (top_value ai) else (bot_value ai))) | TNamed ({ttype=t; _}, _) -> top_value ~varAttr t - | _ -> `Top + | _ -> Top let is_top_value x (t: typ) = match x with - | `Int x -> ID.is_top_of (Cilfacade.get_ikind (t)) x - | `Float x -> FD.is_top x - | `Address x -> AD.is_top x - | `Struct x -> Structs.is_top x - | `Union x -> Unions.is_top x - | `Array x -> CArrays.is_top x - | `Blob x -> Blobs.is_top x - | `Thread x -> Threads.is_top x - | `MutexAttr x -> MutexAttr.is_top x - | `JmpBuf x -> JmpBufs.is_top x - | `Mutex -> true - | `Top -> true - | `Bot -> false + | Int x -> ID.is_top_of (Cilfacade.get_ikind (t)) x + | Float x -> FD.is_top x + | Address x -> AD.is_top x + | Struct x -> Structs.is_top x + | Union x -> Unions.is_top x + | Array x -> CArrays.is_top x + | Blob x -> Blobs.is_top x + | Thread x -> Threads.is_top x + | MutexAttr x -> MutexAttr.is_top x + | JmpBuf x -> JmpBufs.is_top x + | Mutex -> true + | Top -> true + | Bot -> false let rec zero_init_value ?(varAttr=[]) (t:typ): t = match t with - | _ when is_mutex_type t -> `Mutex - | t when is_jmp_buf_type t -> `JmpBuf (JmpBufs.top ()) - | t when is_mutexattr_type t -> `MutexAttr (MutexAttrDomain.top ()) - | TInt (ikind, _) -> `Int (ID.of_int ikind BI.zero) - | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> `Float (FD.of_const fkind 0.0) - | TPtr _ -> `Address AD.null_ptr - | TComp ({cstruct=true; _} as ci,_) -> `Struct (Structs.create (fun fd -> zero_init_value ~varAttr:fd.fattr fd.ftype) ci) + | _ when is_mutex_type t -> Mutex + | t when is_jmp_buf_type t -> JmpBuf (JmpBufs.top ()) + | t when is_mutexattr_type t -> MutexAttr (MutexAttrDomain.top ()) + | TInt (ikind, _) -> Int (ID.of_int ikind BI.zero) + | TFloat (fkind, _) when not (Cilfacade.isComplexFKind fkind) -> Float (FD.of_const fkind 0.0) + | TPtr _ -> Address AD.null_ptr + | TComp ({cstruct=true; _} as ci,_) -> Struct (Structs.create (fun fd -> zero_init_value ~varAttr:fd.fattr fd.ftype) ci) | TComp ({cstruct=false; _} as ci,_) -> let v = try (* C99 6.7.8.10: the first named member is initialized (recursively) according to these rules *) @@ -237,17 +239,17 @@ struct (* Union with no members ò.O *) Failure _ -> Unions.top () in - `Union(v) + Union(v) | TArray (ai, length, _) -> let typAttr = typeAttrs ai in let len = array_length_idx (IndexDomain.top ()) length in - `Array (CArrays.make ~varAttr ~typAttr len (zero_init_value ai)) - (* | t when is_thread_type t -> `Thread (ConcDomain.ThreadSet.empty ()) *) + Array (CArrays.make ~varAttr ~typAttr len (zero_init_value ai)) + (* | t when is_thread_type t -> Thread (ConcDomain.ThreadSet.empty ()) *) | TNamed ({ttype=t; _}, _) -> zero_init_value ~varAttr t - | _ -> `Top + | _ -> Top let tag_name : t -> string = function - | `Top -> "Top" | `Int _ -> "Int" | `Float _ -> "Float" | `Address _ -> "Address" | `Struct _ -> "Struct" | `Union _ -> "Union" | `Array _ -> "Array" | `Blob _ -> "Blob" | `Thread _ -> "Thread" | `Mutex -> "Mutex" | `MutexAttr _ -> "MutexAttr" | `JmpBuf _ -> "JmpBuf" | `Bot -> "Bot" + | Top -> "Top" | Int _ -> "Int" | Float _ -> "Float" | Address _ -> "Address" | Struct _ -> "Struct" | Union _ -> "Union" | Array _ -> "Array" | Blob _ -> "Blob" | Thread _ -> "Thread" | Mutex -> "Mutex" | MutexAttr _ -> "MutexAttr" | JmpBuf _ -> "JmpBuf" | Bot -> "Bot" include Printable.Std let name () = "compound" @@ -255,56 +257,56 @@ struct type offs = (fieldinfo,IndexDomain.t) Lval.offs - let bot () = `Bot - let is_bot x = x = `Bot + let bot () = Bot + let is_bot x = x = Bot let bot_name = "Uninitialized" - let top () = `Top - let is_top x = x = `Top + let top () = Top + let is_top x = x = Top let top_name = "Unknown" let pretty () state = match state with - | `Int n -> ID.pretty () n - | `Float n -> FD.pretty () n - | `Address n -> AD.pretty () n - | `Struct n -> Structs.pretty () n - | `Union n -> Unions.pretty () n - | `Array n -> CArrays.pretty () n - | `Blob n -> Blobs.pretty () n - | `Thread n -> Threads.pretty () n - | `MutexAttr n -> MutexAttr.pretty () n - | `JmpBuf n -> JmpBufs.pretty () n - | `Mutex -> text "mutex" - | `Bot -> text bot_name - | `Top -> text top_name + | Int n -> ID.pretty () n + | Float n -> FD.pretty () n + | Address n -> AD.pretty () n + | Struct n -> Structs.pretty () n + | Union n -> Unions.pretty () n + | Array n -> CArrays.pretty () n + | Blob n -> Blobs.pretty () n + | Thread n -> Threads.pretty () n + | MutexAttr n -> MutexAttr.pretty () n + | JmpBuf n -> JmpBufs.pretty () n + | Mutex -> text "mutex" + | Bot -> text bot_name + | Top -> text top_name let show state = match state with - | `Int n -> ID.show n - | `Float n -> FD.show n - | `Address n -> AD.show n - | `Struct n -> Structs.show n - | `Union n -> Unions.show n - | `Array n -> CArrays.show n - | `Blob n -> Blobs.show n - | `Thread n -> Threads.show n - | `JmpBuf n -> JmpBufs.show n - | `Mutex -> "mutex" - | `MutexAttr x -> MutexAttr.show x - | `Bot -> bot_name - | `Top -> top_name + | Int n -> ID.show n + | Float n -> FD.show n + | Address n -> AD.show n + | Struct n -> Structs.show n + | Union n -> Unions.show n + | Array n -> CArrays.show n + | Blob n -> Blobs.show n + | Thread n -> Threads.show n + | JmpBuf n -> JmpBufs.show n + | Mutex -> "mutex" + | MutexAttr x -> MutexAttr.show x + | Bot -> bot_name + | Top -> top_name let pretty_diff () (x,y) = match (x,y) with - | (`Int x, `Int y) -> ID.pretty_diff () (x,y) - | (`Float x, `Float y) -> FD.pretty_diff () (x,y) - | (`Address x, `Address y) -> AD.pretty_diff () (x,y) - | (`Struct x, `Struct y) -> Structs.pretty_diff () (x,y) - | (`Union x, `Union y) -> Unions.pretty_diff () (x,y) - | (`Array x, `Array y) -> CArrays.pretty_diff () (x,y) - | (`Blob x, `Blob y) -> Blobs.pretty_diff () (x,y) - | (`Thread x, `Thread y) -> Threads.pretty_diff () (x, y) - | (`JmpBuf x, `JmpBuf y) -> JmpBufs.pretty_diff () (x, y) + | (Int x, Int y) -> ID.pretty_diff () (x,y) + | (Float x, Float y) -> FD.pretty_diff () (x,y) + | (Address x, Address y) -> AD.pretty_diff () (x,y) + | (Struct x, Struct y) -> Structs.pretty_diff () (x,y) + | (Union x, Union y) -> Unions.pretty_diff () (x,y) + | (Array x, Array y) -> CArrays.pretty_diff () (x,y) + | (Blob x, Blob y) -> Blobs.pretty_diff () (x,y) + | (Thread x, Thread y) -> Threads.pretty_diff () (x, y) + | (JmpBuf x, JmpBuf y) -> JmpBufs.pretty_diff () (x, y) | _ -> dprintf "%s: %a not same type as %a" (name ()) pretty x pretty y (************************************************************ @@ -408,60 +410,60 @@ struct * 2. dereferencing pointers (needed?) *) let cast ?torg t v = - (*if v = `Bot || (match torg with Some x -> is_safe_cast t x | None -> false) then v else*) + (*if v = Bot || (match torg with Some x -> is_safe_cast t x | None -> false) then v else*) match v with - | `Bot - | `Thread _ - | `Mutex - | `MutexAttr _ - | `JmpBuf _ -> + | Bot + | Thread _ + | Mutex + | MutexAttr _ + | JmpBuf _ -> v | _ -> let log_top (_,l,_,_) = Messages.tracel "cast" "log_top at %d: %a to %a is top!\n" l pretty v d_type t in let t = unrollType t in let v' = match t with | TInt (ik,_) -> - `Int (ID.cast_to ?torg ik (match v with - | `Int x -> x - | `Address x -> AD.to_int (module ID) x - | `Float x -> FD.to_int ik x - (*| `Struct x when Structs.cardinal x > 0 -> + Int (ID.cast_to ?torg ik (match v with + | Int x -> x + | Address x -> AD.to_int (module ID) x + | Float x -> FD.to_int ik x + (*| Struct x when Structs.cardinal x > 0 -> let some = List.hd (Structs.keys x) in let first = List.hd some.fcomp.cfields in - (match Structs.get x first with `Int x -> x | _ -> raise CastError)*) + (match Structs.get x first with Int x -> x | _ -> raise CastError)*) | _ -> log_top __POS__; ID.top_of ik )) | TFloat (fkind,_) when not (Cilfacade.isComplexFKind fkind) -> (match v with - |`Int ix -> `Float (FD.of_int fkind ix) - |`Float fx -> `Float (FD.cast_to fkind fx) - | _ -> log_top __POS__; `Top) - | TFloat _ -> log_top __POS__; `Top (*ignore complex numbers by going to top*) + |Int ix -> Float (FD.of_int fkind ix) + |Float fx -> Float (FD.cast_to fkind fx) + | _ -> log_top __POS__; Top) + | TFloat _ -> log_top __POS__; Top (*ignore complex numbers by going to top*) | TEnum ({ekind=ik; _},_) -> - `Int (ID.cast_to ?torg ik (match v with - | `Int x -> (* TODO warn if x is not in the constant values of ei.eitems? (which is totally valid (only ik is relevant for wrapping), but might be unintended) *) x + Int (ID.cast_to ?torg ik (match v with + | Int x -> (* TODO warn if x is not in the constant values of ei.eitems? (which is totally valid (only ik is relevant for wrapping), but might be unintended) *) x | _ -> log_top __POS__; ID.top_of ik )) | TPtr (t,_) when isVoidType t || isVoidPtrType t -> (match v with - | `Address a -> v - | `Int i -> `Int(ID.cast_to ?torg (Cilfacade.ptr_ikind ()) i) - | _ -> v (* TODO: Does it make sense to have things here that are neither `Address nor `Int? *) + | Address a -> v + | Int i -> Int(ID.cast_to ?torg (Cilfacade.ptr_ikind ()) i) + | _ -> v (* TODO: Does it make sense to have things here that are neither Address nor Int? *) ) (* cast to voidPtr are ignored TODO what happens if our value does not fit? *) | TPtr (t,_) -> - `Address (match v with - | `Int x when ID.to_int x = Some BI.zero -> AD.null_ptr - | `Int x -> AD.top_ptr + Address (match v with + | Int x when ID.to_int x = Some BI.zero -> AD.null_ptr + | Int x -> AD.top_ptr (* we ignore casts to void*! TODO report UB! *) - | `Address x -> (match t with TVoid _ -> x | _ -> cast_addr t x) - (*| `Address x -> x*) + | Address x -> (match t with TVoid _ -> x | _ -> cast_addr t x) + (*| Address x -> x*) | _ -> log_top __POS__; AD.top_ptr ) | TArray (ta, l, _) -> (* TODO, why is the length exp option? *) (* TODO handle casts between different sizes? *) - `Array (match v with - | `Array x -> x + Array (match v with + | Array x -> x | _ -> log_top __POS__; CArrays.top () ) | TComp (ci,_) -> (* struct/union *) @@ -475,23 +477,23 @@ struct * 2. dereferencing a casted pointer works, but is undefined behavior because of the strict aliasing rule (compiler assumes that pointers of different type can never point to the same location) *) if ci.cstruct then - `Struct (match v with - | `Struct x when same_struct x -> x - | `Struct x when ci.cfields <> [] -> + Struct (match v with + | Struct x when same_struct x -> x + | Struct x when ci.cfields <> [] -> let first = List.hd ci.cfields in Structs.(replace (Structs.create (fun fd -> top_value ~varAttr:fd.fattr fd.ftype) ci) first (get x first)) | _ -> log_top __POS__; Structs.create (fun fd -> top_value ~varAttr:fd.fattr fd.ftype) ci ) else - `Union (match v with - | `Union x (* when same (Unions.keys x) *) -> x + Union (match v with + | Union x (* when same (Unions.keys x) *) -> x | _ -> log_top __POS__; Unions.top () ) - (* | _ -> log_top (); `Top *) - | TVoid _ -> log_top __POS__; `Top + (* | _ -> log_top (); Top *) + | TVoid _ -> log_top __POS__; Top | TBuiltin_va_list _ -> (* cast to __builtin_va_list only happens in preprocessed SV-COMP files where vararg declarations are more explicit *) - log_top __POS__; `Top + log_top __POS__; Top | _ -> log_top __POS__; assert false in let s_torg = match torg with Some t -> CilType.Typ.show t | None -> "?" in @@ -504,184 +506,184 @@ struct let rec leq x y = match (x,y) with - | (_, `Top) -> true - | (`Top, _) -> false - | (`Bot, _) -> true - | (_, `Bot) -> false - | (`Int x, `Int y) -> ID.leq x y - | (`Float x, `Float y) -> FD.leq x y - | (`Int x, `Address y) when ID.to_int x = Some BI.zero && not (AD.is_not_null y) -> true - | (`Int _, `Address y) when AD.may_be_unknown y -> true - | (`Address _, `Int y) when ID.is_top_of (Cilfacade.ptrdiff_ikind ()) y -> true - | (`Address x, `Address y) -> AD.leq x y - | (`Struct x, `Struct y) -> Structs.leq x y - | (`Union x, `Union y) -> Unions.leq x y - | (`Array x, `Array y) -> CArrays.leq x y - | (`Blob x, `Blob y) -> Blobs.leq x y - | `Blob (x,s,o), y -> leq (x:t) y - | x, `Blob (y,s,o) -> leq x (y:t) - | (`Thread x, `Thread y) -> Threads.leq x y - | (`Int x, `Thread y) -> true - | (`Address x, `Thread y) -> true - | (`JmpBuf x, `JmpBuf y) -> JmpBufs.leq x y - | (`Mutex, `Mutex) -> true - | (`MutexAttr x, `MutexAttr y) -> MutexAttr.leq x y + | (_, Top) -> true + | (Top, _) -> false + | (Bot, _) -> true + | (_, Bot) -> false + | (Int x, Int y) -> ID.leq x y + | (Float x, Float y) -> FD.leq x y + | (Int x, Address y) when ID.to_int x = Some BI.zero && not (AD.is_not_null y) -> true + | (Int _, Address y) when AD.may_be_unknown y -> true + | (Address _, Int y) when ID.is_top_of (Cilfacade.ptrdiff_ikind ()) y -> true + | (Address x, Address y) -> AD.leq x y + | (Struct x, Struct y) -> Structs.leq x y + | (Union x, Union y) -> Unions.leq x y + | (Array x, Array y) -> CArrays.leq x y + | (Blob x, Blob y) -> Blobs.leq x y + | Blob (x,s,o), y -> leq (x:t) y + | x, Blob (y,s,o) -> leq x (y:t) + | (Thread x, Thread y) -> Threads.leq x y + | (Int x, Thread y) -> true + | (Address x, Thread y) -> true + | (JmpBuf x, JmpBuf y) -> JmpBufs.leq x y + | (Mutex, Mutex) -> true + | (MutexAttr x, MutexAttr y) -> MutexAttr.leq x y | _ -> warn_type "leq" x y; false let rec join x y = match (x,y) with - | (`Top, _) -> `Top - | (_, `Top) -> `Top - | (`Bot, x) -> x - | (x, `Bot) -> x - | (`Int x, `Int y) -> (try `Int (ID.join x y) with IntDomain.IncompatibleIKinds m -> Messages.warn ~category:Analyzer ~tags:[Category Imprecise] "%s" m; `Top) - | (`Float x, `Float y) -> `Float (FD.join x y) - | (`Int x, `Address y) - | (`Address y, `Int x) -> `Address (match ID.to_int x with + | (Top, _) -> Top + | (_, Top) -> Top + | (Bot, x) -> x + | (x, Bot) -> x + | (Int x, Int y) -> (try Int (ID.join x y) with IntDomain.IncompatibleIKinds m -> Messages.warn ~category:Analyzer ~tags:[Category Imprecise] "%s" m; Top) + | (Float x, Float y) -> Float (FD.join x y) + | (Int x, Address y) + | (Address y, Int x) -> Address (match ID.to_int x with | Some x when BI.equal x BI.zero -> AD.join AD.null_ptr y | Some x -> AD.(join y not_null) | None -> AD.join y AD.top_ptr) - | (`Address x, `Address y) -> `Address (AD.join x y) - | (`Struct x, `Struct y) -> `Struct (Structs.join x y) - | (`Union (f,x), `Union (g,y)) -> `Union (match UnionDomain.Field.join f g with + | (Address x, Address y) -> Address (AD.join x y) + | (Struct x, Struct y) -> Struct (Structs.join x y) + | (Union (f,x), Union (g,y)) -> Union (match UnionDomain.Field.join f g with | `Lifted f -> (`Lifted f, join x y) (* f = g *) - | x -> (x, `Top)) (* f <> g *) - | (`Array x, `Array y) -> `Array (CArrays.join x y) - | (`Blob x, `Blob y) -> `Blob (Blobs.join x y) - | `Blob (x,s,o), y - | y, `Blob (x,s,o) -> `Blob (join (x:t) y, s, o) - | (`Thread x, `Thread y) -> `Thread (Threads.join x y) - | (`Int x, `Thread y) - | (`Thread y, `Int x) -> - `Thread y (* TODO: ignores int! *) - | (`Address x, `Thread y) - | (`Thread y, `Address x) -> - `Thread y (* TODO: ignores address! *) - | (`JmpBuf x, `JmpBuf y) -> `JmpBuf (JmpBufs.join x y) - | (`Mutex, `Mutex) -> `Mutex - | (`MutexAttr x, `MutexAttr y) -> `MutexAttr (MutexAttr.join x y) + | x -> (x, Top)) (* f <> g *) + | (Array x, Array y) -> Array (CArrays.join x y) + | (Blob x, Blob y) -> Blob (Blobs.join x y) + | Blob (x,s,o), y + | y, Blob (x,s,o) -> Blob (join (x:t) y, s, o) + | (Thread x, Thread y) -> Thread (Threads.join x y) + | (Int x, Thread y) + | (Thread y, Int x) -> + Thread y (* TODO: ignores int! *) + | (Address x, Thread y) + | (Thread y, Address x) -> + Thread y (* TODO: ignores address! *) + | (JmpBuf x, JmpBuf y) -> JmpBuf (JmpBufs.join x y) + | (Mutex, Mutex) -> Mutex + | (MutexAttr x, MutexAttr y) -> MutexAttr (MutexAttr.join x y) | _ -> warn_type "join" x y; - `Top + Top let rec widen x y = match (x,y) with - | (`Top, _) -> `Top - | (_, `Top) -> `Top - | (`Bot, x) -> x - | (x, `Bot) -> x - | (`Int x, `Int y) -> (try `Int (ID.widen x y) with IntDomain.IncompatibleIKinds m -> Messages.warn ~category:Analyzer "%s" m; `Top) - | (`Float x, `Float y) -> `Float (FD.widen x y) + | (Top, _) -> Top + | (_, Top) -> Top + | (Bot, x) -> x + | (x, Bot) -> x + | (Int x, Int y) -> (try Int (ID.widen x y) with IntDomain.IncompatibleIKinds m -> Messages.warn ~category:Analyzer "%s" m; Top) + | (Float x, Float y) -> Float (FD.widen x y) (* TODO: symmetric widen, wtf? *) - | (`Int x, `Address y) - | (`Address y, `Int x) -> `Address (match ID.to_int x with + | (Int x, Address y) + | (Address y, Int x) -> Address (match ID.to_int x with | Some x when BI.equal x BI.zero -> AD.widen AD.null_ptr (AD.join AD.null_ptr y) | Some x -> AD.(widen y (join y not_null)) | None -> AD.widen y (AD.join y AD.top_ptr)) - | (`Address x, `Address y) -> `Address (AD.widen x y) - | (`Struct x, `Struct y) -> `Struct (Structs.widen x y) - | (`Union (f,x), `Union (g,y)) -> `Union (match UnionDomain.Field.widen f g with + | (Address x, Address y) -> Address (AD.widen x y) + | (Struct x, Struct y) -> Struct (Structs.widen x y) + | (Union (f,x), Union (g,y)) -> Union (match UnionDomain.Field.widen f g with | `Lifted f -> (`Lifted f, widen x y) (* f = g *) - | x -> (x, `Top)) - | (`Array x, `Array y) -> `Array (CArrays.widen x y) - | (`Blob x, `Blob y) -> `Blob (Blobs.widen x y) - | (`Thread x, `Thread y) -> `Thread (Threads.widen x y) - | (`Int x, `Thread y) - | (`Thread y, `Int x) -> - `Thread y (* TODO: ignores int! *) - | (`Address x, `Thread y) - | (`Thread y, `Address x) -> - `Thread y (* TODO: ignores address! *) - | (`Mutex, `Mutex) -> `Mutex - | (`JmpBuf x, `JmpBuf y) -> `JmpBuf (JmpBufs.widen x y) - | (`MutexAttr x, `MutexAttr y) -> `MutexAttr (MutexAttr.widen x y) + | x -> (x, Top)) + | (Array x, Array y) -> Array (CArrays.widen x y) + | (Blob x, Blob y) -> Blob (Blobs.widen x y) + | (Thread x, Thread y) -> Thread (Threads.widen x y) + | (Int x, Thread y) + | (Thread y, Int x) -> + Thread y (* TODO: ignores int! *) + | (Address x, Thread y) + | (Thread y, Address x) -> + Thread y (* TODO: ignores address! *) + | (Mutex, Mutex) -> Mutex + | (JmpBuf x, JmpBuf y) -> JmpBuf (JmpBufs.widen x y) + | (MutexAttr x, MutexAttr y) -> MutexAttr (MutexAttr.widen x y) | _ -> warn_type "widen" x y; - `Top + Top let rec smart_join x_eval_int y_eval_int (x:t) (y:t):t = let join_elem: (t -> t -> t) = smart_join x_eval_int y_eval_int in (* does not compile without type annotation *) match (x,y) with - | (`Struct x, `Struct y) -> `Struct (Structs.join_with_fct join_elem x y) - | (`Union (f,x), `Union (g,y)) -> `Union (match UnionDomain.Field.join f g with + | (Struct x, Struct y) -> Struct (Structs.join_with_fct join_elem x y) + | (Union (f,x), Union (g,y)) -> Union (match UnionDomain.Field.join f g with | `Lifted f -> (`Lifted f, join_elem x y) (* f = g *) - | x -> (x, `Top)) (* f <> g *) - | (`Array x, `Array y) -> `Array (CArrays.smart_join x_eval_int y_eval_int x y) + | x -> (x, Top)) (* f <> g *) + | (Array x, Array y) -> Array (CArrays.smart_join x_eval_int y_eval_int x y) | _ -> join x y (* Others can not contain array -> normal join *) let rec smart_widen x_eval_int y_eval_int x y:t = let widen_elem: (t -> t -> t) = smart_widen x_eval_int y_eval_int in (* does not compile without type annotation *) match (x,y) with - | (`Struct x, `Struct y) -> `Struct (Structs.widen_with_fct widen_elem x y) - | (`Union (f,x), `Union (g,y)) -> `Union (match UnionDomain.Field.widen f g with + | (Struct x, Struct y) -> Struct (Structs.widen_with_fct widen_elem x y) + | (Union (f,x), Union (g,y)) -> Union (match UnionDomain.Field.widen f g with | `Lifted f -> `Lifted f, widen_elem x y (* f = g *) - | x -> x, `Top) (* f <> g *) - | (`Array x, `Array y) -> `Array (CArrays.smart_widen x_eval_int y_eval_int x y) + | x -> x, Top) (* f <> g *) + | (Array x, Array y) -> Array (CArrays.smart_widen x_eval_int y_eval_int x y) | _ -> widen x y (* Others can not contain array -> normal widen *) let rec smart_leq x_eval_int y_eval_int x y = let leq_elem:(t ->t -> bool) = smart_leq x_eval_int y_eval_int in (* does not compile without type annotation *) match (x,y) with - | (`Struct x, `Struct y) -> + | (Struct x, Struct y) -> Structs.leq_with_fct leq_elem x y - | (`Union (f, x), `Union (g, y)) -> + | (Union (f, x), Union (g, y)) -> UnionDomain.Field.leq f g && leq_elem x y - | (`Array x, `Array y) -> CArrays.smart_leq x_eval_int y_eval_int x y + | (Array x, Array y) -> CArrays.smart_leq x_eval_int y_eval_int x y | _ -> leq x y (* Others can not contain array -> normal leq *) let rec meet x y = match (x,y) with - | (`Bot, _) -> `Bot - | (_, `Bot) -> `Bot - | (`Top, x) -> x - | (x, `Top) -> x - | (`Int x, `Int y) -> `Int (ID.meet x y) - | (`Float x, `Float y) -> `Float (FD.meet x y) - | (`Int _, `Address _) -> meet x (cast (TInt(Cilfacade.ptr_ikind (),[])) y) - | (`Address x, `Int y) -> `Address (AD.meet x (AD.of_int (module ID:IntDomain.Z with type t = ID.t) y)) - | (`Address x, `Address y) -> `Address (AD.meet x y) - | (`Struct x, `Struct y) -> `Struct (Structs.meet x y) - | (`Union x, `Union y) -> `Union (Unions.meet x y) - | (`Array x, `Array y) -> `Array (CArrays.meet x y) - | (`Blob x, `Blob y) -> `Blob (Blobs.meet x y) - | (`Thread x, `Thread y) -> `Thread (Threads.meet x y) - | (`Int x, `Thread y) - | (`Thread y, `Int x) -> - `Int x (* TODO: ignores thread! *) - | (`Address x, `Thread y) - | (`Thread y, `Address x) -> - `Address x (* TODO: ignores thread! *) - | (`Mutex, `Mutex) -> `Mutex - | (`JmpBuf x, `JmpBuf y) -> `JmpBuf (JmpBufs.meet x y) - | (`MutexAttr x, `MutexAttr y) -> `MutexAttr (MutexAttr.meet x y) + | (Bot, _) -> Bot + | (_, Bot) -> Bot + | (Top, x) -> x + | (x, Top) -> x + | (Int x, Int y) -> Int (ID.meet x y) + | (Float x, Float y) -> Float (FD.meet x y) + | (Int _, Address _) -> meet x (cast (TInt(Cilfacade.ptr_ikind (),[])) y) + | (Address x, Int y) -> Address (AD.meet x (AD.of_int (module ID:IntDomain.Z with type t = ID.t) y)) + | (Address x, Address y) -> Address (AD.meet x y) + | (Struct x, Struct y) -> Struct (Structs.meet x y) + | (Union x, Union y) -> Union (Unions.meet x y) + | (Array x, Array y) -> Array (CArrays.meet x y) + | (Blob x, Blob y) -> Blob (Blobs.meet x y) + | (Thread x, Thread y) -> Thread (Threads.meet x y) + | (Int x, Thread y) + | (Thread y, Int x) -> + Int x (* TODO: ignores thread! *) + | (Address x, Thread y) + | (Thread y, Address x) -> + Address x (* TODO: ignores thread! *) + | (Mutex, Mutex) -> Mutex + | (JmpBuf x, JmpBuf y) -> JmpBuf (JmpBufs.meet x y) + | (MutexAttr x, MutexAttr y) -> MutexAttr (MutexAttr.meet x y) | _ -> warn_type "meet" x y; - `Bot + Bot let rec narrow x y = match (x,y) with - | (`Int x, `Int y) -> `Int (ID.narrow x y) - | (`Float x, `Float y) -> `Float (FD.narrow x y) - | (`Int _, `Address _) -> narrow x (cast IntDomain.Size.top_typ y) - | (`Address x, `Int y) -> `Address (AD.narrow x (AD.of_int (module ID:IntDomain.Z with type t = ID.t) y)) - | (`Address x, `Address y) -> `Address (AD.narrow x y) - | (`Struct x, `Struct y) -> `Struct (Structs.narrow x y) - | (`Union x, `Union y) -> `Union (Unions.narrow x y) - | (`Array x, `Array y) -> `Array (CArrays.narrow x y) - | (`Blob x, `Blob y) -> `Blob (Blobs.narrow x y) - | (`Thread x, `Thread y) -> `Thread (Threads.narrow x y) - | (`JmpBuf x, `JmpBuf y) -> `JmpBuf (JmpBufs.narrow x y) - | (`Int x, `Thread y) - | (`Thread y, `Int x) -> - `Int x (* TODO: ignores thread! *) - | (`Address x, `Thread y) - | (`Thread y, `Address x) -> - `Address x (* TODO: ignores thread! *) - | (`Mutex, `Mutex) -> `Mutex - | (`MutexAttr x, `MutexAttr y) -> `MutexAttr (MutexAttr.narrow x y) - | x, `Top | `Top, x -> x - | x, `Bot | `Bot, x -> `Bot + | (Int x, Int y) -> Int (ID.narrow x y) + | (Float x, Float y) -> Float (FD.narrow x y) + | (Int _, Address _) -> narrow x (cast IntDomain.Size.top_typ y) + | (Address x, Int y) -> Address (AD.narrow x (AD.of_int (module ID:IntDomain.Z with type t = ID.t) y)) + | (Address x, Address y) -> Address (AD.narrow x y) + | (Struct x, Struct y) -> Struct (Structs.narrow x y) + | (Union x, Union y) -> Union (Unions.narrow x y) + | (Array x, Array y) -> Array (CArrays.narrow x y) + | (Blob x, Blob y) -> Blob (Blobs.narrow x y) + | (Thread x, Thread y) -> Thread (Threads.narrow x y) + | (JmpBuf x, JmpBuf y) -> JmpBuf (JmpBufs.narrow x y) + | (Int x, Thread y) + | (Thread y, Int x) -> + Int x (* TODO: ignores thread! *) + | (Address x, Thread y) + | (Thread y, Address x) -> + Address x (* TODO: ignores thread! *) + | (Mutex, Mutex) -> Mutex + | (MutexAttr x, MutexAttr y) -> MutexAttr (MutexAttr.narrow x y) + | x, Top | Top, x -> x + | x, Bot | Bot, x -> Bot | _ -> warn_type "narrow" x y; x @@ -697,20 +699,20 @@ struct in let array_idx_top = (None, ArrIdxDomain.top ()) in match typ, state with - | _ , `Address n -> `Address (AD.join AD.top_ptr n) - | TComp (ci,_) , `Struct n -> `Struct (invalid_struct ci n) - | _ , `Struct n -> `Struct (Structs.map (fun x -> invalidate_value ask voidType x) n) - | TComp (ci,_) , `Union (`Lifted fd,n) -> `Union (`Lifted fd, invalidate_value ask fd.ftype n) - | TArray (t,_,_), `Array n -> + | _ , Address n -> Address (AD.join AD.top_ptr n) + | TComp (ci,_) , Struct n -> Struct (invalid_struct ci n) + | _ , Struct n -> Struct (Structs.map (fun x -> invalidate_value ask voidType x) n) + | TComp (ci,_) , Union (`Lifted fd,n) -> Union (`Lifted fd, invalidate_value ask fd.ftype n) + | TArray (t,_,_), Array n -> let v = invalidate_value ask t (CArrays.get ask n array_idx_top) in - `Array (CArrays.set ask n (array_idx_top) v) - | _ , `Array n -> + Array (CArrays.set ask n (array_idx_top) v) + | _ , Array n -> let v = invalidate_value ask voidType (CArrays.get ask n (array_idx_top)) in - `Array (CArrays.set ask n (array_idx_top) v) - | t , `Blob n -> `Blob (Blobs.invalidate_value ask t n) - | _ , `Thread _ -> state (* TODO: no top thread ID set! *) - | _ , `JmpBuf _ -> state (* TODO: no top jmpbuf *) - | _, `Bot -> `Bot (* Leave uninitialized value (from malloc) alone in free to avoid trashing everything. TODO: sound? *) + Array (CArrays.set ask n (array_idx_top) v) + | t , Blob n -> Blob (Blobs.invalidate_value ask t n) + | _ , Thread _ -> state (* TODO: no top thread ID set! *) + | _ , JmpBuf _ -> state (* TODO: no top jmpbuf *) + | _, Bot -> Bot (* Leave uninitialized value (from malloc) alone in free to avoid trashing everything. TODO: sound? *) | t , _ -> top_value t @@ -815,7 +817,7 @@ struct if orig then (* This Blob came from malloc *) x - else if x = `Bot then + else if x = Bot then (* This Blob came from calloc *) zero_init_value t (* This should be zero initialized *) else @@ -825,65 +827,65 @@ struct let rec eval_offset (ask: VDQ.t) f (x: t) (offs:offs) (exp:exp option) (v:lval option) (t:typ): t = let rec do_eval_offset (ask:VDQ.t) f (x:t) (offs:offs) (exp:exp option) (l:lval option) (o:offset option) (v:lval option) (t:typ): t = match x, offs with - | `Blob((va, _, orig) as c), `Index (_, ox) -> + | Blob((va, _, orig) 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 end - | `Blob((va, _, orig) as c), `Field _ -> + | Blob((va, _, orig) 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 end - | `Blob((va, _, orig) as c), `NoOffset -> + | Blob((va, _, orig) 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 end - | `Bot, _ -> `Bot + | Bot, _ -> Bot | _ -> match offs with | `NoOffset -> x | `Field (fld, offs) when fld.fcomp.cstruct -> begin match x with - | `Struct str -> + | Struct str -> let x = Structs.get str fld in let l', o' = shift_one_over l o in do_eval_offset ask f x offs exp l' o' v t - | `Top -> M.info ~category:Imprecise "Trying to read a field, but the struct is unknown"; top () + | Top -> M.info ~category:Imprecise "Trying to read a field, but the struct is unknown"; top () | _ -> M.warn ~category:Imprecise ~tags:[Category Program] "Trying to read a field, but was not given a struct"; top () end | `Field (fld, offs) -> begin match x with - | `Union (`Lifted l_fld, value) -> + | Union (`Lifted l_fld, value) -> (match value, fld.ftype with (* only return an actual value if we have a type and return actually the exact same type *) - | `Float f_value, TFloat(fkind, _) when FD.get_fkind f_value = fkind -> `Float f_value - | `Float _, t -> top_value t - | _, TFloat(fkind, _) when not (Cilfacade.isComplexFKind fkind)-> `Float (FD.top_of fkind) + | Float f_value, TFloat(fkind, _) when FD.get_fkind f_value = fkind -> Float f_value + | Float _, t -> top_value t + | _, TFloat(fkind, _) when not (Cilfacade.isComplexFKind fkind)-> Float (FD.top_of fkind) | _ -> let x = cast ~torg:l_fld.ftype fld.ftype value in let l', o' = shift_one_over l o in do_eval_offset ask f x offs exp l' o' v t) - | `Union _ -> top () - | `Top -> M.info ~category:Imprecise "Trying to read a field, but the union is unknown"; top () + | Union _ -> top () + | Top -> M.info ~category:Imprecise "Trying to read a field, but the union is unknown"; top () | _ -> M.warn ~category:Imprecise ~tags:[Category Program] "Trying to read a field, but was not given a union"; top () end | `Index (idx, offs) -> begin let l', o' = shift_one_over l o in match x with - | `Array x -> + | Array x -> let e = determine_offset ask l o exp v in do_eval_offset ask f (CArrays.get ask x (e, idx)) offs exp l' o' v t - | `Address _ -> + | Address _ -> begin do_eval_offset ask f x offs exp l' o' v t (* this used to be `blob `address -> we ignore the index *) end | x when GobOption.exists (BI.equal (BI.zero)) (IndexDomain.to_int idx) -> eval_offset ask f x offs exp v t - | `Top -> M.info ~category:Imprecise "Trying to read an index, but the array is unknown"; top () + | Top -> M.info ~category:Imprecise "Trying to read an index, but the array is unknown"; top () | _ -> M.warn ~category:Imprecise ~tags:[Category Program] "Trying to read an index, but was not given an array (%a)" pretty x; top () end in @@ -896,20 +898,20 @@ struct let update_offset (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\n" 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', orig), s, orig2) -> Blob (y, ID.join s s',orig) | x -> x in let r = match x, offs with - | `Mutex, _ -> (* hide mutex structure contents, not updated anyway *) - `Mutex - | `Blob (x,s,orig), `Index (_,ofs) -> + | Mutex, _ -> (* hide mutex structure contents, not updated anyway *) + Mutex + | Blob (x,s,orig), `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)) + mu (Blob (join x (do_update_offset ask x ofs value exp l' o' v t), s, orig)) end - | `Blob (x,s,orig), `Field(f, _) -> + | Blob (x,s,orig), `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 *) + (* 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 @@ -927,11 +929,11 @@ 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, orig) 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, orig)) end - | `Blob (x,s,orig), _ -> + | Blob (x,s,orig), _ -> begin let l', o' = shift_one_over l o in let x = zero_init_calloced_memory orig x t in @@ -948,66 +950,66 @@ 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, orig) 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, orig)) end - | `Thread _, _ -> + | Thread _, _ -> (* hack for pthread_t variables *) begin match value with - | `Thread t -> value (* if actually assigning thread, use value *) + | Thread t -> value (* if actually assigning thread, use value *) | _ -> if !AnalysisState.global_initialization then - `Thread (ConcDomain.ThreadSet.empty ()) (* if assigning global init (int on linux, ptr to struct on mac), use empty set instead *) + Thread (ConcDomain.ThreadSet.empty ()) (* if assigning global init (int on linux, ptr to struct on mac), use empty set instead *) else - `Top + Top end - | `JmpBuf _, _ -> + | JmpBuf _, _ -> (* hack for jmp_buf variables *) begin match value with - | `JmpBuf t -> value (* if actually assigning jmpbuf, use value *) - | `Blob(`Bot, _, _) -> `Bot (* TODO: Stopgap for malloced jmp_bufs, there is something fundamentally flawed somewhere *) + | JmpBuf t -> value (* if actually assigning jmpbuf, use value *) + | Blob(Bot, _, _) -> Bot (* TODO: Stopgap for malloced jmp_bufs, there is something fundamentally flawed somewhere *) | _ -> if !AnalysisState.global_initialization then - `JmpBuf (JmpBufs.Bufs.empty (), false) (* if assigning global init, use empty set instead *) + JmpBuf (JmpBufs.Bufs.empty (), false) (* if assigning global init, use empty set instead *) else - `Top + Top end | _ -> let result = match offs with | `NoOffset -> begin match value with - | `Blob (y, s, orig) -> mu (`Blob (join x y, s, orig)) - | `Int _ -> cast t value + | Blob (y, s, orig) -> mu (Blob (join x y, s, orig)) + | Int _ -> cast t value | _ -> value end | `Field (fld, offs) when fld.fcomp.cstruct -> begin let t = fld.ftype in match x with - | `Struct str -> + | Struct str -> begin let l', o' = shift_one_over l o in let value' = do_update_offset ask (Structs.get str fld) offs value exp l' o' v t in - `Struct (Structs.replace str fld value') + Struct (Structs.replace str fld value') end - | `Bot -> + | Bot -> let init_comp compinfo = - let nstruct = Structs.create (fun fd -> `Bot) compinfo in - let init_field nstruct fd = Structs.replace nstruct fd `Bot in + let nstruct = Structs.create (fun fd -> Bot) compinfo in + let init_field nstruct fd = Structs.replace nstruct fd Bot in List.fold_left init_field nstruct compinfo.cfields in let strc = init_comp fld.fcomp in let l', o' = shift_one_over l o in - `Struct (Structs.replace strc fld (do_update_offset ask `Bot offs value exp l' o' v t)) - | `Top -> M.warn ~category:Imprecise "Trying to update a field, but the struct is unknown"; top () + Struct (Structs.replace strc fld (do_update_offset ask Bot offs value exp l' o' v t)) + | Top -> M.warn ~category:Imprecise "Trying to update a field, but the struct is unknown"; top () | _ -> M.warn ~category:Imprecise "Trying to update a field, but was not given a struct"; top () end | `Field (fld, offs) -> begin let t = fld.ftype in let l', o' = shift_one_over l o in match x with - | `Union (last_fld, prev_val) -> + | Union (last_fld, prev_val) -> let tempval, tempoffs = if UnionDomain.Field.equal last_fld (`Lifted fld) then prev_val, offs @@ -1015,7 +1017,7 @@ struct match offs with | `Field (fldi, _) when fldi.fcomp.cstruct -> (top_value ~varAttr:fld.fattr fld.ftype), offs - | `Field (fldi, _) -> `Union (Unions.top ()), offs + | `Field (fldi, _) -> Union (Unions.top ()), offs | `NoOffset -> top (), offs | `Index (idx, _) when Cil.isArrayType fld.ftype -> begin @@ -1023,7 +1025,7 @@ struct | TArray(_, l, _) -> let len = try Cil.lenOfArray l with Cil.LenOfArray -> 42 (* will not happen, VLA not allowed in union and struct *) in - `Array(CArrays.make (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ()) (BI.of_int len)) `Top), offs + Array(CArrays.make (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ()) (BI.of_int len)) Top), offs | _ -> top (), offs (* will not happen*) end | `Index (idx, _) when IndexDomain.equal idx (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero) -> @@ -1033,36 +1035,36 @@ struct top (), offs end in - `Union (`Lifted fld, do_update_offset ask tempval tempoffs value exp l' o' v t) - | `Bot -> `Union (`Lifted fld, do_update_offset ask `Bot offs value exp l' o' v t) - | `Top -> M.warn ~category:Imprecise "Trying to update a field, but the union is unknown"; top () + Union (`Lifted fld, do_update_offset ask tempval tempoffs value exp l' o' v t) + | Bot -> Union (`Lifted fld, do_update_offset ask Bot offs value exp l' o' v t) + | Top -> M.warn ~category:Imprecise "Trying to update a field, but the union is unknown"; top () | _ -> M.warn ~category:Imprecise "Trying to update a field, but was not given a union"; top () end | `Index (idx, offs) -> begin let l', o' = shift_one_over l o in match x with - | `Array x' -> + | Array x' -> let t = (match t with | TArray(t1 ,_,_) -> t1 | _ -> t) in (* This is necessary because t is not a TArray in case of calloc *) let e = determine_offset ask l o exp (Some v) in let new_value_at_index = do_update_offset ask (CArrays.get ask x' (e,idx)) offs value exp l' o' v t in let new_array_value = CArrays.set ask x' (e, idx) new_value_at_index in - `Array new_array_value - | `Bot -> + Array new_array_value + | Bot -> let t,len = (match t with | TArray(t1 ,len,_) -> t1, len | _ -> t, None) in (* This is necessary because t is not a TArray in case of calloc *) let x' = CArrays.bot () in let e = determine_offset ask l o exp (Some v) in - let new_value_at_index = do_update_offset ask `Bot offs value exp l' o' v t in + let new_value_at_index = do_update_offset ask Bot offs value exp l' o' v t in let new_array_value = CArrays.set ask x' (e, idx) new_value_at_index in let len_ci = BatOption.bind len (fun e -> Cil.getInteger @@ Cil.constFold true e) in let len_id = BatOption.map (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ())) len_ci in let newl = BatOption.default (ID.starting (Cilfacade.ptrdiff_ikind ()) Z.zero) len_id in let new_array_value = CArrays.update_length newl new_array_value in - `Array new_array_value - | `Top -> M.warn ~category:Imprecise "Trying to update an index, but the array is unknown"; top () + Array new_array_value + | Top -> M.warn ~category:Imprecise "Trying to update an index, but the array is unknown"; top () | x when GobOption.exists (BI.equal BI.zero) (IndexDomain.to_int idx) -> do_update_offset ask x offs value exp l' o' v t | _ -> M.warn ~category:Imprecise "Trying to update an index, but was not given an array(%a)" pretty x; top () end @@ -1080,17 +1082,17 @@ struct let rec affect_move ?(replace_with_const=false) ask (x:t) (v:varinfo) movement_for_expr:t = let move_fun x = affect_move ~replace_with_const:replace_with_const ask x v movement_for_expr in match x with - | `Array a -> + | Array a -> begin (* potentially move things (i.e. other arrays after arbitrarily deep nesting) in array first *) let moved_elems = CArrays.map move_fun a in (* then move the array itself *) let new_val = CArrays.move_if_affected ~replace_with_const:replace_with_const ask moved_elems v movement_for_expr in - `Array (new_val) + Array (new_val) end - | `Struct s -> `Struct (Structs.map (move_fun) s) - | `Union (f, v) -> `Union(f, move_fun v) - (* `Blob can not contain Array *) + | Struct s -> Struct (Structs.map (move_fun) s) + | Union (f, v) -> Union(f, move_fun v) + (* Blob can not contain Array *) | x -> x let rec affecting_vars (x:t) = @@ -1098,22 +1100,22 @@ struct list @ (affecting_vars va) in match x with - | `Array a -> + | Array a -> begin let immediately_affecting = CArrays.get_vars_in_e a in CArrays.fold_left add_affecting_one_level immediately_affecting a end - | `Struct s -> + | Struct s -> Structs.fold (fun x value acc -> add_affecting_one_level acc value) s [] - | `Union (f, v) -> + | Union (f, v) -> affecting_vars v - (* `Blob can not contain Array *) + (* Blob can not contain Array *) | _ -> [] (* Won't compile without the final :t annotation *) let rec update_array_lengths (eval_exp: exp -> t) (v:t) (typ:Cil.typ):t = match v, typ with - | `Array(n), TArray(ti, e, _) -> + | Array(n), TArray(ti, e, _) -> begin let update_fun x = update_array_lengths eval_exp x ti in let n' = CArrays.map (update_fun) n in @@ -1122,73 +1124,73 @@ struct | Some e -> begin match eval_exp e with - | `Int x -> ID.cast_to (Cilfacade.ptrdiff_ikind ()) x + | Int x -> ID.cast_to (Cilfacade.ptrdiff_ikind ()) x | _ -> M.debug ~category:Analyzer "Expression for size of VLA did not evaluate to Int at declaration"; ID.starting (Cilfacade.ptrdiff_ikind ()) Z.zero end in - `Array(CArrays.update_length newl n') + Array(CArrays.update_length newl n') end | _ -> v let rec mark_jmpbufs_as_copied (v:t):t = match v with - | `JmpBuf (v,t) -> `JmpBuf (v, true) - | `Array n -> `Array (CArrays.map (fun (x: t) -> mark_jmpbufs_as_copied x) n) - | `Struct n -> `Struct (Structs.map (fun (x: t) -> mark_jmpbufs_as_copied x) n) - | `Union (f, n) -> `Union (f, mark_jmpbufs_as_copied n) - | `Blob (a,b,c) -> `Blob (mark_jmpbufs_as_copied a, b,c) + | JmpBuf (v,t) -> JmpBuf (v, true) + | Array n -> Array (CArrays.map (fun (x: t) -> mark_jmpbufs_as_copied x) n) + | Struct n -> Struct (Structs.map (fun (x: t) -> mark_jmpbufs_as_copied x) n) + | Union (f, n) -> Union (f, mark_jmpbufs_as_copied n) + | Blob (a,b,c) -> Blob (mark_jmpbufs_as_copied a, b,c) | _ -> v let printXml f state = match state with - | `Int n -> ID.printXml f n - | `Float n -> FD.printXml f n - | `Address n -> AD.printXml f n - | `Struct n -> Structs.printXml f n - | `Union n -> Unions.printXml f n - | `Array n -> CArrays.printXml f n - | `Blob n -> Blobs.printXml f n - | `Thread n -> Threads.printXml f n - | `MutexAttr n -> MutexAttr.printXml f n - | `JmpBuf n -> JmpBufs.printXml f n - | `Mutex -> BatPrintf.fprintf f "\n\nmutex\n\n\n" - | `Bot -> BatPrintf.fprintf f "\n\nbottom\n\n\n" - | `Top -> BatPrintf.fprintf f "\n\ntop\n\n\n" + | Int n -> ID.printXml f n + | Float n -> FD.printXml f n + | Address n -> AD.printXml f n + | Struct n -> Structs.printXml f n + | Union n -> Unions.printXml f n + | Array n -> CArrays.printXml f n + | Blob n -> Blobs.printXml f n + | Thread n -> Threads.printXml f n + | MutexAttr n -> MutexAttr.printXml f n + | JmpBuf n -> JmpBufs.printXml f n + | Mutex -> BatPrintf.fprintf f "\n\nmutex\n\n\n" + | Bot -> BatPrintf.fprintf f "\n\nbottom\n\n\n" + | Top -> BatPrintf.fprintf f "\n\ntop\n\n\n" let to_yojson = function - | `Int n -> ID.to_yojson n - | `Float n -> FD.to_yojson n - | `Address n -> AD.to_yojson n - | `Struct n -> Structs.to_yojson n - | `Union n -> Unions.to_yojson n - | `Array n -> CArrays.to_yojson n - | `Blob n -> Blobs.to_yojson n - | `Thread n -> Threads.to_yojson n - | `MutexAttr n -> MutexAttr.to_yojson n - | `JmpBuf n -> JmpBufs.to_yojson n - | `Mutex -> `String "mutex" - | `Bot -> `String "⊥" - | `Top -> `String "⊤" - - let arbitrary () = QCheck.always `Bot (* S TODO: other elements *) + | Int n -> ID.to_yojson n + | Float n -> FD.to_yojson n + | Address n -> AD.to_yojson n + | Struct n -> Structs.to_yojson n + | Union n -> Unions.to_yojson n + | Array n -> CArrays.to_yojson n + | Blob n -> Blobs.to_yojson n + | Thread n -> Threads.to_yojson n + | MutexAttr n -> MutexAttr.to_yojson n + | JmpBuf n -> JmpBufs.to_yojson n + | Mutex -> `String "mutex" + | Bot -> `String "⊥" + | Top -> `String "⊤" + + let arbitrary () = QCheck.always Bot (* S TODO: other elements *) (*Changes the value: if p is present, change all Integer precisions. If array_attr=(varAttr, typeAttr) is present, change the top level array domain according to the attributes *) let rec project ask p array_attr (v: t): t = match v, p, array_attr with | _, None, None -> v (*Nothing to change*) (* as long as we only have one representation, project is a nop*) - | `Float n, _, _ -> `Float n - | `Int n, Some p, _-> `Int (ID.project p n) - | `Address n, Some p, _-> `Address (project_addr p n) - | `Struct n, _, _ -> `Struct (Structs.map (fun (x: t) -> project ask p None x) n) - | `Union (f, v), _, _ -> `Union (f, project ask p None v) - | `Array n , _, _ -> `Array (project_arr ask p array_attr n) - | `Blob (v, s, z), Some p', _ -> `Blob (project ask p None v, ID.project p' s, z) - | `Thread n, _, _ -> `Thread n - | `Bot, _, _ -> `Bot - | `Top, _, _ -> `Top + | Float n, _, _ -> Float n + | Int n, Some p, _-> Int (ID.project p n) + | Address n, Some p, _-> Address (project_addr p n) + | Struct n, _, _ -> Struct (Structs.map (fun (x: t) -> project ask p None x) n) + | Union (f, v), _, _ -> Union (f, project ask p None v) + | Array n , _, _ -> Array (project_arr ask p array_attr n) + | Blob (v, s, z), Some p', _ -> Blob (project ask p None v, ID.project p' s, z) + | Thread n, _, _ -> Thread n + | Bot, _, _ -> Bot + | Top, _, _ -> Top | _, _, _ -> v (*Nothing to change*) and project_addr p a = AD.map (fun addr -> @@ -1212,19 +1214,19 @@ struct let relift state = match state with - | `Int n -> `Int (ID.relift n) - | `Float n -> `Float (FD.relift n) - | `Address n -> `Address (AD.relift n) - | `Struct n -> `Struct (Structs.relift n) - | `Union n -> `Union (Unions.relift n) - | `Array n -> `Array (CArrays.relift n) - | `Blob n -> `Blob (Blobs.relift n) - | `Thread n -> `Thread (Threads.relift n) - | `JmpBuf n -> `JmpBuf (JmpBufs.relift n) - | `MutexAttr n -> `MutexAttr (MutexAttr.relift n) - | `Mutex -> `Mutex - | `Bot -> `Bot - | `Top -> `Top + | Int n -> Int (ID.relift n) + | Float n -> Float (FD.relift n) + | Address n -> Address (AD.relift n) + | Struct n -> Struct (Structs.relift n) + | Union n -> Union (Unions.relift n) + | Array n -> Array (CArrays.relift n) + | Blob n -> Blob (Blobs.relift n) + | Thread n -> Thread (Threads.relift n) + | JmpBuf n -> JmpBuf (JmpBufs.relift n) + | MutexAttr n -> MutexAttr (MutexAttr.relift n) + | Mutex -> Mutex + | Bot -> Bot + | Top -> Top end and Structs: StructDomain.S with type field = fieldinfo and type value = Compound.t = @@ -1327,23 +1329,23 @@ struct vd_invariant ~vs ~offset ~lval v and vd_invariant ~vs ~offset ~lval = function - | `Int n -> + | Compound.Int n -> let e = Lval lval in if InvariantCil.(not (exp_contains_tmp e) && exp_is_in_scope scope e) then ID.invariant e n else Invariant.none - | `Float n -> + | Float n -> let e = Lval lval in if InvariantCil.(not (exp_contains_tmp e) && exp_is_in_scope scope e) then FD.invariant e n else Invariant.none - | `Address n -> ad_invariant ~vs ~offset ~lval n - | `Struct n -> Structs.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n - | `Union n -> Unions.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n - | `Array n -> CArrays.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n - | `Blob n when GobConfig.get_bool "ana.base.invariant.blobs" -> blob_invariant ~vs ~offset ~lval n + | Address n -> ad_invariant ~vs ~offset ~lval n + | Struct n -> Structs.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n + | Union n -> Unions.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n + | Array n -> CArrays.invariant ~value_invariant:(vd_invariant ~vs) ~offset ~lval n + | Blob n when GobConfig.get_bool "ana.base.invariant.blobs" -> blob_invariant ~vs ~offset ~lval n | _ -> Invariant.none (* TODO *) and deref_invariant ~vs vi ~offset ~lval = From 8c38d6798153f7ec86aab57d1ec62118d3a252d9 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 31 May 2023 18:34:42 +0200 Subject: [PATCH 333/518] Annotate types instead of prefix with VD --- src/analyses/baseInvariant.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index 5013bba31d..b75853bb0d 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -52,9 +52,9 @@ struct (* other unary operators are not implemented on float values *) | _ -> (fun c -> FD.top_of (FD.get_fkind c)) - let is_some_bot x = + let is_some_bot (x:VD.t) = match x with - | VD.Bot -> false (* HACK: bot is here due to typing conflict (we do not cast appropriately) *) + | Bot -> false (* HACK: bot is here due to typing conflict (we do not cast appropriately) *) | _ -> VD.is_bot_value x let apply_invariant oldv newv = @@ -126,7 +126,7 @@ struct let invariant_fallback ctx a (gs:V.t -> G.t) st exp tv = (* We use a recursive helper function so that x != 0 is false can be handled * as x == 0 is true etc *) - let rec helper (op: binop) (lval: lval) (value: VD.t) (tv: bool) = + let rec helper (op: binop) (lval: lval) (value: VD.t) (tv: bool): (lval * VD.t) option = match (op, lval, value, tv) with (* The true-branch where x == value: *) | Eq, x, value, true -> @@ -134,7 +134,7 @@ struct (match value with | Int n -> let ikind = Cilfacade.get_ikind_exp (Lval lval) in - Some (x, VD.Int (ID.cast_to ikind n)) + Some (x, Int (ID.cast_to ikind n)) | _ -> Some(x, value)) (* The false-branch for x == value: *) | Eq, x, value, false -> begin @@ -204,9 +204,9 @@ struct None in if M.tracing then M.traceli "invariant" "assume expression %a is %B\n" d_exp exp tv; - let null_val typ = + let null_val (typ:typ):VD.t = match Cil.unrollType typ with - | TPtr _ -> VD.Address AD.null_ptr + | TPtr _ -> Address AD.null_ptr | TEnum({ekind=_;_},_) | _ -> Int (ID.of_int (Cilfacade.get_ikind typ) BI.zero) in From f56f21c6791493d13509bd6593ffd5b6cc2d8bfb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 12:17:33 +0300 Subject: [PATCH 334/518] Revert region domain changes which should never be triggered --- src/cdomains/regionDomain.ml | 7 +++---- src/domains/partitionDomain.ml | 3 ++- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index 5bccc9d6a4..9911207494 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -47,14 +47,13 @@ struct let leq x y = match x,y with | `Right (), `Right () -> true + | `Right (), _ | _, `Right () -> false (* incomparable according to collapse *) | `Left x, `Left y -> VF.leq x y - | `Left _, _ -> false - | _, `Left _ -> true let join (x:t) (y:t) :t = match x,y with - | `Right (), _ -> y - | _, `Right () -> x + | `Right (), `Right () -> `Right () + | `Right (), _ | _, `Right () -> raise Lattice.Uncomparable (* incomparable according to collapse *) | `Left x, `Left y -> `Left (VF.join x y) let lift f y = match y with diff --git a/src/domains/partitionDomain.ml b/src/domains/partitionDomain.ml index 09e222e8fa..eab15e1b05 100644 --- a/src/domains/partitionDomain.ml +++ b/src/domains/partitionDomain.ml @@ -27,7 +27,8 @@ struct let (s1', res) = fold f s2 (s1, empty ()) in union s1' res - let meet a b = a (* inter is unsound *) + (* TODO: inter-based meet is unsound? *) + let meet _ _ = failwith "PartitonDomain.Set.meet: unsound" let collapse (s1:t) (s2:t): bool = let f vf2 res = From cb55c2dc9cd4519e0d6e12fa92bdcd212ee204ee Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 1 Jun 2023 11:21:31 +0200 Subject: [PATCH 335/518] malloc_null: Replace custom `may` with `Option.iter` --- src/analyses/malloc_null.ml | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index caaf4ce3e3..02bb7df845 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -91,11 +91,6 @@ struct warn_deref_exp a st t; warn_deref_exp a st f - let may (f: 'a -> 'b) (x: 'a option) : unit = - match x with - | Some x -> f x - | None -> () - (* Generate addresses to all points in an given varinfo. (Depends on type) *) let to_addrs (v:varinfo) : Addr.t list = let make_offs = List.fold_left (fun o f -> `Field (f, o)) `NoOffset in @@ -195,7 +190,7 @@ struct let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = let nst = remove_unreachable (Analyses.ask_of_ctx ctx) args ctx.local in - may (fun x -> warn_deref_exp (Analyses.ask_of_ctx ctx) ctx.local (Lval x)) lval; + Option.iter (fun x -> warn_deref_exp (Analyses.ask_of_ctx ctx) ctx.local (Lval x)) lval; List.iter (warn_deref_exp (Analyses.ask_of_ctx ctx) ctx.local) args; [ctx.local,nst] @@ -213,7 +208,7 @@ struct | _ -> ctx.local let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = - may (fun x -> warn_deref_exp (Analyses.ask_of_ctx ctx) ctx.local (Lval x)) lval; + Option.iter (fun x -> warn_deref_exp (Analyses.ask_of_ctx ctx) ctx.local (Lval x)) lval; List.iter (warn_deref_exp (Analyses.ask_of_ctx ctx) ctx.local) arglist; let desc = LibraryFunctions.find f in match desc.special arglist, lval with From 784045e930626795243a5b54a83d5b75cc67fde3 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 1 Jun 2023 12:29:03 +0300 Subject: [PATCH 336/518] Add test for using __thread keyword --- .../04-mutex/82-thread-local-storage.c | 23 +++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 tests/regression/04-mutex/82-thread-local-storage.c diff --git a/tests/regression/04-mutex/82-thread-local-storage.c b/tests/regression/04-mutex/82-thread-local-storage.c new file mode 100644 index 0000000000..e4eae3adaf --- /dev/null +++ b/tests/regression/04-mutex/82-thread-local-storage.c @@ -0,0 +1,23 @@ +#include +#include + +__thread int myglobal; +pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&mutex1); + myglobal=myglobal+1; // NORACE + pthread_mutex_unlock(&mutex1); + return NULL; +} + +int main(void) { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + pthread_mutex_lock(&mutex2); + myglobal=myglobal+1; // NORACE + pthread_mutex_unlock(&mutex2); + pthread_join (id, NULL); + return 0; +} From 32cfb03111df44f050757c90cdaa8f503247791d Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 1 Jun 2023 12:29:57 +0300 Subject: [PATCH 337/518] Ignore variables with __thread keyword --- src/domains/access.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/domains/access.ml b/src/domains/access.ml index c40e6f136c..c433d72c5d 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -20,6 +20,7 @@ let is_ignorable_type (t: typ): bool = let is_ignorable = function | None -> false + | Some (v,os) when hasAttribute "thread" v.vattr -> true (* Thread-Local Storage *) | Some (v,os) -> try isFunctionType v.vtype || is_ignorable_type v.vtype with Not_found -> false From 29227eca0ca6277fbeb91a2bc40efd855ad6ad5b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 13:02:40 +0300 Subject: [PATCH 338/518] Move Lval.Normal to AddressDomain --- src/cdomains/addressDomain.ml | 340 +++++++++++++++++++++++++++++++- src/cdomains/lval.ml | 321 ------------------------------ src/cdomains/preValueDomain.ml | 2 +- src/cdomains/symbLocksDomain.ml | 2 +- 4 files changed, 334 insertions(+), 331 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index ad0abb7378..341a4f9933 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -2,9 +2,333 @@ open GoblintCil open IntOps +open Lval module M = Messages +module type SAddr = +sig + type field + type idx + include Printable.S + + val null_ptr: unit -> t + val str_ptr: unit -> t + val is_null: t -> bool + val get_location: t -> location + + val from_var: varinfo -> t + (** Creates an address from variable. *) + + val from_var_offset: (varinfo * (field,idx) offs) -> t + (** Creates an address from a variable and offset. *) + + val to_var_offset: t -> (varinfo * (field,idx) offs) list + (** Get the offset *) + + val to_var: t -> varinfo list + (** Strips the varinfo out of the address representation. *) + + val to_var_may: t -> varinfo list + val to_var_must: t -> varinfo list + (** Strips the varinfo out of the address representation. *) + + val get_type: t -> typ + (** Finds the type of the address location. *) +end + +module PreNormal (Offset: Printable.S) = +struct + include Printable.StdLeaf + type t = + | Addr of CilType.Varinfo.t * Offset.t (** Pointer to offset of a variable. *) + | NullPtr (** NULL pointer. *) + | UnknownPtr (** Unknown pointer. Could point to globals, heap and escaped variables. *) + | StrPtr of string option (** String literal pointer. [StrPtr None] abstracts any string pointer *) + [@@deriving eq, ord, hash] (* TODO: StrPtr equal problematic if the same literal appears more than once *) + + let hash x = match x with + | StrPtr _ -> + if GobConfig.get_bool "ana.base.limit-string-addresses" then + 13859 + else + hash x + | _ -> hash x + + let show_addr (x, o) = + if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo x then + let description = RichVarinfo.BiVarinfoMap.Collection.describe_varinfo x in + "(" ^ x.vname ^ ", " ^ description ^ ")" ^ Offset.show o + else x.vname ^ Offset.show o + + let show = function + | Addr (x, o)-> show_addr (x, o) + | StrPtr (Some x) -> "\"" ^ x ^ "\"" + | StrPtr None -> "(unknown string)" + | UnknownPtr -> "?" + | NullPtr -> "NULL" + + include Printable.SimpleShow ( + struct + type nonrec t = t + let show = show + end + ) +end + +module Normal (Idx: Offset.Index.Printable) = +struct + type field = fieldinfo + type idx = Idx.t + module Offs = Offset.MakePrintable (Idx) + include PreNormal (Offs) + + let name () = "Normal Lvals" + + type group = Basetype.Variables.group + let show_group = Basetype.Variables.show_group + let to_group = function + | Addr (x,_) -> Basetype.Variables.to_group x + | _ -> Some Basetype.Variables.Local + + let from_var x = Addr (x, `NoOffset) + let from_var_offset (x, o) = Addr (x, o) + + let to_var = function + | Addr (x,_) -> Some x + | _ -> None + let to_var_may = function + | Addr (x,_) -> Some x + | _ -> None + let to_var_must = function + | Addr (x,`NoOffset) -> Some x + | _ -> None + let to_var_offset = function + | Addr (x, o) -> Some (x, o) + | _ -> None + + (* strings *) + let from_string x = StrPtr (Some x) + let to_string = function + | StrPtr (Some x) -> Some x + | _ -> None + (* only keep part before first null byte *) + let to_c_string = function + | StrPtr (Some x) -> + begin match String.split_on_char '\x00' x with + | s::_ -> Some s + | [] -> None + end + | _ -> None + let to_n_c_string n x = + match to_c_string x with + | Some x -> + if n > String.length x then + Some x + else if n < 0 then + None + else + Some (String.sub x 0 n) + | _ -> None + let to_string_length x = + match to_c_string x with + | Some x -> Some (String.length x) + | _ -> None + + (* exception if the offset can't be followed completely *) + exception Type_offset of typ * string + (* tries to follow o in t *) + let rec type_offset t o = match unrollType t, o with (* resolves TNamed *) + | t, `NoOffset -> t + | TArray (t,_,_), `Index (i,o) + | TPtr (t,_), `Index (i,o) -> type_offset t o + | TComp (ci,_), `Field (f,o) -> + let fi = try getCompField ci f.fname + with Not_found -> + let s = GobPretty.sprintf "Addr.type_offset: field %s not found in type %a" f.fname d_plaintype t in + raise (Type_offset (t, s)) + in type_offset fi.ftype o + | TComp _, `Index (_,o) -> type_offset t o (* this happens (hmmer, perlbench). safe? *) + | t,o -> + let s = GobPretty.sprintf "Addr.type_offset: could not follow offset in type. type: %a, offset: %a" d_plaintype t Offs.pretty o in + raise (Type_offset (t, s)) + + let get_type_addr (v,o) = try type_offset v.vtype o with Type_offset (t,_) -> t + + let get_type = function + | Addr (x, o) -> get_type_addr (x, o) + | StrPtr _ -> charPtrType (* TODO Cil.charConstPtrType? *) + | NullPtr -> voidType + | UnknownPtr -> voidPtrType + + let is_zero_offset x = Offs.cmp_zero_offset x = `MustZero + + (* TODO: seems to be unused *) + let to_exp (f:idx -> exp) x = + (* TODO: Offset *) + let rec to_cil c = + match c with + | `NoOffset -> NoOffset + | `Field (fld, ofs) -> Field (fld , to_cil ofs) + | `Index (idx, ofs) -> Index (f idx, to_cil ofs) + in + match x with + | Addr (v,o) -> AddrOf (Var v, to_cil o) + | StrPtr (Some x) -> mkString x + | StrPtr None -> raise (Lattice.Unsupported "Cannot express unknown string pointer as expression.") + | NullPtr -> integer 0 + | UnknownPtr -> raise Lattice.TopValue + (* TODO: unused *) + let add_offset x o = match x with + | Addr (v, u) -> Addr (v, Offs.add_offset u o) + | x -> x + + let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) +end + +(** Lvalue lattice. + + Actually a disjoint union of lattices without top or bottom. + Lvalues are grouped as follows: + + - Each {!Addr}, modulo precise index expressions in offset, is a sublattice with ordering induced by {!Offset}. + - {!NullPtr} is a singleton sublattice. + - {!UnknownPtr} is a singleton sublattice. + - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) +module NormalLat (Idx: Offset.Index.Lattice) = +struct + include Normal (Idx) + module Offs = Offset.MakeLattice (Idx) + + (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) + let semantic_equal x y = match x, y with + | Addr (x, xoffs), Addr (y, yoffs) -> + if CilType.Varinfo.equal x y then + let xtyp = x.vtype in + let ytyp = y.vtype in + Offs.semantic_equal ~xtyp ~xoffs ~ytyp ~yoffs + else + Some false + | StrPtr None, StrPtr _ + | StrPtr _, StrPtr None -> Some true + | StrPtr (Some a), StrPtr (Some b) -> if a = b then None else Some false + | NullPtr, NullPtr -> Some true + | UnknownPtr, UnknownPtr + | UnknownPtr, Addr _ + | Addr _, UnknownPtr + | UnknownPtr, StrPtr _ + | StrPtr _, UnknownPtr -> None + | _, _ -> Some false + + let is_definite = function + | NullPtr -> true + | Addr (v,o) when Offs.is_definite o -> true + | _ -> false + + let leq x y = match x, y with + | StrPtr _, StrPtr None -> true + | StrPtr a, StrPtr b -> a = b + | Addr (x,o), Addr (y,u) -> CilType.Varinfo.equal x y && Offs.leq o u + | _ -> x = y + + let drop_ints = function + | Addr (x, o) -> Addr (x, Offs.top_indices o) + | x -> x + + let join_string_ptr x y = match x, y with + | None, _ + | _, None -> None + | Some a, Some b when a = b -> Some a + | Some a, Some b (* when a <> b *) -> + if GobConfig.get_bool "ana.base.limit-string-addresses" then + None + else + raise Lattice.Uncomparable + + let meet_string_ptr x y = match x, y with + | None, a + | a, None -> a + | Some a, Some b when a = b -> Some a + | Some a, Some b (* when a <> b *) -> + if GobConfig.get_bool "ana.base.limit-string-addresses" then + raise Lattice.BotValue + else + raise Lattice.Uncomparable + + let merge cop x y = + match x, y with + | UnknownPtr, UnknownPtr -> UnknownPtr + | NullPtr , NullPtr -> NullPtr + | StrPtr a, StrPtr b -> + StrPtr + begin match cop with + |`Join | `Widen -> join_string_ptr a b + |`Meet | `Narrow -> meet_string_ptr a b + end + | Addr (x,o), Addr (y,u) when CilType.Varinfo.equal x y -> Addr (x, Offs.merge cop o u) + | _ -> raise Lattice.Uncomparable + + let join = merge `Join + let widen = merge `Widen + let meet = merge `Meet + let narrow = merge `Narrow + + include Lattice.NoBotTop + + let pretty_diff () (x,y) = Pretty.dprintf "%s: %a not leq %a" (name ()) pretty x pretty y +end + +(** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) +module BaseAddrRepr (Idx: Offset.Index.Lattice) = +struct + include NormalLat (Idx) + + module R: DisjointDomain.Representative with type elt = t = + struct + type elt = t + + module AnyOffset = Printable.UnitConf (struct let name = "" end) + include PreNormal (AnyOffset) + + let name () = "BaseAddrRepr.R" + + let of_elt (x: elt): t = match x with + | Addr (v, o) -> Addr (v, ()) + | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) + | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) + | NullPtr -> NullPtr + | UnknownPtr -> UnknownPtr + end +end + +(** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) +module NormalLatRepr (Idx: Offset.Index.Lattice) = +struct + include NormalLat (Idx) + + (** Representatives for lvalue sublattices as defined by {!NormalLat}. *) + module R: DisjointDomain.Representative with type elt = t = + struct + type elt = t + open Offset.Unit + + (* Offset module for representative without abstract values for index offsets, i.e. with unit index offsets. + Reason: The offset in the representative (used for buckets) should not depend on the integer domains, + since different integer domains may be active at different program points. *) + include Normal (Offset.Index.Unit) + + let of_elt_offset: (fieldinfo, Idx.t) offs -> (fieldinfo, unit) offs = of_offs + + let of_elt (x: elt): t = match x with + | Addr (v, o) -> Addr (v, of_elt_offset o) (* addrs grouped by var and part of offset *) + | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) + | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) + | NullPtr -> NullPtr + | UnknownPtr -> UnknownPtr + end +end + + module type S = sig include Lattice.S @@ -21,8 +345,8 @@ end module AddressSet (Idx: IntDomain.Z) = struct - module BaseAddr = Lval.BaseAddrRepr (Idx) - module Addr = Lval.NormalLatRepr (Idx) + module BaseAddr = BaseAddrRepr (Idx) + module Addr = NormalLatRepr (Idx) module J = (struct include SetDomain.Joined (Addr) let may_be_equal a b = Option.value (Addr.semantic_equal a b) ~default:true @@ -103,14 +427,14 @@ struct (* strings *) let from_string x = singleton (Addr.from_string x) - + let to_string x = List.filter_map Addr.to_string (elements x) - + let to_string_length x = let transform elem = match Addr.to_string_length elem with | Some x -> Idx.of_int !Cil.kindOfSizeOf (Z.of_int x) - | None -> Idx.top_of !Cil.kindOfSizeOf in + | None -> Idx.top_of !Cil.kindOfSizeOf in (* maps any StrPtr to the length of its content, otherwise maps to top *) List.map transform (elements x) (* and returns the least upper bound of computed IntDomain values *) @@ -126,7 +450,7 @@ struct | Some s -> from_string s | None -> null_ptr in let compute_substring s1 s2 = - try + try let i = Str.search_forward (Str.regexp_string s2) s1 0 in Some (String.sub s1 i (String.length s1 - i)) with Not_found -> None in @@ -148,8 +472,8 @@ struct | None -> Addr.to_c_string in (* map all StrPtr elements in input address sets to contained strings / n-substrings *) - let x' = List.map f (elements x) in - let y' = List.map f (elements y) in + let x' = List.map f (elements x) in + let y' = List.map f (elements y) in (* helper functions *) let compare s1 s2 = diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 35917c09ea..6069320d3c 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -32,327 +32,6 @@ struct end -module type S = -sig - type field - type idx - include Printable.S - - val null_ptr: unit -> t - val str_ptr: unit -> t - val is_null: t -> bool - val get_location: t -> location - - val from_var: varinfo -> t - (** Creates an address from variable. *) - - val from_var_offset: (varinfo * (field,idx) offs) -> t - (** Creates an address from a variable and offset. *) - - val to_var_offset: t -> (varinfo * (field,idx) offs) list - (** Get the offset *) - - val to_var: t -> varinfo list - (** Strips the varinfo out of the address representation. *) - - val to_var_may: t -> varinfo list - val to_var_must: t -> varinfo list - (** Strips the varinfo out of the address representation. *) - - val get_type: t -> typ - (** Finds the type of the address location. *) -end - -module PreNormal (Offset: Printable.S) = -struct - include Printable.StdLeaf - type t = - | Addr of CilType.Varinfo.t * Offset.t (** Pointer to offset of a variable. *) - | NullPtr (** NULL pointer. *) - | UnknownPtr (** Unknown pointer. Could point to globals, heap and escaped variables. *) - | StrPtr of string option (** String literal pointer. [StrPtr None] abstracts any string pointer *) - [@@deriving eq, ord, hash] (* TODO: StrPtr equal problematic if the same literal appears more than once *) - - let hash x = match x with - | StrPtr _ -> - if GobConfig.get_bool "ana.base.limit-string-addresses" then - 13859 - else - hash x - | _ -> hash x - - let show_addr (x, o) = - if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo x then - let description = RichVarinfo.BiVarinfoMap.Collection.describe_varinfo x in - "(" ^ x.vname ^ ", " ^ description ^ ")" ^ Offset.show o - else x.vname ^ Offset.show o - - let show = function - | Addr (x, o)-> show_addr (x, o) - | StrPtr (Some x) -> "\"" ^ x ^ "\"" - | StrPtr None -> "(unknown string)" - | UnknownPtr -> "?" - | NullPtr -> "NULL" - - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) -end - -module Normal (Idx: Offset.Index.Printable) = -struct - type field = fieldinfo - type idx = Idx.t - module Offs = Offset.MakePrintable (Idx) - include PreNormal (Offs) - - let name () = "Normal Lvals" - - type group = Basetype.Variables.group - let show_group = Basetype.Variables.show_group - let to_group = function - | Addr (x,_) -> Basetype.Variables.to_group x - | _ -> Some Basetype.Variables.Local - - let from_var x = Addr (x, `NoOffset) - let from_var_offset (x, o) = Addr (x, o) - - let to_var = function - | Addr (x,_) -> Some x - | _ -> None - let to_var_may = function - | Addr (x,_) -> Some x - | _ -> None - let to_var_must = function - | Addr (x,`NoOffset) -> Some x - | _ -> None - let to_var_offset = function - | Addr (x, o) -> Some (x, o) - | _ -> None - - (* strings *) - let from_string x = StrPtr (Some x) - let to_string = function - | StrPtr (Some x) -> Some x - | _ -> None - (* only keep part before first null byte *) - let to_c_string = function - | StrPtr (Some x) -> - begin match String.split_on_char '\x00' x with - | s::_ -> Some s - | [] -> None - end - | _ -> None - let to_n_c_string n x = - match to_c_string x with - | Some x -> - if n > String.length x then - Some x - else if n < 0 then - None - else - Some (String.sub x 0 n) - | _ -> None - let to_string_length x = - match to_c_string x with - | Some x -> Some (String.length x) - | _ -> None - - (* exception if the offset can't be followed completely *) - exception Type_offset of typ * string - (* tries to follow o in t *) - let rec type_offset t o = match unrollType t, o with (* resolves TNamed *) - | t, `NoOffset -> t - | TArray (t,_,_), `Index (i,o) - | TPtr (t,_), `Index (i,o) -> type_offset t o - | TComp (ci,_), `Field (f,o) -> - let fi = try getCompField ci f.fname - with Not_found -> - let s = GobPretty.sprintf "Addr.type_offset: field %s not found in type %a" f.fname d_plaintype t in - raise (Type_offset (t, s)) - in type_offset fi.ftype o - | TComp _, `Index (_,o) -> type_offset t o (* this happens (hmmer, perlbench). safe? *) - | t,o -> - let s = GobPretty.sprintf "Addr.type_offset: could not follow offset in type. type: %a, offset: %a" d_plaintype t Offs.pretty o in - raise (Type_offset (t, s)) - - let get_type_addr (v,o) = try type_offset v.vtype o with Type_offset (t,_) -> t - - let get_type = function - | Addr (x, o) -> get_type_addr (x, o) - | StrPtr _ -> charPtrType (* TODO Cil.charConstPtrType? *) - | NullPtr -> voidType - | UnknownPtr -> voidPtrType - - let is_zero_offset x = Offs.cmp_zero_offset x = `MustZero - - (* TODO: seems to be unused *) - let to_exp (f:idx -> exp) x = - (* TODO: Offset *) - let rec to_cil c = - match c with - | `NoOffset -> NoOffset - | `Field (fld, ofs) -> Field (fld , to_cil ofs) - | `Index (idx, ofs) -> Index (f idx, to_cil ofs) - in - match x with - | Addr (v,o) -> AddrOf (Var v, to_cil o) - | StrPtr (Some x) -> mkString x - | StrPtr None -> raise (Lattice.Unsupported "Cannot express unknown string pointer as expression.") - | NullPtr -> integer 0 - | UnknownPtr -> raise Lattice.TopValue - (* TODO: unused *) - let add_offset x o = match x with - | Addr (v, u) -> Addr (v, Offs.add_offset u o) - | x -> x - - let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) -end - -(** Lvalue lattice. - - Actually a disjoint union of lattices without top or bottom. - Lvalues are grouped as follows: - - - Each {!Addr}, modulo precise index expressions in offset, is a sublattice with ordering induced by {!Offset}. - - {!NullPtr} is a singleton sublattice. - - {!UnknownPtr} is a singleton sublattice. - - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) -module NormalLat (Idx: Offset.Index.Lattice) = -struct - include Normal (Idx) - module Offs = Offset.MakeLattice (Idx) - - (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) - let semantic_equal x y = match x, y with - | Addr (x, xoffs), Addr (y, yoffs) -> - if CilType.Varinfo.equal x y then - let xtyp = x.vtype in - let ytyp = y.vtype in - Offs.semantic_equal ~xtyp ~xoffs ~ytyp ~yoffs - else - Some false - | StrPtr None, StrPtr _ - | StrPtr _, StrPtr None -> Some true - | StrPtr (Some a), StrPtr (Some b) -> if a = b then None else Some false - | NullPtr, NullPtr -> Some true - | UnknownPtr, UnknownPtr - | UnknownPtr, Addr _ - | Addr _, UnknownPtr - | UnknownPtr, StrPtr _ - | StrPtr _, UnknownPtr -> None - | _, _ -> Some false - - let is_definite = function - | NullPtr -> true - | Addr (v,o) when Offs.is_definite o -> true - | _ -> false - - let leq x y = match x, y with - | StrPtr _, StrPtr None -> true - | StrPtr a, StrPtr b -> a = b - | Addr (x,o), Addr (y,u) -> CilType.Varinfo.equal x y && Offs.leq o u - | _ -> x = y - - let drop_ints = function - | Addr (x, o) -> Addr (x, Offs.top_indices o) - | x -> x - - let join_string_ptr x y = match x, y with - | None, _ - | _, None -> None - | Some a, Some b when a = b -> Some a - | Some a, Some b (* when a <> b *) -> - if GobConfig.get_bool "ana.base.limit-string-addresses" then - None - else - raise Lattice.Uncomparable - - let meet_string_ptr x y = match x, y with - | None, a - | a, None -> a - | Some a, Some b when a = b -> Some a - | Some a, Some b (* when a <> b *) -> - if GobConfig.get_bool "ana.base.limit-string-addresses" then - raise Lattice.BotValue - else - raise Lattice.Uncomparable - - let merge cop x y = - match x, y with - | UnknownPtr, UnknownPtr -> UnknownPtr - | NullPtr , NullPtr -> NullPtr - | StrPtr a, StrPtr b -> - StrPtr - begin match cop with - |`Join | `Widen -> join_string_ptr a b - |`Meet | `Narrow -> meet_string_ptr a b - end - | Addr (x,o), Addr (y,u) when CilType.Varinfo.equal x y -> Addr (x, Offs.merge cop o u) - | _ -> raise Lattice.Uncomparable - - let join = merge `Join - let widen = merge `Widen - let meet = merge `Meet - let narrow = merge `Narrow - - include Lattice.NoBotTop - - let pretty_diff () (x,y) = dprintf "%s: %a not leq %a" (name ()) pretty x pretty y -end - -(** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module BaseAddrRepr (Idx: Offset.Index.Lattice) = -struct - include NormalLat (Idx) - - module R: DisjointDomain.Representative with type elt = t = - struct - type elt = t - - module AnyOffset = Printable.UnitConf (struct let name = "" end) - include PreNormal (AnyOffset) - - let name () = "BaseAddrRepr.R" - - let of_elt (x: elt): t = match x with - | Addr (v, o) -> Addr (v, ()) - | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) - | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) - | NullPtr -> NullPtr - | UnknownPtr -> UnknownPtr - end -end - -(** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module NormalLatRepr (Idx: Offset.Index.Lattice) = -struct - include NormalLat (Idx) - - (** Representatives for lvalue sublattices as defined by {!NormalLat}. *) - module R: DisjointDomain.Representative with type elt = t = - struct - type elt = t - open Offset.Unit - - (* Offset module for representative without abstract values for index offsets, i.e. with unit index offsets. - Reason: The offset in the representative (used for buckets) should not depend on the integer domains, - since different integer domains may be active at different program points. *) - include Normal (Offset.Index.Unit) - - let of_elt_offset: (fieldinfo, Idx.t) offs -> (fieldinfo, unit) offs = of_offs - - let of_elt (x: elt): t = match x with - | Addr (v, o) -> Addr (v, of_elt_offset o) (* addrs grouped by var and part of offset *) - | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) - | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) - | NullPtr -> NullPtr - | UnknownPtr -> UnknownPtr - end -end module CilLval = struct diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml index 3d4dd6b5c4..ff71da64ca 100644 --- a/src/cdomains/preValueDomain.ml +++ b/src/cdomains/preValueDomain.ml @@ -2,4 +2,4 @@ module ID = IntDomain.IntDomTuple module FD = FloatDomain.FloatDomTupleImpl module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind) (* TODO: add ptrdiff cast into to_int? *) module AD = AddressDomain.AddressSet (IndexDomain) -module Addr = Lval.NormalLat (IndexDomain) +module Addr = AddressDomain.NormalLat (IndexDomain) diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index b97c541efe..47ace795b7 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -305,7 +305,7 @@ struct let top () = Unknown end - include Lval.Normal (Idx) + include AddressDomain.Normal (Idx) let rec conv_const_offset x = match x with From 8489bd74281ab29c528b52d2d30f3051366d81b5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 13:24:58 +0300 Subject: [PATCH 339/518] Remove Lval.offs alias --- src/analyses/baseInvariant.ml | 2 +- src/analyses/malloc_null.ml | 4 ++-- src/analyses/taintPartialContexts.ml | 2 +- src/analyses/uninit.ml | 6 +++--- src/cdomains/addressDomain.ml | 10 +++++----- src/cdomains/lval.ml | 2 -- src/cdomains/valueDomain.ml | 4 ++-- 7 files changed, 14 insertions(+), 16 deletions(-) diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index fe7a1069ff..521a046fdd 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -18,7 +18,7 @@ sig val eval_rv: Queries.ask -> (V.t -> G.t) -> D.t -> exp -> VD.t val eval_rv_address: Queries.ask -> (V.t -> G.t) -> D.t -> exp -> VD.t val eval_lv: Queries.ask -> (V.t -> G.t) -> D.t -> lval -> AD.t - val convert_offset: Queries.ask -> (V.t -> G.t) -> D.t -> offset -> (fieldinfo, ID.t) Lval.offs + val convert_offset: Queries.ask -> (V.t -> G.t) -> D.t -> offset -> ID.t Offset.t val get_var: Queries.ask -> (V.t -> G.t) -> D.t -> varinfo -> VD.t val get: Queries.ask -> (V.t -> G.t) -> D.t -> AD.t -> exp option -> VD.t diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index 8f9c031027..63728ef2e7 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -19,7 +19,7 @@ struct (* Addr set functions: *) - let is_prefix_of (v1,ofs1: varinfo * (Addr.field,Addr.idx) Lval.offs) (v2,ofs2: varinfo * (Addr.field,Addr.idx) Lval.offs) : bool = + let is_prefix_of (v1,ofs1: varinfo * Addr.idx Offset.t) (v2,ofs2: varinfo * Addr.idx Offset.t) : bool = let rec is_offs_prefix_of pr os = match (pr, os) with | (`NoOffset, `NoOffset) -> true @@ -30,7 +30,7 @@ struct CilType.Varinfo.equal v1 v2 && is_offs_prefix_of ofs1 ofs2 (* We just had to dereference an lval --- warn if it was null *) - let warn_lval (st:D.t) (v :varinfo * (Addr.field,Addr.idx) Lval.offs) : unit = + let warn_lval (st:D.t) (v :varinfo * Addr.idx Offset.t) : unit = try if D.exists (fun x -> GobOption.exists (fun x -> is_prefix_of x v) (Addr.to_var_offset x)) st then diff --git a/src/analyses/taintPartialContexts.ml b/src/analyses/taintPartialContexts.ml index 5edeb1e403..89504fcd20 100644 --- a/src/analyses/taintPartialContexts.ml +++ b/src/analyses/taintPartialContexts.ml @@ -14,7 +14,7 @@ struct module D = SetDomain.ToppedSet (Lval.CilLval) (struct let topname = "All" end) module C = Lattice.Unit - let rec resolve (offs : offset) : (CilType.Fieldinfo.t, Basetype.CilExp.t) Lval.offs = + let rec resolve (offs : offset) : Basetype.CilExp.t Offset.t = match offs with | NoOffset -> `NoOffset | Field (f_info, f_offs) -> `Field (f_info, (resolve f_offs)) diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 4eda2c5a9b..8a2d217bfd 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -85,7 +85,7 @@ struct let vars a (rval:exp) : Addr.t list = List.map Addr.from_var_offset (varoffs a rval) - let is_prefix_of (v1,ofs1: varinfo * (Addr.field,Addr.idx) Lval.offs) (v2,ofs2: varinfo * (Addr.field,Addr.idx) Lval.offs) : bool = + let is_prefix_of (v1,ofs1: varinfo * Addr.idx Offset.t) (v2,ofs2: varinfo * Addr.idx Offset.t) : bool = let rec is_offs_prefix_of pr os = match (pr, os) with | (`NoOffset, _) -> true @@ -110,14 +110,14 @@ struct t in List.fold_left will_addr_init true raw_vars - let remove_if_prefix (pr: varinfo * (Addr.field,Addr.idx) Lval.offs) (uis: D.t) : D.t = + let remove_if_prefix (pr: varinfo * Addr.idx Offset.t) (uis: D.t) : D.t = let f ad = let vals = Addr.to_var_offset ad in GobOption.for_all (fun a -> not (is_prefix_of pr a)) vals in D.filter f uis - type lval_offs = (Addr.field,Addr.idx) Lval.offs + type lval_offs = Addr.idx Offset.t type var_offs = varinfo * lval_offs (* Call to [get_pfx v cx] returns initialized prefixes ... *) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 341a4f9933..30801bd98c 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -20,10 +20,10 @@ sig val from_var: varinfo -> t (** Creates an address from variable. *) - val from_var_offset: (varinfo * (field,idx) offs) -> t + val from_var_offset: (varinfo * idx Offset.t) -> t (** Creates an address from a variable and offset. *) - val to_var_offset: t -> (varinfo * (field,idx) offs) list + val to_var_offset: t -> (varinfo * idx Offset.t) list (** Get the offset *) val to_var: t -> varinfo list @@ -317,7 +317,7 @@ struct since different integer domains may be active at different program points. *) include Normal (Offset.Index.Unit) - let of_elt_offset: (fieldinfo, Idx.t) offs -> (fieldinfo, unit) offs = of_offs + let of_elt_offset: Idx.t Offset.t -> Offset.Unit.t = of_offs let of_elt (x: elt): t = match x with | Addr (v, o) -> Addr (v, of_elt_offset o) (* addrs grouped by var and part of offset *) @@ -336,8 +336,8 @@ sig type field val from_var: varinfo -> t - val from_var_offset: (varinfo * (idx,field) Lval.offs) -> t - val to_var_offset: t -> (varinfo * (idx,field) Lval.offs) list + val from_var_offset: (varinfo * idx Offset.t) -> t + val to_var_offset: t -> (varinfo * idx Offset.t) list val to_var_may: t -> varinfo list val to_var_must: t -> varinfo list val get_type: t -> typ diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index 6069320d3c..eb9c0c2d92 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -5,8 +5,6 @@ open Pretty module M = Messages -type ('f, 'i) offs = 'i Offset.t [@@deriving eq, ord, hash] - module MakePrintable (Offs: Printable.S) = struct include Printable.StdLeaf diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 020727be8e..312c472494 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -90,7 +90,7 @@ module rec Compound: S with type t = [ | `Mutex | `MutexAttr of MutexAttr.t | `Bot - ] and type offs = (fieldinfo,IndexDomain.t) Lval.offs = + ] and type offs = IndexDomain.t Offset.t = struct type t = [ | `Top @@ -252,7 +252,7 @@ struct include Printable.Std let name () = "compound" - type offs = (fieldinfo,IndexDomain.t) Lval.offs + type offs = IndexDomain.t Offset.t let bot () = `Bot From d718a2da2309b8237d53a1f243a269dbcb95d010 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 13:28:28 +0300 Subject: [PATCH 340/518] Remove Lval.CilLval.class_tag --- src/analyses/spec.ml | 2 +- src/cdomains/lval.ml | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml index 068698bf45..79e32b5e4b 100644 --- a/src/analyses/spec.ml +++ b/src/analyses/spec.ml @@ -253,7 +253,7 @@ struct | Some k1, Some k2 when D.mem k2 m -> (* only k2 in D *) M.debug ~category:Analyzer "assign (only k2 in D): %s = %s" (D.string_of_key k1) (D.string_of_key k2); let m = D.alias k1 k2 m in (* point k1 to k2 *) - if Lval.CilLval.class_tag k2 = `Temp (* check if k2 is a temporary Lval introduced by CIL *) + if Basetype.Variables.to_group (fst k2) = Some Temp (* check if k2 is a temporary Lval introduced by CIL *) then D.remove' k2 m (* if yes we need to remove it from our map *) else m (* otherwise no change *) | Some k1, _ when D.mem k1 m -> (* k1 in D and assign something unknown *) diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index eb9c0c2d92..fe785d6185 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -35,12 +35,5 @@ module CilLval = struct include Exp - let class_tag (v,o) = - match v with - | _ when v.vglob -> `Global - | _ when v.vdecl.line = -1 -> `Temp - | _ when Cilfacade.is_varinfo_formal v -> `Parameter - | _ -> `Local - let to_exp = to_cil_exp (* TODO: remove *) end From 783830c1792f6c9f18a89a3cd1b37f363d8883ae Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 13:31:23 +0300 Subject: [PATCH 341/518] Remove Lval.CilLval --- src/analyses/base.ml | 16 ++++++++-------- src/analyses/condVars.ml | 6 +++--- src/analyses/fileUse.ml | 2 +- src/analyses/region.ml | 4 ++-- src/analyses/spec.ml | 2 +- src/analyses/taintPartialContexts.ml | 2 +- src/cdomains/lval.ml | 9 --------- src/cdomains/lvalMapDomain.ml | 14 +++++++------- src/domains/valueDomainQueries.ml | 2 +- 9 files changed, 24 insertions(+), 33 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 0d4a927ce5..d4ae2e831d 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2030,7 +2030,7 @@ struct set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value in (* for string functions *) let eval_n = function - (* if only n characters of a given string are needed, evaluate expression n to an integer option *) + (* if only n characters of a given string are needed, evaluate expression n to an integer option *) | Some n -> begin match eval_rv (Analyses.ask_of_ctx ctx) gs st n with | `Int i -> @@ -2041,10 +2041,10 @@ struct | _ -> Some (-1) end (* do nothing if all characters are needed *) - | _ -> None + | _ -> None in let string_manipulation s1 s2 lv all op = - let s1_a, s1_typ = addr_type_of_exp s1 in + let s1_a, s1_typ = addr_type_of_exp s1 in let s2_a, s2_typ = addr_type_of_exp s2 in match lv, op with | Some lv_val, Some f -> @@ -2101,11 +2101,11 @@ struct | None -> failwith "already handled in case above" end | Strcat { dest = dst; src; n }, _ -> - let dest_a, dest_typ, value = string_manipulation dst src None false None in + let dest_a, dest_typ, value = string_manipulation dst src None false None in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Strlen s, _ -> - begin match lv with - | Some lv_val -> + begin match lv with + | Some lv_val -> let dest_a = eval_lv (Analyses.ask_of_ctx ctx) gs st lv_val in let dest_typ = Cilfacade.typeOfLval lv_val in let lval = mkMem ~addr:(Cil.stripCasts s) ~off:NoOffset in @@ -2117,7 +2117,7 @@ struct | Strstr { haystack; needle }, _ -> begin match lv with | Some _ -> - (* when haystack, needle and dest type coincide, check if needle is a substring of haystack: + (* when haystack, needle and dest type coincide, check if needle is a substring of haystack: if that is the case, assign the substring of haystack starting at the first occurrence of needle to dest, else use top *) let dest_a, dest_typ, value = string_manipulation haystack needle lv true (Some (fun h_a n_a -> `Address(AD.substring_extraction h_a n_a))) in @@ -2367,7 +2367,7 @@ struct let lval = Lval.Exp.to_cil (v,o) in let address = eval_lv ask ctx.global st lval in let lval_type = (AD.get_type address) in - if M.tracing then M.trace "taintPC" "updating %a; type: %a\n" Lval.CilLval.pretty (v, o) d_type lval_type; + if M.tracing then M.trace "taintPC" "updating %a; type: %a\n" Lval.Exp.pretty (v, o) d_type lval_type; match (CPA.find_opt v (fun_st.cpa)), lval_type with | None, _ -> st (* partitioned arrays cannot be copied by individual lvalues, so if tainted just copy the whole callee value for the array variable *) diff --git a/src/analyses/condVars.ml b/src/analyses/condVars.ml index 937142b650..e2112ee384 100644 --- a/src/analyses/condVars.ml +++ b/src/analyses/condVars.ml @@ -7,7 +7,7 @@ open Analyses module Domain = struct module V = Queries.ES - include MapDomain.MapBot (Lval.CilLval) (V) + include MapDomain.MapBot (Lval.Exp) (V) let rec var_in_lval p (lh,offs) = var_in_offs p offs && match lh with | Var v -> p v | Mem e -> var_in_expr p e @@ -75,7 +75,7 @@ struct Queries.LS.elements a' | _ -> [] - let mustPointTo ctx exp = (* this is just to get CilLval *) + let mustPointTo ctx exp = (* this is just to get Lval.Exp *) match mayPointTo ctx exp with | [clval] -> Some clval | _ -> None @@ -108,7 +108,7 @@ struct let save_expr lval expr = match mustPointTo ctx (AddrOf lval) with | Some clval -> - if M.tracing then M.tracel "condvars" "CondVars: saving %a = %a\n" Lval.CilLval.pretty clval d_exp expr; + if M.tracing then M.tracel "condvars" "CondVars: saving %a = %a\n" Lval.Exp.pretty clval d_exp expr; D.add clval (D.V.singleton expr) d (* if lval must point to clval, add expr *) | None -> d in diff --git a/src/analyses/fileUse.ml b/src/analyses/fileUse.ml index 47a01c13ba..84c813c902 100644 --- a/src/analyses/fileUse.ml +++ b/src/analyses/fileUse.ml @@ -223,7 +223,7 @@ struct (* let m' = Option.map_default (fun v -> List.fold_left (fun m k -> D.add' k v m) m xs) m v in *) (* then check each key *) (* List.iter (fun k -> ignore(f k m')) xs; *) - (* get CilLval from lval *) + (* get Lval.Exp from lval *) let k' = D.key_from_lval lval in (* add joined value for that key *) let m' = Option.map_default (fun v -> D.add' k' v m) m v in diff --git a/src/analyses/region.ml b/src/analyses/region.ml index c9642a3344..c56e0b5513 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -23,7 +23,7 @@ struct include StdV end - let regions exp part st : Lval.CilLval.t list = + let regions exp part st : Lval.Exp.t list = match st with | `Lifted reg -> let ev = Reg.eval_exp exp in @@ -58,7 +58,7 @@ struct ls | _ -> Queries.Result.top q - module Lvals = SetDomain.Make (Lval.CilLval) + module Lvals = SetDomain.Make (Lval.Exp) module A = struct include Printable.Option (Lvals) (struct let name = "no region" end) diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml index 79e32b5e4b..b594214518 100644 --- a/src/analyses/spec.ml +++ b/src/analyses/spec.ml @@ -182,7 +182,7 @@ struct let c_str = match SC.branch_exp c with Some (exp,tv) -> SC.exp_to_string exp | _ -> "" in let c_str = Str.global_replace (Str.regexp_string "$key") "%e:key" c_str in (* TODO what should be used to specify the key? *) (* TODO this somehow also prints the expression!? why?? *) - let c_exp = Formatcil.cExp c_str [("key", Fe (D.K.to_exp var))] in (* use Fl for Lval instead? *) + let c_exp = Formatcil.cExp c_str [("key", Fe (D.K.to_cil_exp var))] in (* use Fl for Lval instead? *) (* TODO encode key in exp somehow *) (* ignore(printf "BRANCH %a\n" d_plainexp c_exp); *) ctx.split new_m [Events.SplitBranch (c_exp, true)]; diff --git a/src/analyses/taintPartialContexts.ml b/src/analyses/taintPartialContexts.ml index 89504fcd20..17eddc6635 100644 --- a/src/analyses/taintPartialContexts.ml +++ b/src/analyses/taintPartialContexts.ml @@ -11,7 +11,7 @@ struct include Analyses.IdentitySpec let name () = "taintPartialContexts" - module D = SetDomain.ToppedSet (Lval.CilLval) (struct let topname = "All" end) + module D = SetDomain.ToppedSet (Lval.Exp) (struct let topname = "All" end) module C = Lattice.Unit let rec resolve (offs : offset) : Basetype.CilExp.t Offset.t = diff --git a/src/cdomains/lval.ml b/src/cdomains/lval.ml index fe785d6185..f8eef30136 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/lval.ml @@ -28,12 +28,3 @@ struct let to_cil ((v, o): t): lval = (Var v, Offset.Exp.to_cil o) let to_cil_exp lv = Lval (to_cil lv) end - - - -module CilLval = -struct - include Exp - - let to_exp = to_cil_exp (* TODO: remove *) -end diff --git a/src/cdomains/lvalMapDomain.ml b/src/cdomains/lvalMapDomain.ml index 7815833607..ddcda71def 100644 --- a/src/cdomains/lvalMapDomain.ml +++ b/src/cdomains/lvalMapDomain.ml @@ -13,7 +13,7 @@ exception Error module type S = sig include Lattice.S - type k = Lval.CilLval.t (* key *) + type k = Lval.Exp.t (* key *) type s (* state is defined by Impl *) type r (* record *) @@ -68,7 +68,7 @@ module Value (Impl: sig val string_of_state: s -> string end) : S with type s = Impl.s = struct - type k = Lval.CilLval.t [@@deriving eq, ord, hash] + type k = Lval.Exp.t [@@deriving eq, ord, hash] type s = Impl.s [@@deriving eq, ord, hash] module R = struct include Printable.StdLeaf @@ -76,7 +76,7 @@ struct let name () = "LValMapDomainValue" let pretty () {key; loc; state} = - Pretty.dprintf "{key=%a; loc=%a; state=%s}" Lval.CilLval.pretty key (Pretty.d_list ", " Node.pretty) loc (Impl.string_of_state state) + Pretty.dprintf "{key=%a; loc=%a; state=%s}" Lval.Exp.pretty key (Pretty.d_list ", " Node.pretty) loc (Impl.string_of_state state) include Printable.SimplePretty ( struct @@ -104,7 +104,7 @@ struct let get_alias (x,y) = (May.choose y).key (* Printing *) - let string_of_key k = Lval.CilLval.show k + let string_of_key k = Lval.Exp.show k let string_of_loc xs = String.concat ", " (List.map (CilType.Location.show % Node.location) xs) let string_of_record r = Impl.string_of_state r.state^" ("^string_of_loc r.loc^")" let string_of (x,y) = @@ -157,9 +157,9 @@ end module Domain (V: S) = struct - module K = Lval.CilLval + module K = Lval.Exp module V = V - module MD = MapDomain.MapBot (Lval.CilLval) (V) + module MD = MapDomain.MapBot (Lval.Exp) (V) include MD (* Map functions *) @@ -273,7 +273,7 @@ struct (* getting keys from Cil Lvals *) - let key_from_lval lval = match lval with (* TODO try to get a Lval.CilLval from Cil.Lval *) + let key_from_lval lval = match lval with (* TODO try to get a Lval.Exp from Cil.Lval *) | Var v1, o1 -> v1, Offset.Exp.of_cil o1 | Mem Lval(Var v1, o1), o2 -> v1, Offset.Exp.of_cil (addOffset o1 o2) (* | Mem exp, o1 -> failwith "not implemented yet" (* TODO use query_lv *) *) diff --git a/src/domains/valueDomainQueries.ml b/src/domains/valueDomainQueries.ml index c89e491e58..0a14dff599 100644 --- a/src/domains/valueDomainQueries.ml +++ b/src/domains/valueDomainQueries.ml @@ -3,7 +3,7 @@ open GoblintCil open BoolDomain -module LS = SetDomain.ToppedSet (Lval.CilLval) (struct let topname = "All" end) +module LS = SetDomain.ToppedSet (Lval.Exp) (struct let topname = "All" end) module ID = struct From 0715a5ab48f22910afe29287c64fcb1e25ea986c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 13:41:02 +0300 Subject: [PATCH 342/518] Rename Lval -> Mval --- src/analyses/apron/relationAnalysis.apron.ml | 8 ++++---- src/analyses/base.ml | 6 +++--- src/analyses/condVars.ml | 6 +++--- src/analyses/extractPthread.ml | 2 +- src/analyses/fileUse.ml | 2 +- src/analyses/region.ml | 4 ++-- src/analyses/symbLocks.ml | 2 +- src/analyses/taintPartialContexts.ml | 2 +- src/analyses/varEq.ml | 6 +++--- src/cdomains/addressDomain.ml | 2 +- src/cdomains/lvalMapDomain.ml | 14 +++++++------- src/cdomains/{lval.ml => mval.ml} | 3 ++- src/domains/valueDomainQueries.ml | 2 +- src/goblint_lib.ml | 2 +- 14 files changed, 31 insertions(+), 30 deletions(-) rename src/cdomains/{lval.ml => mval.ml} (76%) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index f55a150f89..7e03e7b98e 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -163,7 +163,7 @@ struct st | `Lifted s -> let lvals = Queries.LS.elements r in - let ass' = List.map (fun lv -> assign_to_global_wrapper ask getg sideg st (Lval.Exp.to_cil lv) f) lvals in + let ass' = List.map (fun lv -> assign_to_global_wrapper ask getg sideg st (Mval.Exp.to_cil lv) f) lvals in List.fold_right D.join ass' (D.bot ()) ) (* Ignoring all other assigns *) @@ -219,7 +219,7 @@ struct | Lval (Mem e, NoOffset) -> (match ask (Queries.MayPointTo e) with | a when not (Queries.LS.is_top a || Queries.LS.mem (dummyFunDec.svar, `NoOffset) a) && (Queries.LS.cardinal a) = 1 -> - Lval.Exp.to_cil_exp (Queries.LS.choose a) + Mval.Exp.to_cil_exp (Queries.LS.choose a) (* It would be possible to do better here, exploiting e.g. that the things pointed to are known to be equal *) (* see: https://github.com/goblint/analyzer/pull/742#discussion_r879099745 *) | _ -> Lval (Mem e, NoOffset)) @@ -453,7 +453,7 @@ struct |> List.map Cil.var | Some rs -> Queries.LS.elements rs - |> List.map Lval.Exp.to_cil + |> List.map Mval.Exp.to_cil in List.fold_left (fun st lval -> invalidate_one ask ctx st lval @@ -507,7 +507,7 @@ struct let s = ask.f (Queries.MayPointTo e) in match s with | `Top -> [] - | `Lifted _ -> List.map Lval.Exp.to_cil (Queries.LS.elements s) + | `Lifted _ -> List.map Mval.Exp.to_cil (Queries.LS.elements s) in let shallow_addrs = LibraryDesc.Accesses.find desc.accs { kind = Write; deep = false } args in let deep_addrs = LibraryDesc.Accesses.find desc.accs { kind = Write; deep = true } args in diff --git a/src/analyses/base.ml b/src/analyses/base.ml index d4ae2e831d..3504355c2f 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1325,7 +1325,7 @@ struct (* ignore @@ printf "EvalStr `Address: %a -> %s (must %i, may %i)\n" d_plainexp e (VD.short 80 (`Address a)) (List.length @@ AD.to_var_must a) (List.length @@ AD.to_var_may a); *) begin match unrollType (Cilfacade.typeOf e) with | TPtr(TInt(IChar, _), _) -> - let lval = Lval.Exp.to_cil @@ Q.LS.choose @@ addrToLvalSet a in + let lval = Mval.Exp.to_cil @@ Q.LS.choose @@ addrToLvalSet a in (try `Lifted (Bytes.to_string (Hashtbl.find char_array lval)) with Not_found -> Queries.Result.top q) | _ -> (* what about ISChar and IUChar? *) @@ -2364,10 +2364,10 @@ struct let ask = (Analyses.ask_of_ctx ctx) in Q.LS.fold (fun (v, o) st -> if CPA.mem v fun_st.cpa then - let lval = Lval.Exp.to_cil (v,o) in + let lval = Mval.Exp.to_cil (v,o) in let address = eval_lv ask ctx.global st lval in let lval_type = (AD.get_type address) in - if M.tracing then M.trace "taintPC" "updating %a; type: %a\n" Lval.Exp.pretty (v, o) d_type lval_type; + if M.tracing then M.trace "taintPC" "updating %a; type: %a\n" Mval.Exp.pretty (v, o) d_type lval_type; match (CPA.find_opt v (fun_st.cpa)), lval_type with | None, _ -> st (* partitioned arrays cannot be copied by individual lvalues, so if tainted just copy the whole callee value for the array variable *) diff --git a/src/analyses/condVars.ml b/src/analyses/condVars.ml index e2112ee384..5a2e97139c 100644 --- a/src/analyses/condVars.ml +++ b/src/analyses/condVars.ml @@ -7,7 +7,7 @@ open Analyses module Domain = struct module V = Queries.ES - include MapDomain.MapBot (Lval.Exp) (V) + include MapDomain.MapBot (Mval.Exp) (V) let rec var_in_lval p (lh,offs) = var_in_offs p offs && match lh with | Var v -> p v | Mem e -> var_in_expr p e @@ -75,7 +75,7 @@ struct Queries.LS.elements a' | _ -> [] - let mustPointTo ctx exp = (* this is just to get Lval.Exp *) + let mustPointTo ctx exp = (* this is just to get Mval.Exp *) match mayPointTo ctx exp with | [clval] -> Some clval | _ -> None @@ -108,7 +108,7 @@ struct let save_expr lval expr = match mustPointTo ctx (AddrOf lval) with | Some clval -> - if M.tracing then M.tracel "condvars" "CondVars: saving %a = %a\n" Lval.Exp.pretty clval d_exp expr; + if M.tracing then M.tracel "condvars" "CondVars: saving %a = %a\n" Mval.Exp.pretty clval d_exp expr; D.add clval (D.V.singleton expr) d (* if lval must point to clval, add expr *) | None -> d in diff --git a/src/analyses/extractPthread.ml b/src/analyses/extractPthread.ml index 91bb2f4589..2041c23e1b 100644 --- a/src/analyses/extractPthread.ml +++ b/src/analyses/extractPthread.ml @@ -1128,7 +1128,7 @@ module Spec : Analyses.MCPSpec = struct let ls = ctx.ask (Queries.ReachableFrom func) in Queries.LS.filter (fun lv -> - let lval = Lval.Exp.to_cil lv in + let lval = Mval.Exp.to_cil lv in isFunctionType (typeOfLval lval)) ls in diff --git a/src/analyses/fileUse.ml b/src/analyses/fileUse.ml index 84c813c902..174cd6a914 100644 --- a/src/analyses/fileUse.ml +++ b/src/analyses/fileUse.ml @@ -223,7 +223,7 @@ struct (* let m' = Option.map_default (fun v -> List.fold_left (fun m k -> D.add' k v m) m xs) m v in *) (* then check each key *) (* List.iter (fun k -> ignore(f k m')) xs; *) - (* get Lval.Exp from lval *) + (* get Mval.Exp from lval *) let k' = D.key_from_lval lval in (* add joined value for that key *) let m' = Option.map_default (fun v -> D.add' k' v m) m v in diff --git a/src/analyses/region.ml b/src/analyses/region.ml index c56e0b5513..966e22dc35 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -23,7 +23,7 @@ struct include StdV end - let regions exp part st : Lval.Exp.t list = + let regions exp part st : Mval.Exp.t list = match st with | `Lifted reg -> let ev = Reg.eval_exp exp in @@ -58,7 +58,7 @@ struct ls | _ -> Queries.Result.top q - module Lvals = SetDomain.Make (Lval.Exp) + module Lvals = SetDomain.Make (Mval.Exp) module A = struct include Printable.Option (Lvals) (struct let name = "no region" end) diff --git a/src/analyses/symbLocks.ml b/src/analyses/symbLocks.ml index 2f55185e9e..0c23d5a37b 100644 --- a/src/analyses/symbLocks.ml +++ b/src/analyses/symbLocks.ml @@ -184,7 +184,7 @@ struct (match ctx.ask (Queries.Regions e) with | ls when not (Queries.LS.is_top ls || Queries.LS.is_empty ls) -> let add_exp x xs = - try Queries.ES.add (Lval.Exp.to_cil_exp x) xs + try Queries.ES.add (Mval.Exp.to_cil_exp x) xs with Lattice.BotValue -> xs in begin try Queries.LS.fold add_exp ls (Queries.ES.singleton e) diff --git a/src/analyses/taintPartialContexts.ml b/src/analyses/taintPartialContexts.ml index 17eddc6635..2cbfe7d87a 100644 --- a/src/analyses/taintPartialContexts.ml +++ b/src/analyses/taintPartialContexts.ml @@ -11,7 +11,7 @@ struct include Analyses.IdentitySpec let name () = "taintPartialContexts" - module D = SetDomain.ToppedSet (Lval.Exp) (struct let topname = "All" end) + module D = SetDomain.ToppedSet (Mval.Exp) (struct let topname = "All" end) module C = Lattice.Unit let rec resolve (offs : offset) : Basetype.CilExp.t Offset.t = diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index b9671ac921..99307d5d37 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -369,7 +369,7 @@ struct | Lval rlval -> begin match ask (Queries.MayPointTo (mkAddrOf rlval)) with | rv when not (Queries.LS.is_top rv) && Queries.LS.cardinal rv = 1 -> - let rv = Lval.Exp.to_cil_exp (Queries.LS.choose rv) in + let rv = Mval.Exp.to_cil_exp (Queries.LS.choose rv) in if is_local lv && Exp.is_global_var rv = Some false then D.add_eq (rv,Lval lv) st else st @@ -437,7 +437,7 @@ struct if Queries.LS.is_top tainted || not (ctx.ask (Queries.MustBeSingleThreaded {since_start = true})) then D.top () else - let taint_exp = Queries.ES.of_list (List.map Lval.Exp.to_cil_exp (Queries.LS.elements tainted)) in + let taint_exp = Queries.ES.of_list (List.map Mval.Exp.to_cil_exp (Queries.LS.elements tainted)) in D.filter (fun exp -> not (Queries.ES.mem exp taint_exp)) ctx.local in let d = D.meet au d_local in @@ -458,7 +458,7 @@ struct each expression in st was checked for reachability from es/rs using very conservative but also unsound reachable_from. It is unknown, why that was necessary. *) Queries.LS.fold (fun lval st -> - remove ask (Lval.Exp.to_cil lval) st + remove ask (Mval.Exp.to_cil lval) st ) rs st let unknown_fn ctx lval f args = diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 30801bd98c..70b67da0fc 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -2,7 +2,7 @@ open GoblintCil open IntOps -open Lval +open Mval module M = Messages diff --git a/src/cdomains/lvalMapDomain.ml b/src/cdomains/lvalMapDomain.ml index ddcda71def..2e62645d28 100644 --- a/src/cdomains/lvalMapDomain.ml +++ b/src/cdomains/lvalMapDomain.ml @@ -13,7 +13,7 @@ exception Error module type S = sig include Lattice.S - type k = Lval.Exp.t (* key *) + type k = Mval.Exp.t (* key *) type s (* state is defined by Impl *) type r (* record *) @@ -68,7 +68,7 @@ module Value (Impl: sig val string_of_state: s -> string end) : S with type s = Impl.s = struct - type k = Lval.Exp.t [@@deriving eq, ord, hash] + type k = Mval.Exp.t [@@deriving eq, ord, hash] type s = Impl.s [@@deriving eq, ord, hash] module R = struct include Printable.StdLeaf @@ -76,7 +76,7 @@ struct let name () = "LValMapDomainValue" let pretty () {key; loc; state} = - Pretty.dprintf "{key=%a; loc=%a; state=%s}" Lval.Exp.pretty key (Pretty.d_list ", " Node.pretty) loc (Impl.string_of_state state) + Pretty.dprintf "{key=%a; loc=%a; state=%s}" Mval.Exp.pretty key (Pretty.d_list ", " Node.pretty) loc (Impl.string_of_state state) include Printable.SimplePretty ( struct @@ -104,7 +104,7 @@ struct let get_alias (x,y) = (May.choose y).key (* Printing *) - let string_of_key k = Lval.Exp.show k + let string_of_key k = Mval.Exp.show k let string_of_loc xs = String.concat ", " (List.map (CilType.Location.show % Node.location) xs) let string_of_record r = Impl.string_of_state r.state^" ("^string_of_loc r.loc^")" let string_of (x,y) = @@ -157,9 +157,9 @@ end module Domain (V: S) = struct - module K = Lval.Exp + module K = Mval.Exp module V = V - module MD = MapDomain.MapBot (Lval.Exp) (V) + module MD = MapDomain.MapBot (Mval.Exp) (V) include MD (* Map functions *) @@ -273,7 +273,7 @@ struct (* getting keys from Cil Lvals *) - let key_from_lval lval = match lval with (* TODO try to get a Lval.Exp from Cil.Lval *) + let key_from_lval lval = match lval with (* TODO try to get a Mval.Exp from Cil.Lval *) | Var v1, o1 -> v1, Offset.Exp.of_cil o1 | Mem Lval(Var v1, o1), o2 -> v1, Offset.Exp.of_cil (addOffset o1 o2) (* | Mem exp, o1 -> failwith "not implemented yet" (* TODO use query_lv *) *) diff --git a/src/cdomains/lval.ml b/src/cdomains/mval.ml similarity index 76% rename from src/cdomains/lval.ml rename to src/cdomains/mval.ml index f8eef30136..1eaed3938f 100644 --- a/src/cdomains/lval.ml +++ b/src/cdomains/mval.ml @@ -1,4 +1,5 @@ -(** Domains for lvalues. *) +(** Domains for mvalues: simplified lvalues, which start with a {!GoblintCil.varinfo}. + Mvalues are the result of resolving {{!GoblintCil.Mem} pointer dereferences} in lvalues. *) open GoblintCil open Pretty diff --git a/src/domains/valueDomainQueries.ml b/src/domains/valueDomainQueries.ml index 0a14dff599..d366e6dda3 100644 --- a/src/domains/valueDomainQueries.ml +++ b/src/domains/valueDomainQueries.ml @@ -3,7 +3,7 @@ open GoblintCil open BoolDomain -module LS = SetDomain.ToppedSet (Lval.Exp) (struct let topname = "All" end) +module LS = SetDomain.ToppedSet (Mval.Exp) (struct let topname = "All" end) module ID = struct diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 19fef9ed19..a3963fc6ef 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -229,7 +229,7 @@ module PthreadDomain = PthreadDomain (** {3 Other} *) module Basetype = Basetype -module Lval = Lval +module Mval = Mval module CilLval = CilLval module Access = Access module AccessDomain = AccessDomain From d9d528183ab4e9c919f0cc850e2e0ef77f0b5b6a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 13:48:25 +0300 Subject: [PATCH 343/518] Add Mval.Unit --- src/cdomains/mval.ml | 2 ++ src/domains/access.ml | 4 ++-- src/domains/queries.ml | 6 +++--- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 1eaed3938f..f455ae9429 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -22,6 +22,8 @@ struct ) end +module Unit = MakePrintable (Offset.Unit) + module Exp = struct include MakePrintable (Offset.Exp) diff --git a/src/domains/access.ml b/src/domains/access.ml index 24ddf67558..5846181413 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -126,7 +126,7 @@ let get_val_type e (vo: var_o) (oo: off_o) : acc_typ = end | exception (Cilfacade.TypeOfError _) -> get_type voidType e -let add_one side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv:(varinfo*offs) option) a: unit = +let add_one side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv:Mval.Unit.t option) a: unit = if is_ignorable lv then () else begin let loc = Option.get !Node.current_node in side ty lv (conf, kind, loc, e, a) @@ -149,7 +149,7 @@ let type_from_type_offset : acc_typ -> typ = function in unrollType (type_from_offs (TComp (s, []), o)) -let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (varinfo * offs) option) a: unit = +let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: Mval.Unit.t option) a: unit = let rec dist_fields ty = match unrollType ty with | TComp (ci,_) -> diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 0f9da9010b..544e236dcf 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -100,7 +100,7 @@ type _ t = | HeapVar: VI.t t | IsHeapVar: varinfo -> MayBool.t t (* TODO: is may or must? *) | IsMultiple: varinfo -> MustBool.t t (* Is no other copy of this local variable reachable via pointers? *) - | MutexType: varinfo * Offset.Unit.t -> MutexAttrDomain.t t + | MutexType: Mval.Unit.t -> MutexAttrDomain.t t | EvalThread: exp -> ConcDomain.ThreadSet.t t | EvalMutexAttr: exp -> MutexAttrDomain.t t | EvalJumpBuf: exp -> JmpBufDomain.JmpBufSet.t t @@ -341,7 +341,7 @@ struct | Any (Invariant i1), Any (Invariant i2) -> compare_invariant_context i1 i2 | Any (InvariantGlobal vi1), Any (InvariantGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) | Any (IterSysVars (vq1, vf1)), Any (IterSysVars (vq2, vf2)) -> VarQuery.compare vq1 vq2 (* not comparing fs *) - | Any (MutexType (v1,o1)), Any (MutexType (v2,o2)) -> [%ord: CilType.Varinfo.t * Offset.Unit.t] (v1,o1) (v2,o2) + | Any (MutexType m1), Any (MutexType m2) -> Mval.Unit.compare m1 m2 | Any (MustProtectedVars m1), Any (MustProtectedVars m2) -> compare_mustprotectedvars m1 m2 | Any (MayBeModifiedSinceSetjmp e1), Any (MayBeModifiedSinceSetjmp e2) -> JmpBufDomain.BufferEntry.compare e1 e2 | Any (MustBeSingleThreaded {since_start=s1;}), Any (MustBeSingleThreaded {since_start=s2;}) -> Stdlib.compare s1 s2 @@ -378,7 +378,7 @@ struct | Any (EvalJumpBuf e) -> CilType.Exp.hash e | Any (WarnGlobal vi) -> Hashtbl.hash vi | Any (Invariant i) -> hash_invariant_context i - | Any (MutexType (v,o)) -> [%hash: CilType.Varinfo.t * Offset.Unit.t] (v, o) + | Any (MutexType m) -> Mval.Unit.hash m | Any (InvariantGlobal vi) -> Hashtbl.hash vi | Any (MustProtectedVars m) -> hash_mustprotectedvars m | Any (MayBeModifiedSinceSetjmp e) -> JmpBufDomain.BufferEntry.hash e From b4443e792aa451d93bb0b8e1a19fbcef179738b4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 15:10:04 +0300 Subject: [PATCH 344/518] Generalize AddressDomain.PreNormal over Mval --- src/cdomains/addressDomain.ml | 19 ++++++------------- src/cdomains/mval.ml | 1 + 2 files changed, 7 insertions(+), 13 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 70b67da0fc..62846618e4 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -37,11 +37,11 @@ sig (** Finds the type of the address location. *) end -module PreNormal (Offset: Printable.S) = +module PreNormal (Mval: Printable.S) = struct include Printable.StdLeaf type t = - | Addr of CilType.Varinfo.t * Offset.t (** Pointer to offset of a variable. *) + | Addr of Mval.t (** Pointer to offset of a variable. *) | NullPtr (** NULL pointer. *) | UnknownPtr (** Unknown pointer. Could point to globals, heap and escaped variables. *) | StrPtr of string option (** String literal pointer. [StrPtr None] abstracts any string pointer *) @@ -55,14 +55,8 @@ struct hash x | _ -> hash x - let show_addr (x, o) = - if RichVarinfo.BiVarinfoMap.Collection.mem_varinfo x then - let description = RichVarinfo.BiVarinfoMap.Collection.describe_varinfo x in - "(" ^ x.vname ^ ", " ^ description ^ ")" ^ Offset.show o - else x.vname ^ Offset.show o - let show = function - | Addr (x, o)-> show_addr (x, o) + | Addr m -> Mval.show m | StrPtr (Some x) -> "\"" ^ x ^ "\"" | StrPtr None -> "(unknown string)" | UnknownPtr -> "?" @@ -81,7 +75,7 @@ struct type field = fieldinfo type idx = Idx.t module Offs = Offset.MakePrintable (Idx) - include PreNormal (Offs) + include PreNormal (Mval.MakePrintable (Offs)) let name () = "Normal Lvals" @@ -287,13 +281,12 @@ struct struct type elt = t - module AnyOffset = Printable.UnitConf (struct let name = "" end) - include PreNormal (AnyOffset) + include PreNormal (Basetype.Variables) let name () = "BaseAddrRepr.R" let of_elt (x: elt): t = match x with - | Addr (v, o) -> Addr (v, ()) + | Addr (v, o) -> Addr v | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) | NullPtr -> NullPtr diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index f455ae9429..8b942acd7a 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -9,6 +9,7 @@ module M = Messages module MakePrintable (Offs: Printable.S) = struct include Printable.StdLeaf + (* TODO: version with Basetype.Variables and RichVarinfo for AddressDomain *) type t = CilType.Varinfo.t * Offs.t [@@deriving eq, ord, hash] let name () = Format.sprintf "lval (%s)" (Offs.name ()) From 697437d02e759f1035af16cb222a6794325fea90 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 15:30:06 +0300 Subject: [PATCH 345/518] Generalize AddressDomain.Normal over Offset --- src/cdomains/addressDomain.ml | 20 ++++++++++++++------ src/cdomains/offset.ml | 1 + src/cdomains/symbLocksDomain.ml | 2 +- 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 62846618e4..30f2183c88 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -70,11 +70,19 @@ struct ) end -module Normal (Idx: Offset.Index.Printable) = +module type OffsS = +sig + type idx + include Printable.S with type t = idx Offset.t + val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] + val add_offset: t -> t -> t +end + +module Normal (Offs: OffsS) = struct type field = fieldinfo - type idx = Idx.t - module Offs = Offset.MakePrintable (Idx) + type idx = Offs.idx + (* module Offs = Offset.MakePrintable (Idx) *) include PreNormal (Mval.MakePrintable (Offs)) let name () = "Normal Lvals" @@ -158,7 +166,7 @@ struct let is_zero_offset x = Offs.cmp_zero_offset x = `MustZero (* TODO: seems to be unused *) - let to_exp (f:idx -> exp) x = + let to_exp (f:Offs.idx -> exp) x = (* TODO: Offset *) let rec to_cil c = match c with @@ -191,7 +199,7 @@ end - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) module NormalLat (Idx: Offset.Index.Lattice) = struct - include Normal (Idx) + include Normal (Offset.MakePrintable (Idx)) module Offs = Offset.MakeLattice (Idx) (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) @@ -308,7 +316,7 @@ struct (* Offset module for representative without abstract values for index offsets, i.e. with unit index offsets. Reason: The offset in the representative (used for buckets) should not depend on the integer domains, since different integer domains may be active at different program points. *) - include Normal (Offset.Index.Unit) + include Normal (Offset.Unit) let of_elt_offset: Idx.t Offset.t -> Offset.Unit.t = of_offs diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 6822e5064b..df06792396 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -71,6 +71,7 @@ end module MakePrintable (Idx: Index.Printable) = struct + type idx = Idx.t type t = Idx.t offs [@@deriving eq, ord, hash] include Printable.StdLeaf diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index 47ace795b7..1d20eb180a 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -305,7 +305,7 @@ struct let top () = Unknown end - include AddressDomain.Normal (Idx) + include AddressDomain.Normal (Offset.MakePrintable (Idx)) let rec conv_const_offset x = match x with From 50d58f0ad21c78d4e98983ed5e553cfe9537b256 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 15:45:33 +0300 Subject: [PATCH 346/518] Generalize AddressDomain.NormalLat over Offset --- src/cdomains/addressDomain.ml | 24 +++++++++++++++++++----- src/cdomains/preValueDomain.ml | 2 +- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 30f2183c88..e707a22d45 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -78,6 +78,20 @@ sig val add_offset: t -> t -> t end +module type OffsT = +sig + include OffsS + val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option + val is_definite: t -> bool + val leq: t -> t -> bool + val top_indices: t -> t + val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t + val remove_offset: t -> t + val to_cil: t -> offset + val of_exp: exp Offset.t -> t + val to_exp: t -> exp Offset.t +end + module Normal (Offs: OffsS) = struct type field = fieldinfo @@ -197,10 +211,10 @@ end - {!NullPtr} is a singleton sublattice. - {!UnknownPtr} is a singleton sublattice. - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) -module NormalLat (Idx: Offset.Index.Lattice) = +module NormalLat (Offs: OffsT) = struct - include Normal (Offset.MakePrintable (Idx)) - module Offs = Offset.MakeLattice (Idx) + include Normal (Offs) + module Offs = Offs (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) let semantic_equal x y = match x, y with @@ -283,7 +297,7 @@ end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) module BaseAddrRepr (Idx: Offset.Index.Lattice) = struct - include NormalLat (Idx) + include NormalLat (Offset.MakeLattice (Idx)) module R: DisjointDomain.Representative with type elt = t = struct @@ -305,7 +319,7 @@ end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) module NormalLatRepr (Idx: Offset.Index.Lattice) = struct - include NormalLat (Idx) + include NormalLat (Offset.MakeLattice (Idx)) (** Representatives for lvalue sublattices as defined by {!NormalLat}. *) module R: DisjointDomain.Representative with type elt = t = diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml index ff71da64ca..67d9078e75 100644 --- a/src/cdomains/preValueDomain.ml +++ b/src/cdomains/preValueDomain.ml @@ -2,4 +2,4 @@ module ID = IntDomain.IntDomTuple module FD = FloatDomain.FloatDomTupleImpl module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind) (* TODO: add ptrdiff cast into to_int? *) module AD = AddressDomain.AddressSet (IndexDomain) -module Addr = AddressDomain.NormalLat (IndexDomain) +module Addr = AddressDomain.NormalLat (Offset.MakeLattice (IndexDomain)) From 5352f7cedb37bce39ce9f2955fdd591dc6e30915 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 15:50:38 +0300 Subject: [PATCH 347/518] Generalize AddressDomain.AddrReprs over Offset --- src/cdomains/addressDomain.ml | 15 ++++++++------- src/cdomains/preValueDomain.ml | 2 +- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index e707a22d45..3b259f3e73 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -295,9 +295,9 @@ struct end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module BaseAddrRepr (Idx: Offset.Index.Lattice) = +module BaseAddrRepr (Offs: OffsT) = struct - include NormalLat (Offset.MakeLattice (Idx)) + include NormalLat (Offs) module R: DisjointDomain.Representative with type elt = t = struct @@ -317,9 +317,9 @@ struct end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module NormalLatRepr (Idx: Offset.Index.Lattice) = +module NormalLatRepr (Offs: OffsT) = struct - include NormalLat (Offset.MakeLattice (Idx)) + include NormalLat (Offs) (** Representatives for lvalue sublattices as defined by {!NormalLat}. *) module R: DisjointDomain.Representative with type elt = t = @@ -332,7 +332,7 @@ struct since different integer domains may be active at different program points. *) include Normal (Offset.Unit) - let of_elt_offset: Idx.t Offset.t -> Offset.Unit.t = of_offs + let of_elt_offset: Offs.idx Offset.t -> Offset.Unit.t = of_offs let of_elt (x: elt): t = match x with | Addr (v, o) -> Addr (v, of_elt_offset o) (* addrs grouped by var and part of offset *) @@ -360,8 +360,9 @@ end module AddressSet (Idx: IntDomain.Z) = struct - module BaseAddr = BaseAddrRepr (Idx) - module Addr = NormalLatRepr (Idx) + module Offs = Offset.MakeLattice (Idx) + module BaseAddr = BaseAddrRepr (Offs) + module Addr = NormalLatRepr (Offs) module J = (struct include SetDomain.Joined (Addr) let may_be_equal a b = Option.value (Addr.semantic_equal a b) ~default:true diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml index 67d9078e75..e9587df1b6 100644 --- a/src/cdomains/preValueDomain.ml +++ b/src/cdomains/preValueDomain.ml @@ -2,4 +2,4 @@ module ID = IntDomain.IntDomTuple module FD = FloatDomain.FloatDomTupleImpl module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind) (* TODO: add ptrdiff cast into to_int? *) module AD = AddressDomain.AddressSet (IndexDomain) -module Addr = AddressDomain.NormalLat (Offset.MakeLattice (IndexDomain)) +module Addr = AD.Addr From beb09912ab335469a58cbd48a3614051e88f30e2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 16:00:13 +0300 Subject: [PATCH 348/518] Remove unnecessary BaseAddrRepr wrapper --- src/cdomains/addressDomain.ml | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 3b259f3e73..66a1238b93 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -295,11 +295,11 @@ struct end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module BaseAddrRepr (Offs: OffsT) = +module NormalLatRepr (Offs: OffsT) = struct include NormalLat (Offs) - module R: DisjointDomain.Representative with type elt = t = + module R0: DisjointDomain.Representative with type elt = t = struct type elt = t @@ -314,12 +314,6 @@ struct | NullPtr -> NullPtr | UnknownPtr -> UnknownPtr end -end - -(** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module NormalLatRepr (Offs: OffsT) = -struct - include NormalLat (Offs) (** Representatives for lvalue sublattices as defined by {!NormalLat}. *) module R: DisjointDomain.Representative with type elt = t = @@ -361,7 +355,6 @@ end module AddressSet (Idx: IntDomain.Z) = struct module Offs = Offset.MakeLattice (Idx) - module BaseAddr = BaseAddrRepr (Offs) module Addr = NormalLatRepr (Offs) module J = (struct include SetDomain.Joined (Addr) @@ -372,7 +365,7 @@ struct (* module H = HoareDomain.SetEM (Addr) *) (* Hoare set for bucket doesn't play well with StrPtr limiting: https://github.com/goblint/analyzer/pull/808 *) - module AddressSet : SetDomain.S with type elt = Addr.t = DisjointDomain.ProjectiveSet (BaseAddr) (OffsetSplit) (BaseAddr.R) + module AddressSet : SetDomain.S with type elt = Addr.t = DisjointDomain.ProjectiveSet (Addr) (OffsetSplit) (Addr.R0) include AddressSet (* short-circuit with physical equality, From a6b0410b1517d769066e475beee17e722a1752ab Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 16:08:10 +0300 Subject: [PATCH 349/518] Move offset functions away from AddressDomain --- src/cdomains/addressDomain.ml | 24 ++++-------------------- src/cdomains/offset.ml | 20 ++++++++++++++++++++ src/cdomains/valueDomain.ml | 6 +++--- 3 files changed, 27 insertions(+), 23 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 66a1238b93..7bed40d81f 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -75,7 +75,10 @@ sig type idx include Printable.S with type t = idx Offset.t val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] + val is_zero_offset: t -> bool val add_offset: t -> t -> t + val type_offset: typ -> t -> typ + exception Type_offset of typ * string end module type OffsT = @@ -151,25 +154,7 @@ struct | Some x -> Some (String.length x) | _ -> None - (* exception if the offset can't be followed completely *) - exception Type_offset of typ * string - (* tries to follow o in t *) - let rec type_offset t o = match unrollType t, o with (* resolves TNamed *) - | t, `NoOffset -> t - | TArray (t,_,_), `Index (i,o) - | TPtr (t,_), `Index (i,o) -> type_offset t o - | TComp (ci,_), `Field (f,o) -> - let fi = try getCompField ci f.fname - with Not_found -> - let s = GobPretty.sprintf "Addr.type_offset: field %s not found in type %a" f.fname d_plaintype t in - raise (Type_offset (t, s)) - in type_offset fi.ftype o - | TComp _, `Index (_,o) -> type_offset t o (* this happens (hmmer, perlbench). safe? *) - | t,o -> - let s = GobPretty.sprintf "Addr.type_offset: could not follow offset in type. type: %a, offset: %a" d_plaintype t Offs.pretty o in - raise (Type_offset (t, s)) - - let get_type_addr (v,o) = try type_offset v.vtype o with Type_offset (t,_) -> t + let get_type_addr (v,o) = try Offs.type_offset v.vtype o with Offs.Type_offset (t,_) -> t let get_type = function | Addr (x, o) -> get_type_addr (x, o) @@ -177,7 +162,6 @@ struct | NullPtr -> voidType | UnknownPtr -> voidPtrType - let is_zero_offset x = Offs.cmp_zero_offset x = `MustZero (* TODO: seems to be unused *) let to_exp (f:Offs.idx -> exp) x = diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index df06792396..cf049d5644 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -91,6 +91,8 @@ struct | `Field (x, o) -> if is_first_field x then cmp_zero_offset o else `MustNonzero + let is_zero_offset x = cmp_zero_offset x = `MustZero + let rec show: t -> string = function | `NoOffset -> "" | `Index (x,o) -> "[" ^ (Idx.show x) ^ "]" ^ (show o) @@ -163,6 +165,24 @@ struct | `Index (i, o) -> `Index (g i, map_indices g o) let top_indices = map_indices (fun _ -> Idx.top ()) + + (* exception if the offset can't be followed completely *) + exception Type_offset of typ * string + (* tries to follow o in t *) + let rec type_offset t o = match unrollType t, o with (* resolves TNamed *) + | t, `NoOffset -> t + | TArray (t,_,_), `Index (i,o) + | TPtr (t,_), `Index (i,o) -> type_offset t o + | TComp (ci,_), `Field (f,o) -> + let fi = try getCompField ci f.fname + with Not_found -> + let s = GobPretty.sprintf "Addr.type_offset: field %s not found in type %a" f.fname d_plaintype t in + raise (Type_offset (t, s)) + in type_offset fi.ftype o + | TComp _, `Index (_,o) -> type_offset t o (* this happens (hmmer, perlbench). safe? *) + | t,o -> + let s = GobPretty.sprintf "Addr.type_offset: could not follow offset in type. type: %a, offset: %a" d_plaintype t pretty o in + raise (Type_offset (t, s)) end module MakeLattice (Idx: Index.Lattice) = diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 312c472494..e11e200973 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -348,7 +348,7 @@ struct | t -> t in let rec adjust_offs v o d = - let ta = try Addr.type_offset v.vtype o with Addr.Type_offset (t,s) -> raise (CastError s) in + let ta = try Addr.Offs.type_offset v.vtype o with Addr.Offs.Type_offset (t,s) -> raise (CastError s) in let info = GobPretty.sprintf "Ptr-Cast %a from %a to %a" Addr.pretty (Addr.Addr (v,o)) d_type ta d_type t in M.tracel "casta" "%s\n" info; let err s = raise (CastError (s ^ " (" ^ info ^ ")")) in @@ -361,7 +361,7 @@ struct M.tracel "casta" "cast to bigger size\n"; if d = Some false then err "Ptr-cast to type of incompatible size!" else if o = `NoOffset then err "Ptr-cast to outer type, but no offset to remove." - else if Addr.is_zero_offset o then adjust_offs v (Addr.Offs.remove_offset o) (Some true) + else if Addr.Offs.is_zero_offset o then adjust_offs v (Addr.Offs.remove_offset o) (Some true) else err "Ptr-cast to outer type, but possibly from non-zero offset." | _ -> (* cast to smaller/inner type *) M.tracel "casta" "cast to smaller size\n"; @@ -377,7 +377,7 @@ struct | TArray _, _ -> M.tracel "casta" "cast array to its first element\n"; adjust_offs v (Addr.Offs.add_offset o (`Index (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset))) (Some false) - | _ -> err @@ Format.sprintf "Cast to neither array index nor struct field. is_zero_offset: %b" (Addr.is_zero_offset o) + | _ -> err @@ Format.sprintf "Cast to neither array index nor struct field. is_zero_offset: %b" (Addr.Offs.is_zero_offset o) end in let one_addr = let open Addr in function From f81c6cce3afaa4ec0a322af17326501794bc5800 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 16:26:36 +0300 Subject: [PATCH 350/518] Abstract some Mval functions --- src/analyses/base.ml | 4 ++-- src/cdomains/addressDomain.ml | 23 +++++++---------------- src/cdomains/mval.ml | 25 ++++++++++++++++++------- 3 files changed, 27 insertions(+), 25 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 3504355c2f..4041669691 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -924,7 +924,7 @@ struct match a with | Addr (x, o) -> begin - let at = get_type_addr (x, o) in + let at = Addr.Mval.get_type_addr (x, o) in if M.tracing then M.tracel "evalint" "cast_ok %a %a %a\n" Addr.pretty (Addr (x, o)) CilType.Typ.pretty (Cil.unrollType x.vtype) CilType.Typ.pretty at; if at = TVoid [] then (* HACK: cast from alloc variable is always fine *) true @@ -932,7 +932,7 @@ struct match Cil.getInteger (sizeOf t), Cil.getInteger (sizeOf at) with | Some i1, Some i2 -> Z.compare i1 i2 <= 0 | _ -> - if contains_vla t || contains_vla (get_type_addr (x, o)) then + if contains_vla t || contains_vla (Addr.Mval.get_type_addr (x, o)) then begin (* TODO: Is this ok? *) M.info ~category:Unsound "Casting involving a VLA is assumed to work"; diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 7bed40d81f..4d5e69325b 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -79,6 +79,7 @@ sig val add_offset: t -> t -> t val type_offset: typ -> t -> typ exception Type_offset of typ * string + val to_cil: t -> offset end module type OffsT = @@ -100,7 +101,8 @@ struct type field = fieldinfo type idx = Offs.idx (* module Offs = Offset.MakePrintable (Idx) *) - include PreNormal (Mval.MakePrintable (Offs)) + module Mval = Mval.MakePrintable (Offs) + include PreNormal (Mval) let name () = "Normal Lvals" @@ -154,33 +156,22 @@ struct | Some x -> Some (String.length x) | _ -> None - let get_type_addr (v,o) = try Offs.type_offset v.vtype o with Offs.Type_offset (t,_) -> t - let get_type = function - | Addr (x, o) -> get_type_addr (x, o) + | Addr (x, o) -> Mval.get_type_addr (x, o) | StrPtr _ -> charPtrType (* TODO Cil.charConstPtrType? *) | NullPtr -> voidType | UnknownPtr -> voidPtrType - (* TODO: seems to be unused *) - let to_exp (f:Offs.idx -> exp) x = - (* TODO: Offset *) - let rec to_cil c = - match c with - | `NoOffset -> NoOffset - | `Field (fld, ofs) -> Field (fld , to_cil ofs) - | `Index (idx, ofs) -> Index (f idx, to_cil ofs) - in - match x with - | Addr (v,o) -> AddrOf (Var v, to_cil o) + let to_exp = function + | Addr m -> AddrOf (Mval.to_cil m) | StrPtr (Some x) -> mkString x | StrPtr None -> raise (Lattice.Unsupported "Cannot express unknown string pointer as expression.") | NullPtr -> integer 0 | UnknownPtr -> raise Lattice.TopValue (* TODO: unused *) let add_offset x o = match x with - | Addr (v, u) -> Addr (v, Offs.add_offset u o) + | Addr m -> Addr (Mval.add_offset m o) | x -> x let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 8b942acd7a..f1a4fd762d 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -6,7 +6,17 @@ open Pretty module M = Messages -module MakePrintable (Offs: Printable.S) = +module type OffsS = +sig + type idx + include Printable.S with type t = idx Offset.t + val add_offset: t -> t -> t + val type_offset: typ -> t -> typ + exception Type_offset of typ * string + val to_cil: t -> offset +end + +module MakePrintable (Offs: OffsS) = struct include Printable.StdLeaf (* TODO: version with Basetype.Variables and RichVarinfo for AddressDomain *) @@ -21,14 +31,15 @@ struct let show = show end ) -end -module Unit = MakePrintable (Offset.Unit) + let add_offset (v, o) o' = (v, Offs.add_offset o o') + + let get_type_addr (v,o) = try Offs.type_offset v.vtype o with Offs.Type_offset (t,_) -> t -module Exp = -struct - include MakePrintable (Offset.Exp) - let to_cil ((v, o): t): lval = (Var v, Offset.Exp.to_cil o) + let to_cil ((v, o): t): lval = (Var v, Offs.to_cil o) let to_cil_exp lv = Lval (to_cil lv) end + +module Unit = MakePrintable (Offset.Unit) +module Exp = MakePrintable (Offset.Exp) From 8b9560a61def5eddfa86732d40175a2bbcad5198 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 16:33:15 +0300 Subject: [PATCH 351/518] Generalize AddressDomain.Normal over Mval --- src/cdomains/addressDomain.ml | 22 +++++++++++++++++----- src/cdomains/mval.ml | 1 + src/cdomains/symbLocksDomain.ml | 2 +- 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 4d5e69325b..f55a8e7925 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -96,13 +96,23 @@ sig val to_exp: t -> exp Offset.t end -module Normal (Offs: OffsS) = +module type MvalS = +sig + type idx + include Printable.S with type t = varinfo * idx Offset.t + val get_type_addr: t -> typ + val add_offset: t -> idx Offset.t -> t + val to_cil: t -> lval +end + +module Normal (Mval: MvalS) = struct type field = fieldinfo - type idx = Offs.idx + type idx = Mval.idx (* module Offs = Offset.MakePrintable (Idx) *) - module Mval = Mval.MakePrintable (Offs) + (* module Mval = Mval.MakePrintable (Offs) *) include PreNormal (Mval) + module Mval = Mval let name () = "Normal Lvals" @@ -188,7 +198,7 @@ end - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) module NormalLat (Offs: OffsT) = struct - include Normal (Offs) + include Normal (Mval.MakePrintable (Offs)) module Offs = Offs (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) @@ -272,6 +282,8 @@ end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) module NormalLatRepr (Offs: OffsT) = struct + open struct module Mval0 = Mval end + include NormalLat (Offs) module R0: DisjointDomain.Representative with type elt = t = @@ -299,7 +311,7 @@ struct (* Offset module for representative without abstract values for index offsets, i.e. with unit index offsets. Reason: The offset in the representative (used for buckets) should not depend on the integer domains, since different integer domains may be active at different program points. *) - include Normal (Offset.Unit) + include Normal (Mval0.Unit) let of_elt_offset: Offs.idx Offset.t -> Offset.Unit.t = of_offs diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index f1a4fd762d..5992beec57 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -18,6 +18,7 @@ end module MakePrintable (Offs: OffsS) = struct + type idx = Offs.idx include Printable.StdLeaf (* TODO: version with Basetype.Variables and RichVarinfo for AddressDomain *) type t = CilType.Varinfo.t * Offs.t [@@deriving eq, ord, hash] diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index 1d20eb180a..8a79de8723 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -305,7 +305,7 @@ struct let top () = Unknown end - include AddressDomain.Normal (Offset.MakePrintable (Idx)) + include AddressDomain.Normal (Mval.MakePrintable (Offset.MakePrintable (Idx))) let rec conv_const_offset x = match x with From 4b11b50413d626d3c844186c4fe3af036e3bbec1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 16:44:42 +0300 Subject: [PATCH 352/518] Abstract some Mval functions --- src/cdomains/addressDomain.ml | 20 +++++++----------- src/cdomains/mval.ml | 39 +++++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+), 12 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index f55a8e7925..8d5071b686 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -198,18 +198,14 @@ end - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) module NormalLat (Offs: OffsT) = struct - include Normal (Mval.MakePrintable (Offs)) + open struct module Mval0 = Mval.MakeLattice (Offs) end + include Normal (Mval0) + module Mval = Mval0 module Offs = Offs (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) let semantic_equal x y = match x, y with - | Addr (x, xoffs), Addr (y, yoffs) -> - if CilType.Varinfo.equal x y then - let xtyp = x.vtype in - let ytyp = y.vtype in - Offs.semantic_equal ~xtyp ~xoffs ~ytyp ~yoffs - else - Some false + | Addr x, Addr y -> Mval.semantic_equal x y | StrPtr None, StrPtr _ | StrPtr _, StrPtr None -> Some true | StrPtr (Some a), StrPtr (Some b) -> if a = b then None else Some false @@ -223,17 +219,17 @@ struct let is_definite = function | NullPtr -> true - | Addr (v,o) when Offs.is_definite o -> true + | Addr m -> Mval.is_definite m | _ -> false let leq x y = match x, y with | StrPtr _, StrPtr None -> true | StrPtr a, StrPtr b -> a = b - | Addr (x,o), Addr (y,u) -> CilType.Varinfo.equal x y && Offs.leq o u + | Addr x, Addr y -> Mval.leq x y | _ -> x = y let drop_ints = function - | Addr (x, o) -> Addr (x, Offs.top_indices o) + | Addr x -> Addr (Mval.top_indices x) | x -> x let join_string_ptr x y = match x, y with @@ -266,7 +262,7 @@ struct |`Join | `Widen -> join_string_ptr a b |`Meet | `Narrow -> meet_string_ptr a b end - | Addr (x,o), Addr (y,u) when CilType.Varinfo.equal x y -> Addr (x, Offs.merge cop o u) + | Addr x, Addr y -> Addr (Mval.merge cop x y) | _ -> raise Lattice.Uncomparable let join = merge `Join diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 5992beec57..e4e4a40645 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -42,5 +42,44 @@ struct let to_cil_exp lv = Lval (to_cil lv) end +module type OffsT = +sig + include OffsS + val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option + val is_definite: t -> bool + val leq: t -> t -> bool + val top_indices: t -> t + val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t + val remove_offset: t -> t + val to_cil: t -> offset + val of_exp: exp Offset.t -> t + val to_exp: t -> exp Offset.t +end + +module MakeLattice (Offs: OffsT) = +struct + include MakePrintable (Offs) + + let semantic_equal (x, xoffs) (y, yoffs) = + if CilType.Varinfo.equal x y then + let xtyp = x.vtype in + let ytyp = y.vtype in + Offs.semantic_equal ~xtyp ~xoffs ~ytyp ~yoffs + else + Some false + + let is_definite (_, o) = Offs.is_definite o + + let leq (x,o) (y,u) = CilType.Varinfo.equal x y && Offs.leq o u + let top_indices (x, o) = (x, Offs.top_indices o) + let merge cop (x,o) (y,u) = + if CilType.Varinfo.equal x y then + (x, Offs.merge cop o u) + else + raise Lattice.Uncomparable +end + + + module Unit = MakePrintable (Offset.Unit) module Exp = MakePrintable (Offset.Exp) From f6b99715cddab0f6da758a676f61ebb43ed2ac20 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 16:53:00 +0300 Subject: [PATCH 353/518] Generalize AddressDomain.NormalLat over Mval --- src/cdomains/addressDomain.ml | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 8d5071b686..e27b1c6500 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -187,6 +187,16 @@ struct let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) end +module type MvalT = +sig + include MvalS + val semantic_equal: t -> t -> bool option + val is_definite: t -> bool + val leq: t -> t -> bool + val top_indices: t -> t + val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t +end + (** Lvalue lattice. Actually a disjoint union of lattices without top or bottom. @@ -196,12 +206,12 @@ end - {!NullPtr} is a singleton sublattice. - {!UnknownPtr} is a singleton sublattice. - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) -module NormalLat (Offs: OffsT) = +module NormalLat (Mval0: MvalT) = struct - open struct module Mval0 = Mval.MakeLattice (Offs) end + (* open struct module Mval0 = Mval.MakeLattice (Offs) end *) include Normal (Mval0) module Mval = Mval0 - module Offs = Offs + (* module Offs = Offs *) (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) let semantic_equal x y = match x, y with @@ -280,7 +290,8 @@ module NormalLatRepr (Offs: OffsT) = struct open struct module Mval0 = Mval end - include NormalLat (Offs) + include NormalLat (Mval.MakeLattice (Offs)) + module Offs = Offs module R0: DisjointDomain.Representative with type elt = t = struct @@ -309,10 +320,8 @@ struct since different integer domains may be active at different program points. *) include Normal (Mval0.Unit) - let of_elt_offset: Offs.idx Offset.t -> Offset.Unit.t = of_offs - let of_elt (x: elt): t = match x with - | Addr (v, o) -> Addr (v, of_elt_offset o) (* addrs grouped by var and part of offset *) + | Addr (v, o) -> Addr (v, of_offs o) (* addrs grouped by var and part of offset *) | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) | NullPtr -> NullPtr From 5adfee90d5df5643b9f6869d487b151011ec3869 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 16:55:38 +0300 Subject: [PATCH 354/518] Generalize AddressDomain.NormalLatRepr over Mval --- src/cdomains/addressDomain.ml | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index e27b1c6500..08cb063bb4 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -286,12 +286,12 @@ struct end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module NormalLatRepr (Offs: OffsT) = +module NormalLatRepr (Mval1: MvalT) = struct open struct module Mval0 = Mval end - include NormalLat (Mval.MakeLattice (Offs)) - module Offs = Offs + include NormalLat (Mval1) + (* module Offs = Offs *) module R0: DisjointDomain.Representative with type elt = t = struct @@ -347,7 +347,12 @@ end module AddressSet (Idx: IntDomain.Z) = struct module Offs = Offset.MakeLattice (Idx) - module Addr = NormalLatRepr (Offs) + module Mval = Mval.MakeLattice (Offs) + module Addr = + struct + include NormalLatRepr (Mval) + module Offs = Offs + end module J = (struct include SetDomain.Joined (Addr) let may_be_equal a b = Option.value (Addr.semantic_equal a b) ~default:true From f9fee826674735efc04f213a6be75b48a904193a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 17:16:42 +0300 Subject: [PATCH 355/518] Move prefix to Offset --- src/analyses/malloc_null.ml | 12 ++---------- src/analyses/uninit.ml | 16 ++++------------ src/cdomains/addressDomain.ml | 5 +++-- src/cdomains/musteqDomain.ml | 7 +------ src/cdomains/mval.ml | 6 ++++++ src/cdomains/offset.ml | 6 ++++++ 6 files changed, 22 insertions(+), 30 deletions(-) diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index 63728ef2e7..4e9fa98b44 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -19,18 +19,10 @@ struct (* Addr set functions: *) - let is_prefix_of (v1,ofs1: varinfo * Addr.idx Offset.t) (v2,ofs2: varinfo * Addr.idx Offset.t) : bool = - let rec is_offs_prefix_of pr os = - match (pr, os) with - | (`NoOffset, `NoOffset) -> true - | (`NoOffset, _) -> false - | (`Field (f1, o1), `Field (f2,o2)) -> f1 == f2 && is_offs_prefix_of o1 o2 - | (_, _) -> false - in - CilType.Varinfo.equal v1 v2 && is_offs_prefix_of ofs1 ofs2 + let is_prefix_of m1 m2 = Option.is_some (Addr.Mval.prefix m1 m2) (* We just had to dereference an lval --- warn if it was null *) - let warn_lval (st:D.t) (v :varinfo * Addr.idx Offset.t) : unit = + let warn_lval (st:D.t) (v :Addr.Mval.t) : unit = try if D.exists (fun x -> GobOption.exists (fun x -> is_prefix_of x v) (Addr.to_var_offset x)) st then diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 8a2d217bfd..4ca4b1fb1a 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -85,15 +85,7 @@ struct let vars a (rval:exp) : Addr.t list = List.map Addr.from_var_offset (varoffs a rval) - let is_prefix_of (v1,ofs1: varinfo * Addr.idx Offset.t) (v2,ofs2: varinfo * Addr.idx Offset.t) : bool = - let rec is_offs_prefix_of pr os = - match (pr, os) with - | (`NoOffset, _) -> true - | (`Field (f1, o1), `Field (f2,o2)) -> CilType.Fieldinfo.equal f1 f2 && is_offs_prefix_of o1 o2 - | (_, _) -> false - in - CilType.Varinfo.equal v1 v2 && is_offs_prefix_of ofs1 ofs2 - + let is_prefix_of m1 m2 = Option.is_some (Addr.Mval.prefix m1 m2) (* Does it contain non-initialized variables? *) let is_expr_initd a (expr:exp) (st:D.t) : bool = @@ -110,15 +102,15 @@ struct t in List.fold_left will_addr_init true raw_vars - let remove_if_prefix (pr: varinfo * Addr.idx Offset.t) (uis: D.t) : D.t = + let remove_if_prefix (pr: Addr.Mval.t) (uis: D.t) : D.t = let f ad = let vals = Addr.to_var_offset ad in GobOption.for_all (fun a -> not (is_prefix_of pr a)) vals in D.filter f uis - type lval_offs = Addr.idx Offset.t - type var_offs = varinfo * lval_offs + type lval_offs = Addr.Offs.t + type var_offs = Addr.Mval.t (* Call to [get_pfx v cx] returns initialized prefixes ... *) let rec get_pfx (v:varinfo) (cx:lval_offs) (ofs:lval_offs) (target:typ) (other:typ) : var_offs list = diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 08cb063bb4..69c1cbbd80 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -103,12 +103,13 @@ sig val get_type_addr: t -> typ val add_offset: t -> idx Offset.t -> t val to_cil: t -> lval + val prefix: t -> t -> idx Offset.t option end module Normal (Mval: MvalS) = struct type field = fieldinfo - type idx = Mval.idx + (* type idx = Mval.idx *) (* module Offs = Offset.MakePrintable (Idx) *) (* module Mval = Mval.MakePrintable (Offs) *) include PreNormal (Mval) @@ -386,7 +387,7 @@ struct r type field = Addr.field - type idx = Idx.t + (* type idx = Idx.t *) let null_ptr = singleton Addr.NullPtr let unknown_ptr = singleton Addr.UnknownPtr diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index bb58767519..bc9b595339 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -64,18 +64,13 @@ struct let pretty_diff () ((x:t),(y:t)): Pretty.doc = Pretty.dprintf "%a not leq %a" pretty x pretty y - let rec prefix x y = match x,y with - | `Index (x, xs), `Index (y, ys) when I.equal x y -> prefix xs ys - | `Field (x, xs), `Field (y, ys) when F.equal x y -> prefix xs ys - | `NoOffset, ys -> Some ys - | _ -> None - let rec occurs v fds = match fds with | `Field (x, xs) -> occurs v xs | `Index (x, xs) -> I.occurs v x || occurs v xs | `NoOffset -> false end +(* TODO: Mval *) module VF = struct include Printable.ProdSimple (V) (F) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index e4e4a40645..13bf6351e4 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -14,6 +14,7 @@ sig val type_offset: typ -> t -> typ exception Type_offset of typ * string val to_cil: t -> offset + val prefix: t -> t -> t option end module MakePrintable (Offs: OffsS) = @@ -37,6 +38,11 @@ struct let get_type_addr (v,o) = try Offs.type_offset v.vtype o with Offs.Type_offset (t,_) -> t + let prefix (v1,ofs1) (v2,ofs2) = + if CilType.Varinfo.equal v1 v2 then + Offs.prefix ofs1 ofs2 + else + None let to_cil ((v, o): t): lval = (Var v, Offs.to_cil o) let to_cil_exp lv = Lval (to_cil lv) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index cf049d5644..b177cc035c 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -183,6 +183,12 @@ struct | t,o -> let s = GobPretty.sprintf "Addr.type_offset: could not follow offset in type. type: %a, offset: %a" d_plaintype t pretty o in raise (Type_offset (t, s)) + + let rec prefix (x: t) (y: t): t option = match x,y with + | `Index (x, xs), `Index (y, ys) when Idx.equal x y -> prefix xs ys + | `Field (x, xs), `Field (y, ys) when CilType.Fieldinfo.equal x y -> prefix xs ys + | `NoOffset, ys -> Some ys + | _ -> None end module MakeLattice (Idx: Index.Lattice) = From 6d2fa97910bfc1a6aa63c07ee7a34135e3d890d0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 17:25:24 +0300 Subject: [PATCH 356/518] Use ID for string address operation results --- src/analyses/base.ml | 2 +- src/analyses/baseInvariant.ml | 2 +- src/cdomains/addressDomain.ml | 22 +++++++++++----------- src/cdomains/preValueDomain.ml | 2 +- src/cdomains/valueDomain.ml | 6 +++--- 5 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 4041669691..850e1cac67 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1030,7 +1030,7 @@ struct | Index (exp, ofs) -> match eval_rv a gs st exp with | `Int i -> `Index (iDtoIdx i, convert_offset a gs st ofs) - | `Address add -> `Index (AD.to_int (module IdxDom) add, convert_offset a gs st ofs) + | `Address add -> `Index (AD.to_int add, convert_offset a gs st ofs) | `Top -> `Index (IdxDom.top (), convert_offset a gs st ofs) | `Bot -> `Index (IdxDom.bot (), convert_offset a gs st ofs) | _ -> failwith "Index not an integer value" diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index 521a046fdd..137366b333 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -686,7 +686,7 @@ struct begin match c_typed with | `Int c -> let c' = match t with - | TPtr _ -> `Address (AD.of_int (module ID) c) + | TPtr _ -> `Address (AD.of_int c) | TInt (ik, _) | TEnum ({ekind = ik; _}, _) -> `Int (ID.cast_to ik c) | TFloat (fk, _) -> `Float (FD.of_int fk c) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 69c1cbbd80..03fedba830 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -345,7 +345,7 @@ sig val get_type: t -> typ end -module AddressSet (Idx: IntDomain.Z) = +module AddressSet (Idx: IntDomain.Z) (ID: IntDomain.Z) = struct module Offs = Offset.MakeLattice (Idx) module Mval = Mval.MakeLattice (Offs) @@ -401,7 +401,7 @@ struct let to_bool x = if is_null x then Some false else if is_not_null x then Some true else None let has_unknown x = mem Addr.UnknownPtr x - let of_int (type a) (module ID : IntDomain.Z with type t = a) i = + let of_int i = match ID.to_int i with | x when GobOption.exists BigIntOps.(equal (zero)) x -> null_ptr | x when GobOption.exists BigIntOps.(equal (one)) x -> not_null @@ -409,7 +409,7 @@ struct | Some (xs, _) when List.exists BigIntOps.(equal (zero)) xs -> not_null | _ -> top_ptr - let to_int (type a) (module ID : IntDomain.Z with type t = a) x = + let to_int x = let ik = Cilfacade.ptr_ikind () in if equal x null_ptr then ID.of_int ik Z.zero @@ -440,12 +440,12 @@ struct let to_string_length x = let transform elem = match Addr.to_string_length elem with - | Some x -> Idx.of_int !Cil.kindOfSizeOf (Z.of_int x) - | None -> Idx.top_of !Cil.kindOfSizeOf in + | Some x -> ID.of_int !Cil.kindOfSizeOf (Z.of_int x) + | None -> ID.top_of !Cil.kindOfSizeOf in (* maps any StrPtr to the length of its content, otherwise maps to top *) List.map transform (elements x) (* and returns the least upper bound of computed IntDomain values *) - |> List.fold_left Idx.join (Idx.bot_of !Cil.kindOfSizeOf) + |> List.fold_left ID.join (ID.bot_of !Cil.kindOfSizeOf) let substring_extraction haystack needle = (* map all StrPtr elements in input address sets to contained strings *) @@ -486,20 +486,20 @@ struct let compare s1 s2 = let res = String.compare s1 s2 in if res = 0 then - Idx.of_int IInt Z.zero + ID.of_int IInt Z.zero else if res > 0 then - Idx.starting IInt Z.one + ID.starting IInt Z.one else - Idx.ending IInt Z.minus_one in + ID.ending IInt Z.minus_one in (* if any of the input address sets contains an element that isn't a StrPtr, return top *) if List.mem None x' || List.mem None y' then - Idx.top_of IInt + ID.top_of IInt else (* else compare every string of x' with every string of y' and return the least upper bound *) BatList.cartesian_product x' y' |> List.map (fun (s1, s2) -> compare (Option.get s1) (Option.get s2)) - |> List.fold_left Idx.join (Idx.bot_of IInt) + |> List.fold_left ID.join (ID.bot_of IInt) let string_writing_defined dest = (* if the destination address set contains a StrPtr, writing to such a string literal is undefined behavior *) diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml index e9587df1b6..4da87f3ee1 100644 --- a/src/cdomains/preValueDomain.ml +++ b/src/cdomains/preValueDomain.ml @@ -1,5 +1,5 @@ module ID = IntDomain.IntDomTuple module FD = FloatDomain.FloatDomTupleImpl module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind) (* TODO: add ptrdiff cast into to_int? *) -module AD = AddressDomain.AddressSet (IndexDomain) +module AD = AddressDomain.AddressSet (IndexDomain) (ID) module Addr = AD.Addr diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index e11e200973..f7cbf714e9 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -423,7 +423,7 @@ struct | TInt (ik,_) -> `Int (ID.cast_to ?torg ik (match v with | `Int x -> x - | `Address x -> AD.to_int (module ID) x + | `Address x -> AD.to_int x | `Float x -> FD.to_int ik x (*| `Struct x when Structs.cardinal x > 0 -> let some = List.hd (Structs.keys x) in @@ -639,7 +639,7 @@ struct | (`Int x, `Int y) -> `Int (ID.meet x y) | (`Float x, `Float y) -> `Float (FD.meet x y) | (`Int _, `Address _) -> meet x (cast (TInt(Cilfacade.ptr_ikind (),[])) y) - | (`Address x, `Int y) -> `Address (AD.meet x (AD.of_int (module ID:IntDomain.Z with type t = ID.t) y)) + | (`Address x, `Int y) -> `Address (AD.meet x (AD.of_int y)) | (`Address x, `Address y) -> `Address (AD.meet x y) | (`Struct x, `Struct y) -> `Struct (Structs.meet x y) | (`Union x, `Union y) -> `Union (Unions.meet x y) @@ -664,7 +664,7 @@ struct | (`Int x, `Int y) -> `Int (ID.narrow x y) | (`Float x, `Float y) -> `Float (FD.narrow x y) | (`Int _, `Address _) -> narrow x (cast IntDomain.Size.top_typ y) - | (`Address x, `Int y) -> `Address (AD.narrow x (AD.of_int (module ID:IntDomain.Z with type t = ID.t) y)) + | (`Address x, `Int y) -> `Address (AD.narrow x (AD.of_int y)) | (`Address x, `Address y) -> `Address (AD.narrow x y) | (`Struct x, `Struct y) -> `Struct (Structs.narrow x y) | (`Union x, `Union y) -> `Union (Unions.narrow x y) From b9711d7972eab64e30b8f4a2e9427197ac570dbc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 17:29:13 +0300 Subject: [PATCH 357/518] Generalize AddressDomain.AddressSet over Offset --- src/cdomains/addressDomain.ml | 5 +++-- src/cdomains/preValueDomain.ml | 3 ++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 03fedba830..a66e30c1c0 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -94,6 +94,7 @@ sig val to_cil: t -> offset val of_exp: exp Offset.t -> t val to_exp: t -> exp Offset.t + val prefix: t -> t -> t option end module type MvalS = @@ -345,9 +346,9 @@ sig val get_type: t -> typ end -module AddressSet (Idx: IntDomain.Z) (ID: IntDomain.Z) = +module AddressSet (Offs: OffsT) (ID: IntDomain.Z) = struct - module Offs = Offset.MakeLattice (Idx) + (* module Offs = Offset.MakeLattice (Idx) *) module Mval = Mval.MakeLattice (Offs) module Addr = struct diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml index 4da87f3ee1..b15b49d0e2 100644 --- a/src/cdomains/preValueDomain.ml +++ b/src/cdomains/preValueDomain.ml @@ -1,5 +1,6 @@ module ID = IntDomain.IntDomTuple module FD = FloatDomain.FloatDomTupleImpl module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind) (* TODO: add ptrdiff cast into to_int? *) -module AD = AddressDomain.AddressSet (IndexDomain) (ID) +module Offs = Offset.MakeLattice (IndexDomain) +module AD = AddressDomain.AddressSet (Offs) (ID) module Addr = AD.Addr From bfcd7b4b42de64d620cc66c019d3c876b9b64870 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 17:37:01 +0300 Subject: [PATCH 358/518] Generalize AddressDomain.AddressSet over Mval --- src/cdomains/addressDomain.ml | 9 +++++---- src/cdomains/mval.ml | 2 ++ src/cdomains/preValueDomain.ml | 3 ++- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index a66e30c1c0..51c65e0525 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -74,7 +74,7 @@ module type OffsS = sig type idx include Printable.S with type t = idx Offset.t - val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] + (* val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] *) val is_zero_offset: t -> bool val add_offset: t -> t -> t val type_offset: typ -> t -> typ @@ -192,6 +192,7 @@ end module type MvalT = sig include MvalS + module Offs: OffsT val semantic_equal: t -> t -> bool option val is_definite: t -> bool val leq: t -> t -> bool @@ -346,14 +347,14 @@ sig val get_type: t -> typ end -module AddressSet (Offs: OffsT) (ID: IntDomain.Z) = +module AddressSet (Mval: MvalT) (ID: IntDomain.Z) = struct (* module Offs = Offset.MakeLattice (Idx) *) - module Mval = Mval.MakeLattice (Offs) + (* module Mval = Mval.MakeLattice (Offs) *) module Addr = struct + module Offs = Mval.Offs include NormalLatRepr (Mval) - module Offs = Offs end module J = (struct include SetDomain.Joined (Addr) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 13bf6351e4..5c75916bb6 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -15,6 +15,7 @@ sig exception Type_offset of typ * string val to_cil: t -> offset val prefix: t -> t -> t option + val is_zero_offset: t -> bool end module MakePrintable (Offs: OffsS) = @@ -65,6 +66,7 @@ end module MakeLattice (Offs: OffsT) = struct include MakePrintable (Offs) + module Offs = Offs let semantic_equal (x, xoffs) (y, yoffs) = if CilType.Varinfo.equal x y then diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml index b15b49d0e2..669109ee1e 100644 --- a/src/cdomains/preValueDomain.ml +++ b/src/cdomains/preValueDomain.ml @@ -2,5 +2,6 @@ module ID = IntDomain.IntDomTuple module FD = FloatDomain.FloatDomTupleImpl module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIkind) (* TODO: add ptrdiff cast into to_int? *) module Offs = Offset.MakeLattice (IndexDomain) -module AD = AddressDomain.AddressSet (Offs) (ID) +module Mval = Mval.MakeLattice (Offs) +module AD = AddressDomain.AddressSet (Mval) (ID) module Addr = AD.Addr From 108ea3adb34d266d38216cbb86efbf6935dbf25c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 17:58:18 +0300 Subject: [PATCH 359/518] Add Offset and Mval signatures --- src/cdomains/addressDomain.ml | 56 +++-------------------------------- src/cdomains/mval.ml | 46 ++++++++++++++-------------- src/cdomains/offset.ml | 38 ++++++++++++++++++++++-- 3 files changed, 62 insertions(+), 78 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 51c65e0525..952e1f1f56 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -70,44 +70,7 @@ struct ) end -module type OffsS = -sig - type idx - include Printable.S with type t = idx Offset.t - (* val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] *) - val is_zero_offset: t -> bool - val add_offset: t -> t -> t - val type_offset: typ -> t -> typ - exception Type_offset of typ * string - val to_cil: t -> offset -end - -module type OffsT = -sig - include OffsS - val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option - val is_definite: t -> bool - val leq: t -> t -> bool - val top_indices: t -> t - val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t - val remove_offset: t -> t - val to_cil: t -> offset - val of_exp: exp Offset.t -> t - val to_exp: t -> exp Offset.t - val prefix: t -> t -> t option -end - -module type MvalS = -sig - type idx - include Printable.S with type t = varinfo * idx Offset.t - val get_type_addr: t -> typ - val add_offset: t -> idx Offset.t -> t - val to_cil: t -> lval - val prefix: t -> t -> idx Offset.t option -end - -module Normal (Mval: MvalS) = +module Normal (Mval: Mval.Printable) = struct type field = fieldinfo (* type idx = Mval.idx *) @@ -189,17 +152,6 @@ struct let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) end -module type MvalT = -sig - include MvalS - module Offs: OffsT - val semantic_equal: t -> t -> bool option - val is_definite: t -> bool - val leq: t -> t -> bool - val top_indices: t -> t - val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t -end - (** Lvalue lattice. Actually a disjoint union of lattices without top or bottom. @@ -209,7 +161,7 @@ end - {!NullPtr} is a singleton sublattice. - {!UnknownPtr} is a singleton sublattice. - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) -module NormalLat (Mval0: MvalT) = +module NormalLat (Mval0: Mval.Lattice) = struct (* open struct module Mval0 = Mval.MakeLattice (Offs) end *) include Normal (Mval0) @@ -289,7 +241,7 @@ struct end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module NormalLatRepr (Mval1: MvalT) = +module NormalLatRepr (Mval1: Mval.Lattice) = struct open struct module Mval0 = Mval end @@ -347,7 +299,7 @@ sig val get_type: t -> typ end -module AddressSet (Mval: MvalT) (ID: IntDomain.Z) = +module AddressSet (Mval: Mval.Lattice) (ID: IntDomain.Z) = struct (* module Offs = Offset.MakeLattice (Idx) *) (* module Mval = Mval.MakeLattice (Offs) *) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 5c75916bb6..f54e800ed2 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -6,19 +6,31 @@ open Pretty module M = Messages -module type OffsS = +module type Printable = sig type idx - include Printable.S with type t = idx Offset.t - val add_offset: t -> t -> t - val type_offset: typ -> t -> typ - exception Type_offset of typ * string - val to_cil: t -> offset - val prefix: t -> t -> t option - val is_zero_offset: t -> bool + type t = varinfo * idx Offset.t + include Printable.S with type t := t + include MapDomain.Groupable with type t := t + val get_type_addr: t -> typ + val add_offset: t -> idx Offset.t -> t + val to_cil: t -> lval + val to_cil_exp: t -> exp + val prefix: t -> t -> idx Offset.t option end -module MakePrintable (Offs: OffsS) = +module type Lattice = +sig + include Printable + module Offs: Offset.Lattice with type idx = idx + val semantic_equal: t -> t -> bool option + val is_definite: t -> bool + val leq: t -> t -> bool + val top_indices: t -> t + val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t +end + +module MakePrintable (Offs: Offset.Printable): Printable with type idx = Offs.idx = struct type idx = Offs.idx include Printable.StdLeaf @@ -49,21 +61,7 @@ struct let to_cil_exp lv = Lval (to_cil lv) end -module type OffsT = -sig - include OffsS - val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option - val is_definite: t -> bool - val leq: t -> t -> bool - val top_indices: t -> t - val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t - val remove_offset: t -> t - val to_cil: t -> offset - val of_exp: exp Offset.t -> t - val to_exp: t -> exp Offset.t -end - -module MakeLattice (Offs: OffsT) = +module MakeLattice (Offs: Offset.Lattice): Lattice with type idx = Offs.idx = struct include MakePrintable (Offs) module Offs = Offs diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index b177cc035c..d9e473e0fa 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -69,7 +69,41 @@ struct end end -module MakePrintable (Idx: Index.Printable) = +module type Printable = +sig + type idx + include Printable.S with type t = idx offs + val add_offset: t -> t -> t + val type_offset: typ -> t -> typ + exception Type_offset of typ * string + val to_cil: t -> offset + val prefix: t -> t -> t option + val is_zero_offset: t -> bool + val map_indices: (idx -> idx) -> t -> t + val is_definite: t -> bool + val remove_offset: t -> t + val to_exp: t -> exp offs + val top_indices: t -> t + val contains_index: t -> bool + val to_cil_offset: t -> offset +end + +module type Lattice = +sig + include Printable + val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option + val is_definite: t -> bool + val leq: t -> t -> bool + val top_indices: t -> t + val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t + val remove_offset: t -> t + val to_cil: t -> offset + val of_exp: exp offs -> t + val to_exp: t -> exp offs + val prefix: t -> t -> t option +end + +module MakePrintable (Idx: Index.Printable): Printable with type idx = Idx.t = struct type idx = Idx.t type t = Idx.t offs [@@deriving eq, ord, hash] @@ -191,7 +225,7 @@ struct | _ -> None end -module MakeLattice (Idx: Index.Lattice) = +module MakeLattice (Idx: Index.Lattice): Lattice with type idx = Idx.t = struct include MakePrintable (Idx) From 833a0973df31c19074448cc1f71cbeb9a9a8c4e8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 18:02:13 +0300 Subject: [PATCH 360/518] Extend Offset and Mval Lattices to actual Lattice.S --- src/cdomains/mval.ml | 11 +++++++++++ src/cdomains/offset.ml | 6 ++++++ 2 files changed, 17 insertions(+) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index f54e800ed2..3eb850dd1d 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -22,6 +22,7 @@ end module type Lattice = sig include Printable + include Lattice.S with type t := t module Offs: Offset.Lattice with type idx = idx val semantic_equal: t -> t -> bool option val is_definite: t -> bool @@ -83,6 +84,16 @@ struct (x, Offs.merge cop o u) else raise Lattice.Uncomparable + + let join x y = merge `Join x y + let meet x y = merge `Meet x y + let widen x y = merge `Widen x y + let narrow x y = merge `Narrow x y + + include Lattice.NoBotTop + + let pretty_diff () (x,y) = + Pretty.dprintf "%s: %a not equal %a" (name ()) pretty x pretty y end diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index d9e473e0fa..86a56c2ebe 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -91,6 +91,7 @@ end module type Lattice = sig include Printable + include Lattice.S with type t := t val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option val is_definite: t -> bool val leq: t -> t -> bool @@ -289,6 +290,11 @@ struct let y_index = offset_to_index_offset ytyp yoffs in if M.tracing then M.tracel "addr" "xoffs=%a xtyp=%a xindex=%a yoffs=%a ytyp=%a yindex=%a\n" pretty xoffs d_plaintype xtyp Idx.pretty x_index pretty yoffs d_plaintype ytyp Idx.pretty y_index; Idx.to_bool (Idx.eq x_index y_index) + + include Lattice.NoBotTop + + let pretty_diff () (x,y) = + Pretty.dprintf "%s: %a not equal %a" (name ()) pretty x pretty y end module Unit = From 60c4fe2f76c845ecaa075897b9d5f211aace2c54 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 18:07:08 +0300 Subject: [PATCH 361/518] Remove merge from Offset and Mval --- src/cdomains/addressDomain.ml | 19 +++++++------------ src/cdomains/mval.ml | 13 ++++++------- src/cdomains/offset.ml | 1 - 3 files changed, 13 insertions(+), 20 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 952e1f1f56..026f6407f2 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -217,23 +217,18 @@ struct else raise Lattice.Uncomparable - let merge cop x y = + let merge mop sop x y = match x, y with | UnknownPtr, UnknownPtr -> UnknownPtr | NullPtr , NullPtr -> NullPtr - | StrPtr a, StrPtr b -> - StrPtr - begin match cop with - |`Join | `Widen -> join_string_ptr a b - |`Meet | `Narrow -> meet_string_ptr a b - end - | Addr x, Addr y -> Addr (Mval.merge cop x y) + | StrPtr a, StrPtr b -> StrPtr (sop a b) + | Addr x, Addr y -> Addr (mop x y) | _ -> raise Lattice.Uncomparable - let join = merge `Join - let widen = merge `Widen - let meet = merge `Meet - let narrow = merge `Narrow + let join = merge Mval.join join_string_ptr + let widen = merge Mval.widen join_string_ptr + let meet = merge Mval.meet meet_string_ptr + let narrow = merge Mval.narrow meet_string_ptr include Lattice.NoBotTop diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 3eb850dd1d..4c68ee978e 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -28,7 +28,6 @@ sig val is_definite: t -> bool val leq: t -> t -> bool val top_indices: t -> t - val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t end module MakePrintable (Offs: Offset.Printable): Printable with type idx = Offs.idx = @@ -79,16 +78,16 @@ struct let leq (x,o) (y,u) = CilType.Varinfo.equal x y && Offs.leq o u let top_indices (x, o) = (x, Offs.top_indices o) - let merge cop (x,o) (y,u) = + let merge op (x,o) (y,u) = if CilType.Varinfo.equal x y then - (x, Offs.merge cop o u) + (x, op o u) else raise Lattice.Uncomparable - let join x y = merge `Join x y - let meet x y = merge `Meet x y - let widen x y = merge `Widen x y - let narrow x y = merge `Narrow x y + let join = merge Offs.join + let meet = merge Offs.meet + let widen = merge Offs.widen + let narrow = merge Offs.narrow include Lattice.NoBotTop diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 86a56c2ebe..347080abc4 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -96,7 +96,6 @@ sig val is_definite: t -> bool val leq: t -> t -> bool val top_indices: t -> t - val merge: [`Join | `Widen | `Meet | `Narrow] -> t -> t -> t val remove_offset: t -> t val to_cil: t -> offset val of_exp: exp offs -> t From 5bd945c949ab38324d043cf948eb1448aabb3ff8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 18:14:49 +0300 Subject: [PATCH 362/518] Pull some address definitions up --- src/cdomains/addressDomain.ml | 69 ++++++++++++++++++----------------- src/cdomains/mval.ml | 5 ++- 2 files changed, 38 insertions(+), 36 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 026f6407f2..12bec4aa9c 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -68,6 +68,36 @@ struct let show = show end ) + + (* strings *) + let from_string x = StrPtr (Some x) + let to_string = function + | StrPtr (Some x) -> Some x + | _ -> None + (* only keep part before first null byte *) + let to_c_string = function + | StrPtr (Some x) -> + begin match String.split_on_char '\x00' x with + | s::_ -> Some s + | [] -> None + end + | _ -> None + let to_n_c_string n x = + match to_c_string x with + | Some x -> + if n > String.length x then + Some x + else if n < 0 then + None + else + Some (String.sub x 0 n) + | _ -> None + let to_string_length x = + match to_c_string x with + | Some x -> Some (String.length x) + | _ -> None + + let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) end module Normal (Mval: Mval.Printable) = @@ -103,34 +133,6 @@ struct | Addr (x, o) -> Some (x, o) | _ -> None - (* strings *) - let from_string x = StrPtr (Some x) - let to_string = function - | StrPtr (Some x) -> Some x - | _ -> None - (* only keep part before first null byte *) - let to_c_string = function - | StrPtr (Some x) -> - begin match String.split_on_char '\x00' x with - | s::_ -> Some s - | [] -> None - end - | _ -> None - let to_n_c_string n x = - match to_c_string x with - | Some x -> - if n > String.length x then - Some x - else if n < 0 then - None - else - Some (String.sub x 0 n) - | _ -> None - let to_string_length x = - match to_c_string x with - | Some x -> Some (String.length x) - | _ -> None - let get_type = function | Addr (x, o) -> Mval.get_type_addr (x, o) | StrPtr _ -> charPtrType (* TODO Cil.charConstPtrType? *) @@ -149,7 +151,11 @@ struct | Addr m -> Addr (Mval.add_offset m o) | x -> x - let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) + + let is_definite = function + | NullPtr -> true + | Addr m -> Mval.is_definite m + | _ -> false end (** Lvalue lattice. @@ -182,11 +188,6 @@ struct | StrPtr _, UnknownPtr -> None | _, _ -> Some false - let is_definite = function - | NullPtr -> true - | Addr m -> Mval.is_definite m - | _ -> false - let leq x y = match x, y with | StrPtr _, StrPtr None -> true | StrPtr a, StrPtr b -> a = b diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 4c68ee978e..cacb08d411 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -17,6 +17,7 @@ sig val to_cil: t -> lval val to_cil_exp: t -> exp val prefix: t -> t -> idx Offset.t option + val is_definite: t -> bool end module type Lattice = @@ -25,7 +26,6 @@ sig include Lattice.S with type t := t module Offs: Offset.Lattice with type idx = idx val semantic_equal: t -> t -> bool option - val is_definite: t -> bool val leq: t -> t -> bool val top_indices: t -> t end @@ -59,6 +59,8 @@ struct let to_cil ((v, o): t): lval = (Var v, Offs.to_cil o) let to_cil_exp lv = Lval (to_cil lv) + + let is_definite (_, o) = Offs.is_definite o end module MakeLattice (Offs: Offset.Lattice): Lattice with type idx = Offs.idx = @@ -74,7 +76,6 @@ struct else Some false - let is_definite (_, o) = Offs.is_definite o let leq (x,o) (y,u) = CilType.Varinfo.equal x y && Offs.leq o u let top_indices (x, o) = (x, Offs.top_indices o) From 168be2aac49454f458f8620ba2e0533cc4d82a3f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 1 Jun 2023 18:17:41 +0300 Subject: [PATCH 363/518] Simplify Offset and Mval signatures --- src/cdomains/mval.ml | 5 ++--- src/cdomains/offset.ml | 7 ------- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index cacb08d411..16975c165d 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -18,6 +18,7 @@ sig val to_cil_exp: t -> exp val prefix: t -> t -> idx Offset.t option val is_definite: t -> bool + val top_indices: t -> t end module type Lattice = @@ -26,8 +27,6 @@ sig include Lattice.S with type t := t module Offs: Offset.Lattice with type idx = idx val semantic_equal: t -> t -> bool option - val leq: t -> t -> bool - val top_indices: t -> t end module MakePrintable (Offs: Offset.Printable): Printable with type idx = Offs.idx = @@ -61,6 +60,7 @@ struct let to_cil_exp lv = Lval (to_cil lv) let is_definite (_, o) = Offs.is_definite o + let top_indices (x, o) = (x, Offs.top_indices o) end module MakeLattice (Offs: Offset.Lattice): Lattice with type idx = Offs.idx = @@ -78,7 +78,6 @@ struct let leq (x,o) (y,u) = CilType.Varinfo.equal x y && Offs.leq o u - let top_indices (x, o) = (x, Offs.top_indices o) let merge op (x,o) (y,u) = if CilType.Varinfo.equal x y then (x, op o u) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 347080abc4..de7ad0e89a 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -93,14 +93,7 @@ sig include Printable include Lattice.S with type t := t val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option - val is_definite: t -> bool - val leq: t -> t -> bool - val top_indices: t -> t - val remove_offset: t -> t - val to_cil: t -> offset val of_exp: exp offs -> t - val to_exp: t -> exp offs - val prefix: t -> t -> t option end module MakePrintable (Idx: Index.Printable): Printable with type idx = Idx.t = From 89139b21e19ef9f40f214f21ca74be8342013625 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 10:43:40 +0300 Subject: [PATCH 364/518] Fix LvalTest compilation --- src/cdomains/offset.ml | 3 +++ src/goblint_lib.ml | 1 + unittest/cdomains/lvalTest.ml | 5 +++-- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index de7ad0e89a..cffd616efe 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -86,6 +86,8 @@ sig val top_indices: t -> t val contains_index: t -> bool val to_cil_offset: t -> offset + val is_first_field: fieldinfo -> bool + val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] end module type Lattice = @@ -94,6 +96,7 @@ sig include Lattice.S with type t := t val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option val of_exp: exp offs -> t + val offset_to_index_offset: typ -> t -> idx end module MakePrintable (Idx: Index.Printable): Printable with type idx = Idx.t = diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index a3963fc6ef..837a047e03 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -229,6 +229,7 @@ module PthreadDomain = PthreadDomain (** {3 Other} *) module Basetype = Basetype +module Offset = Offset module Mval = Mval module CilLval = CilLval module Access = Access diff --git a/unittest/cdomains/lvalTest.ml b/unittest/cdomains/lvalTest.ml index f0a7532a08..37393312b4 100644 --- a/unittest/cdomains/lvalTest.ml +++ b/unittest/cdomains/lvalTest.ml @@ -3,7 +3,8 @@ open OUnit2 open GoblintCil module ID = IntDomain.IntDomWithDefaultIkind (IntDomain.IntDomLifter (IntDomain.DefExc)) (IntDomain.PtrDiffIkind) -module LV = Lval.NormalLat (ID) +module Offs = Offset.MakeLattice (ID) +module LV = AddressDomain.NormalLat (Mval.MakeLattice (Offs)) let ikind = IntDomain.PtrDiffIkind.ikind () @@ -33,7 +34,7 @@ let test_join_0 _ = let test_leq_not_0 _ = assert_leq a_lv_1 a_lv_not_0; OUnit.assert_equal ~printer:[%show: [`Eq | `Neq | `Top]] `Neq (ID.equal_to Z.zero i_not_0); - OUnit.assert_equal ~printer:[%show: [`MustZero | `MustNonzero | `MayZero]] `MustNonzero (LV.Offs.cmp_zero_offset (`Index (i_not_0, `NoOffset))); + OUnit.assert_equal ~printer:[%show: [`MustZero | `MustNonzero | `MayZero]] `MustNonzero (Offs.cmp_zero_offset (`Index (i_not_0, `NoOffset))); assert_not_leq a_lv a_lv_not_0; assert_not_leq a_lv_0 a_lv_not_0 From 18d137ff6f9196348c95d985d5c33395e80decb0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 11:26:33 +0300 Subject: [PATCH 365/518] Add Offset module signature --- src/cdomains/offset.ml | 57 +----------------- src/cdomains/offset.mli | 3 + src/cdomains/offset_intf.ml | 111 ++++++++++++++++++++++++++++++++++++ 3 files changed, 116 insertions(+), 55 deletions(-) create mode 100644 src/cdomains/offset.mli create mode 100644 src/cdomains/offset_intf.ml diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index cffd616efe..4e0d8c9567 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -1,42 +1,17 @@ -(** Domains for offsets. *) +include Offset_intf open GoblintCil module M = Messages - -(** Special index expression for some unknown index. - Weakly updates array in assignment. - Used for exp.fast_global_inits. *) let any_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") -(** Special index expression for all indices. - Strongly updates array in assignment. - Used for Goblint-specific witness invariants. *) let all_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") -type 'i t = [ - | `NoOffset - | `Field of CilType.Fieldinfo.t * 'i t - | `Index of 'i * 'i t -] [@@deriving eq, ord, hash] - -type 'i offs = 'i t [@@deriving eq, ord, hash] module Index = struct - - (** Subinterface of IntDomain.Z which is sufficient for Printable (but not Lattice) Offset. *) - module type Printable = - sig - include Printable.S - val equal_to: IntOps.BigIntOps.t -> t -> [`Eq | `Neq | `Top] - val to_int: t -> IntOps.BigIntOps.t option - val top: unit -> t - end - - module type Lattice = IntDomain.Z - + include Index module Unit: Printable with type t = unit = struct @@ -69,35 +44,7 @@ struct end end -module type Printable = -sig - type idx - include Printable.S with type t = idx offs - val add_offset: t -> t -> t - val type_offset: typ -> t -> typ - exception Type_offset of typ * string - val to_cil: t -> offset - val prefix: t -> t -> t option - val is_zero_offset: t -> bool - val map_indices: (idx -> idx) -> t -> t - val is_definite: t -> bool - val remove_offset: t -> t - val to_exp: t -> exp offs - val top_indices: t -> t - val contains_index: t -> bool - val to_cil_offset: t -> offset - val is_first_field: fieldinfo -> bool - val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] -end -module type Lattice = -sig - include Printable - include Lattice.S with type t := t - val semantic_equal: xtyp:typ -> xoffs:t -> ytyp:typ -> yoffs:t -> bool option - val of_exp: exp offs -> t - val offset_to_index_offset: typ -> t -> idx -end module MakePrintable (Idx: Index.Printable): Printable with type idx = Idx.t = struct diff --git a/src/cdomains/offset.mli b/src/cdomains/offset.mli new file mode 100644 index 0000000000..ae78921c9d --- /dev/null +++ b/src/cdomains/offset.mli @@ -0,0 +1,3 @@ +(** Domains for offsets. *) + +include Offset_intf.Offset (** @inline *) diff --git a/src/cdomains/offset_intf.ml b/src/cdomains/offset_intf.ml new file mode 100644 index 0000000000..83c178694c --- /dev/null +++ b/src/cdomains/offset_intf.ml @@ -0,0 +1,111 @@ +type 'i t = [ + | `NoOffset + | `Field of CilType.Fieldinfo.t * 'i t + | `Index of 'i * 'i t +] [@@deriving eq, ord, hash] + +(* TODO: remove? *) +type 'i offs = 'i t [@@deriving eq, ord, hash] + +module Index = +struct + + (** Subinterface of {!IntDomain.Z} which is sufficient for Printable (but not Lattice) Offset. *) + module type Printable = + sig + include Printable.S (** @closed *) + val top: unit -> t + + val equal_to: Z.t -> t -> [`Eq | `Neq | `Top] + val to_int: t -> Z.t option + end + + module type Lattice = IntDomain.Z +end + +module type Printable = +sig + type idx + include Printable.S with type t = idx offs (** @closed *) + + val is_definite: t -> bool + val contains_index: t -> bool + val add_offset: t -> t -> t + val remove_offset: t -> t + val prefix: t -> t -> t option + val map_indices: (idx -> idx) -> t -> t + val top_indices: t -> t + + val to_cil: t -> GoblintCil.offset + val to_exp: t -> GoblintCil.exp offs + + val to_cil_offset: t -> GoblintCil.offset + (** Version of {!to_cil} which drops indices for {!ArrayDomain}. *) + + val is_first_field: GoblintCil.fieldinfo -> bool + val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] + val is_zero_offset: t -> bool + + exception Type_offset of GoblintCil.typ * string + val type_offset: GoblintCil.typ -> t -> GoblintCil.typ +end + +module type Lattice = +sig + include Printable (** @closed *) + include Lattice.S with type t := t (** @closed *) + + val of_exp: GoblintCil.exp offs -> t + + val offset_to_index_offset: GoblintCil.typ -> t -> idx + val semantic_equal: xtyp:GoblintCil.typ -> xoffs:t -> ytyp:GoblintCil.typ -> yoffs:t -> bool option +end + +module type Offset = +sig + type nonrec 'i t = 'i t [@@deriving eq, ord, hash] + + (** Domains for offset indices. *) + module Index: + sig + include module type of Index + + module Unit: Printable with type t = unit + (** Unit index. + Usually represents an arbitrary index. *) + + module Exp: Printable with type t = GoblintCil.exp + end + + module type Printable = Printable + module type Lattice = Lattice + + module MakePrintable (Idx: Index.Printable): Printable with type idx = Idx.t + module MakeLattice (Idx: Index.Lattice): Lattice with type idx = Idx.t + + (** Offset instantiated with {!Index.Unit}. *) + module Unit: + sig + include Printable with type idx = unit + val of_offs : 'i offs -> t + val of_cil : GoblintCil.offset -> t + end + + (** Offset instantiated with {!Index.Exp}. *) + module Exp: + sig + include Printable with type idx = GoblintCil.exp + val of_cil : GoblintCil.offset -> t + val to_cil : t -> GoblintCil.offset + end + + (** Special index expression for some unknown index. + Weakly updates array in assignment. + Used for exp.fast_global_inits. *) + val any_index_exp: GoblintCil.exp + + (** Special index expression for all indices. + Strongly updates array in assignment. + Used for Goblint-specific witness invariants. *) + val all_index_exp: GoblintCil.exp +end From e1d2a640289db1978719fe418dd1650217c4e520 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 2 Jun 2023 10:33:15 +0200 Subject: [PATCH 366/518] Fix strange indentation --- src/analyses/baseInvariant.ml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index b75853bb0d..ab22c84637 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -552,7 +552,7 @@ struct (* trying to improve variables in an expression so it is bottom means dead code *) if VD.is_bot_value c_typed then contra st else match exp, c_typed with - | UnOp (LNot, e, _), Int c -> + | UnOp (LNot, e, _), Int c -> let ikind = Cilfacade.get_ikind_exp e in let c' = match ID.to_bool (unop_ID LNot c) with @@ -564,12 +564,12 @@ struct | _ -> ID.top_of ikind in inv_exp (Int c') e st - | UnOp (Neg, e, _), Float c -> inv_exp (Float (unop_FD Neg c)) e st - | UnOp ((BNot|Neg) as op, e, _), Int c -> inv_exp (Int (unop_ID op c)) e st + | UnOp (Neg, e, _), Float c -> inv_exp (Float (unop_FD Neg c)) e st + | UnOp ((BNot|Neg) as op, e, _), Int c -> inv_exp (Int (unop_ID op c)) e st (* no equivalent for Float, as VD.is_safe_cast fails for all float types anyways *) - | BinOp((Eq | Ne) as op, CastE (t1, e1), CastE (t2, e2), t), Int c when typeSig (Cilfacade.typeOf e1) = typeSig (Cilfacade.typeOf e2) && VD.is_safe_cast t1 (Cilfacade.typeOf e1) && VD.is_safe_cast t2 (Cilfacade.typeOf e2) -> - inv_exp (Int c) (BinOp (op, e1, e2, t)) st - | BinOp (LOr, arg1, arg2, typ) as exp, Int c -> + | BinOp((Eq | Ne) as op, CastE (t1, e1), CastE (t2, e2), t), Int c when typeSig (Cilfacade.typeOf e1) = typeSig (Cilfacade.typeOf e2) && VD.is_safe_cast t1 (Cilfacade.typeOf e1) && VD.is_safe_cast t2 (Cilfacade.typeOf e2) -> + inv_exp (Int c) (BinOp (op, e1, e2, t)) st + | BinOp (LOr, arg1, arg2, typ) as exp, Int c -> (* copied & modified from eval_rv_base... *) let (let*) = Option.bind in (* split nested LOr Eqs to equality pairs, if possible *) @@ -651,8 +651,8 @@ struct | None -> st (* TODO: not bothering to fall back, no other case can refine LOr anyway *) end - | (BinOp (op, e1, e2, _) as e, Float _) - | (BinOp (op, e1, e2, _) as e, Int _) -> + | (BinOp (op, e1, e2, _) as e, Float _) + | (BinOp (op, e1, e2, _) as e, Int _) -> let invert_binary_op c pretty c_int c_float = if M.tracing then M.tracel "inv" "binop %a with %a %a %a == %a\n" d_exp e VD.pretty (eval e1 st) d_binop op VD.pretty (eval e2 st) pretty c; (match eval e1 st, eval e2 st with @@ -680,7 +680,7 @@ struct | Int c -> invert_binary_op c ID.pretty (fun ik -> ID.cast_to ik c) (fun fk -> FD.of_int fk c) | Float c -> invert_binary_op c FD.pretty (fun ik -> FD.to_int ik c) (fun fk -> FD.cast_to fk c) | _ -> failwith "unreachable") - | Lval x, (Int _ | Float _ | Address _) -> (* meet x with c *) + | Lval x, (Int _ | Float _ | Address _) -> (* meet x with c *) let update_lval c x c' pretty = refine_lv ctx a gs st c x c' pretty exp in let t = Cil.unrollType (Cilfacade.typeOfLval x) in (* unroll type to deal with TNamed *) begin match c_typed with From b28872a1e6b00d090d0b17aefeb136c34df9d28b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 11:35:09 +0300 Subject: [PATCH 367/518] Add Mval module signature --- src/cdomains/mval.ml | 27 +------------------------ src/cdomains/mval.mli | 4 ++++ src/cdomains/mval_intf.ml | 42 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 47 insertions(+), 26 deletions(-) create mode 100644 src/cdomains/mval.mli create mode 100644 src/cdomains/mval_intf.ml diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 16975c165d..a0fb8e98c4 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -1,33 +1,10 @@ -(** Domains for mvalues: simplified lvalues, which start with a {!GoblintCil.varinfo}. - Mvalues are the result of resolving {{!GoblintCil.Mem} pointer dereferences} in lvalues. *) +include Mval_intf open GoblintCil open Pretty module M = Messages -module type Printable = -sig - type idx - type t = varinfo * idx Offset.t - include Printable.S with type t := t - include MapDomain.Groupable with type t := t - val get_type_addr: t -> typ - val add_offset: t -> idx Offset.t -> t - val to_cil: t -> lval - val to_cil_exp: t -> exp - val prefix: t -> t -> idx Offset.t option - val is_definite: t -> bool - val top_indices: t -> t -end - -module type Lattice = -sig - include Printable - include Lattice.S with type t := t - module Offs: Offset.Lattice with type idx = idx - val semantic_equal: t -> t -> bool option -end module MakePrintable (Offs: Offset.Printable): Printable with type idx = Offs.idx = struct @@ -95,7 +72,5 @@ struct Pretty.dprintf "%s: %a not equal %a" (name ()) pretty x pretty y end - - module Unit = MakePrintable (Offset.Unit) module Exp = MakePrintable (Offset.Exp) diff --git a/src/cdomains/mval.mli b/src/cdomains/mval.mli new file mode 100644 index 0000000000..caffecbd4a --- /dev/null +++ b/src/cdomains/mval.mli @@ -0,0 +1,4 @@ +(** Domains for mvalues: simplified lvalues, which start with a {!GoblintCil.varinfo}. + Mvalues are the result of resolving {{!GoblintCil.Mem} pointer dereferences} in lvalues. *) + +include Mval_intf.Mval (** @inline *) diff --git a/src/cdomains/mval_intf.ml b/src/cdomains/mval_intf.ml new file mode 100644 index 0000000000..256a29f107 --- /dev/null +++ b/src/cdomains/mval_intf.ml @@ -0,0 +1,42 @@ +module type Printable = +sig + type idx + type t = GoblintCil.varinfo * idx Offset.t + include Printable.S with type t := t (** @closed *) + include MapDomain.Groupable with type t := t (** @closed *) + + val is_definite: t -> bool + val add_offset: t -> idx Offset.t -> t + val prefix: t -> t -> idx Offset.t option + val top_indices: t -> t + + val to_cil: t -> GoblintCil.lval + val to_cil_exp: t -> GoblintCil.exp + + val get_type_addr: t -> GoblintCil.typ +end + +module type Lattice = +sig + include Printable (** @closed *) + include Lattice.S with type t := t (** @closed *) + + module Offs: Offset.Lattice with type idx = idx (* TODO: remove *) + + val semantic_equal: t -> t -> bool option +end + +module type Mval = +sig + module type Printable = Printable + module type Lattice = Lattice + + module MakePrintable (Offs: Offset.Printable): Printable with type idx = Offs.idx + module MakeLattice (Offs: Offset.Lattice): Lattice with type idx = Offs.idx + + (** Mval instantiated with {!Offset.Unit}. *) + module Unit: Printable with type idx = unit + + (** Mval instantiated with {!Offset.Unit}. *) + module Exp: Printable with type idx = GoblintCil.exp +end From e0331f4a643753fa49370186d14f65c246aa992e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 11:38:03 +0300 Subject: [PATCH 368/518] Fix offset and mval warnings --- src/cdomains/addressDomain.ml | 1 - src/cdomains/lockDomain.ml | 2 +- src/cdomains/mval.ml | 1 - src/cdomains/offset.ml | 5 ----- 4 files changed, 1 insertion(+), 8 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 12bec4aa9c..6a7dce65eb 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -2,7 +2,6 @@ open GoblintCil open IntOps -open Mval module M = Messages diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index f52fda9528..0e5eb7dd35 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -44,7 +44,7 @@ struct include SetDomain.Reverse(SetDomain.ToppedSet (Lock) (struct let topname = "All mutexes" end)) - let rec may_be_same_offset of1 of2 = + let may_be_same_offset of1 of2 = (* Only reached with definite of2 and indefinite of1. *) (* TODO: Currently useless, because MayPointTo query doesn't return index offset ranges, so not enough information to ever return false. *) (* TODO: Use Addr.Offs.semantic_equal. *) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index a0fb8e98c4..4e8005ae9b 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -1,7 +1,6 @@ include Mval_intf open GoblintCil -open Pretty module M = Messages diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 4e0d8c9567..ae1aa6f352 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -82,11 +82,6 @@ struct end ) - let pretty_diff () (x,y) = - Pretty.dprintf "%s: %a not leq %a" (name ()) pretty x pretty y - - let name () = "Offset" - let rec is_definite: t -> bool = function | `NoOffset -> true | `Field (f,o) -> is_definite o From 9be1c90c69a819634dea2e2b0b44dab6179077e3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 11:44:33 +0300 Subject: [PATCH 369/518] Rename Normal -> Address in AddressDomain --- src/cdomains/addressDomain.ml | 24 ++++++++++++------------ src/cdomains/symbLocksDomain.ml | 2 +- unittest/cdomains/lvalTest.ml | 2 +- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 6a7dce65eb..1df3a97eca 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -5,7 +5,7 @@ open IntOps module M = Messages -module type SAddr = +module type AddressS = sig type field type idx @@ -36,7 +36,7 @@ sig (** Finds the type of the address location. *) end -module PreNormal (Mval: Printable.S) = +module AddressBase (Mval: Printable.S) = struct include Printable.StdLeaf type t = @@ -99,13 +99,13 @@ struct let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) end -module Normal (Mval: Mval.Printable) = +module AddressPrintable (Mval: Mval.Printable) = struct type field = fieldinfo (* type idx = Mval.idx *) (* module Offs = Offset.MakePrintable (Idx) *) (* module Mval = Mval.MakePrintable (Offs) *) - include PreNormal (Mval) + include AddressBase (Mval) module Mval = Mval let name () = "Normal Lvals" @@ -166,10 +166,10 @@ end - {!NullPtr} is a singleton sublattice. - {!UnknownPtr} is a singleton sublattice. - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) -module NormalLat (Mval0: Mval.Lattice) = +module AddressLattice (Mval0: Mval.Lattice) = struct (* open struct module Mval0 = Mval.MakeLattice (Offs) end *) - include Normal (Mval0) + include AddressPrintable (Mval0) module Mval = Mval0 (* module Offs = Offs *) @@ -236,18 +236,18 @@ struct end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) -module NormalLatRepr (Mval1: Mval.Lattice) = +module AddressLatticeRepr (Mval1: Mval.Lattice) = struct open struct module Mval0 = Mval end - include NormalLat (Mval1) + include AddressLattice (Mval1) (* module Offs = Offs *) module R0: DisjointDomain.Representative with type elt = t = struct type elt = t - include PreNormal (Basetype.Variables) + include AddressBase (Basetype.Variables) let name () = "BaseAddrRepr.R" @@ -259,7 +259,7 @@ struct | UnknownPtr -> UnknownPtr end - (** Representatives for lvalue sublattices as defined by {!NormalLat}. *) + (** Representatives for lvalue sublattices as defined by {!AddressLattice}. *) module R: DisjointDomain.Representative with type elt = t = struct type elt = t @@ -268,7 +268,7 @@ struct (* Offset module for representative without abstract values for index offsets, i.e. with unit index offsets. Reason: The offset in the representative (used for buckets) should not depend on the integer domains, since different integer domains may be active at different program points. *) - include Normal (Mval0.Unit) + include AddressPrintable (Mval0.Unit) let of_elt (x: elt): t = match x with | Addr (v, o) -> Addr (v, of_offs o) (* addrs grouped by var and part of offset *) @@ -301,7 +301,7 @@ struct module Addr = struct module Offs = Mval.Offs - include NormalLatRepr (Mval) + include AddressLatticeRepr (Mval) end module J = (struct include SetDomain.Joined (Addr) diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index 8a79de8723..71aa6cc4ca 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -305,7 +305,7 @@ struct let top () = Unknown end - include AddressDomain.Normal (Mval.MakePrintable (Offset.MakePrintable (Idx))) + include AddressDomain.AddressPrintable (Mval.MakePrintable (Offset.MakePrintable (Idx))) let rec conv_const_offset x = match x with diff --git a/unittest/cdomains/lvalTest.ml b/unittest/cdomains/lvalTest.ml index 37393312b4..04e3a6e32f 100644 --- a/unittest/cdomains/lvalTest.ml +++ b/unittest/cdomains/lvalTest.ml @@ -4,7 +4,7 @@ open GoblintCil module ID = IntDomain.IntDomWithDefaultIkind (IntDomain.IntDomLifter (IntDomain.DefExc)) (IntDomain.PtrDiffIkind) module Offs = Offset.MakeLattice (ID) -module LV = AddressDomain.NormalLat (Mval.MakeLattice (Offs)) +module LV = AddressDomain.AddressLattice (Mval.MakeLattice (Offs)) let ikind = IntDomain.PtrDiffIkind.ikind () From 89b463032c2f24587c27b9702d4f9cdb400eb3bb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 12:35:04 +0300 Subject: [PATCH 370/518] Add AddressDomain module signature --- src/cdomains/addressDomain.ml | 69 ++-------------- src/cdomains/addressDomain.mli | 3 + src/cdomains/addressDomain_intf.ml | 122 +++++++++++++++++++++++++++++ src/cdomains/preValueDomain.ml | 7 +- 4 files changed, 138 insertions(+), 63 deletions(-) create mode 100644 src/cdomains/addressDomain.mli create mode 100644 src/cdomains/addressDomain_intf.ml diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 1df3a97eca..c055ec3338 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -1,51 +1,23 @@ -(** Domains for addresses/pointers. *) +include AddressDomain_intf open GoblintCil open IntOps module M = Messages -module type AddressS = -sig - type field - type idx - include Printable.S - - val null_ptr: unit -> t - val str_ptr: unit -> t - val is_null: t -> bool - val get_location: t -> location - - val from_var: varinfo -> t - (** Creates an address from variable. *) - - val from_var_offset: (varinfo * idx Offset.t) -> t - (** Creates an address from a variable and offset. *) - - val to_var_offset: t -> (varinfo * idx Offset.t) list - (** Get the offset *) - - val to_var: t -> varinfo list - (** Strips the varinfo out of the address representation. *) - - val to_var_may: t -> varinfo list - val to_var_must: t -> varinfo list - (** Strips the varinfo out of the address representation. *) - - val get_type: t -> typ - (** Finds the type of the address location. *) -end module AddressBase (Mval: Printable.S) = struct include Printable.StdLeaf type t = - | Addr of Mval.t (** Pointer to offset of a variable. *) - | NullPtr (** NULL pointer. *) - | UnknownPtr (** Unknown pointer. Could point to globals, heap and escaped variables. *) - | StrPtr of string option (** String literal pointer. [StrPtr None] abstracts any string pointer *) + | Addr of Mval.t + | NullPtr + | UnknownPtr + | StrPtr of string option [@@deriving eq, ord, hash] (* TODO: StrPtr equal problematic if the same literal appears more than once *) + let name () = "address" + let hash x = match x with | StrPtr _ -> if GobConfig.get_bool "ana.base.limit-string-addresses" then @@ -157,15 +129,6 @@ struct | _ -> false end -(** Lvalue lattice. - - Actually a disjoint union of lattices without top or bottom. - Lvalues are grouped as follows: - - - Each {!Addr}, modulo precise index expressions in offset, is a sublattice with ordering induced by {!Offset}. - - {!NullPtr} is a singleton sublattice. - - {!UnknownPtr} is a singleton sublattice. - - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) module AddressLattice (Mval0: Mval.Lattice) = struct (* open struct module Mval0 = Mval.MakeLattice (Offs) end *) @@ -173,7 +136,6 @@ struct module Mval = Mval0 (* module Offs = Offs *) - (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) let semantic_equal x y = match x, y with | Addr x, Addr y -> Mval.semantic_equal x y | StrPtr None, StrPtr _ @@ -235,7 +197,6 @@ struct let pretty_diff () (x,y) = Pretty.dprintf "%s: %a not leq %a" (name ()) pretty x pretty y end -(** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) module AddressLatticeRepr (Mval1: Mval.Lattice) = struct open struct module Mval0 = Mval end @@ -259,7 +220,6 @@ struct | UnknownPtr -> UnknownPtr end - (** Representatives for lvalue sublattices as defined by {!AddressLattice}. *) module R: DisjointDomain.Representative with type elt = t = struct type elt = t @@ -279,21 +239,6 @@ struct end end - -module type S = -sig - include Lattice.S - type idx - type field - - val from_var: varinfo -> t - val from_var_offset: (varinfo * idx Offset.t) -> t - val to_var_offset: t -> (varinfo * idx Offset.t) list - val to_var_may: t -> varinfo list - val to_var_must: t -> varinfo list - val get_type: t -> typ -end - module AddressSet (Mval: Mval.Lattice) (ID: IntDomain.Z) = struct (* module Offs = Offset.MakeLattice (Idx) *) diff --git a/src/cdomains/addressDomain.mli b/src/cdomains/addressDomain.mli new file mode 100644 index 0000000000..6f6a9a1001 --- /dev/null +++ b/src/cdomains/addressDomain.mli @@ -0,0 +1,3 @@ +(** Domains for addresses/pointers. *) + +include AddressDomain_intf.AddressDomain (** @inline *) diff --git a/src/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml new file mode 100644 index 0000000000..9b083d1254 --- /dev/null +++ b/src/cdomains/addressDomain_intf.ml @@ -0,0 +1,122 @@ +module type AddressDomain = +sig + module AddressBase (Mval: Printable.S): + sig + type t = + | Addr of Mval.t (** Pointer to offset of a variable. *) + | NullPtr (** NULL pointer. *) + | UnknownPtr (** Unknown pointer. Could point to globals, heap and escaped variables. *) + | StrPtr of string option (** String literal pointer. [StrPtr None] abstracts any string pointer *) + include Printable.S with type t := t (** @closed *) + include MapDomain.Groupable with type t := t (** @closed *) + + val from_string: string -> t + val to_string: t -> string option + val to_c_string: t -> string option + val to_n_c_string: int -> t -> string option + val to_string_length: t -> int option + end + + module AddressPrintable (Mval: Mval.Printable): + sig + type field = GoblintCil.fieldinfo (* TODO: remove *) + include module type of AddressBase (Mval) + include MapDomain.Groupable with type t := t and type group = Basetype.Variables.group (** @closed *) + + val is_definite: t -> bool + val add_offset: t -> Mval.idx Offset.t -> t + + (* TODO: rename to of_* *) + val from_var: GoblintCil.varinfo -> t + (** Creates an address from variable. *) + + val from_var_offset: Mval.t -> t + (** Creates an address from a variable and offset. *) + + val to_var: t -> GoblintCil.varinfo option + (** Strips the varinfo out of the address representation. *) + + val to_var_may: t -> GoblintCil.varinfo option + val to_var_must: t -> GoblintCil.varinfo option + (** Strips the varinfo out of the address representation. *) + + val to_var_offset: t -> Mval.t option + (** Get the offset *) + + val to_exp: t -> GoblintCil.exp + + val get_type: t -> GoblintCil.typ + (** Finds the type of the address location. *) + end + + (** Lvalue lattice. + + Actually a disjoint union of lattices without top or bottom. + Lvalues are grouped as follows: + + - Each {!Addr}, modulo precise index expressions in offset, is a sublattice with ordering induced by {!Offset}. + - {!NullPtr} is a singleton sublattice. + - {!UnknownPtr} is a singleton sublattice. + - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) + module AddressLattice (Mval: Mval.Lattice): + sig + include module type of AddressPrintable (Mval) + include Lattice.S with type t := t (** @closed *) + + val drop_ints: t -> t + + val semantic_equal: t -> t -> bool option + (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) + end + + (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) + module AddressLatticeRepr (Mval1: Mval.Lattice): + sig + include module type of AddressLattice (Mval1) (** @closed *) + + module R0: DisjointDomain.Representative with type elt = t + + module R: DisjointDomain.Representative with type elt = t + (** Representatives for lvalue sublattices as defined by {!AddressLattice}. *) + end + + module AddressSet (Mval: Mval.Lattice) (ID: IntDomain.Z): + sig + module Addr: module type of AddressLattice (Mval) + type field = Addr.field (* TODO: remove *) + + include SetDomain.S with type elt = Addr.t (** @closed *) + + val null_ptr: t + val unknown_ptr: t + val not_null: t + val top_ptr: t + + val is_null: t -> bool + val is_not_null: t -> bool + val may_be_null: t -> bool + val is_definite: t -> bool + val has_unknown: t -> bool + val may_be_unknown: t -> bool + val is_element: Addr.t -> t -> bool + + val from_var: GoblintCil.varinfo -> t + val from_var_offset: Mval.t -> t + val of_int: ID.t -> t + + val to_var_may: t -> GoblintCil.varinfo list + val to_var_must: t -> GoblintCil.varinfo list + val to_var_offset: t -> Mval.t list + val to_int: t -> ID.t + val to_bool: t -> bool option + + val get_type: t -> GoblintCil.typ + + val from_string: string -> t + val to_string: t -> string list + val to_string_length: t -> ID.t + val substring_extraction: t -> t -> t + val string_comparison: t -> t -> int option -> ID.t + val string_writing_defined: t -> bool + end +end diff --git a/src/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml index 669109ee1e..9766a1ac60 100644 --- a/src/cdomains/preValueDomain.ml +++ b/src/cdomains/preValueDomain.ml @@ -4,4 +4,9 @@ module IndexDomain = IntDomain.IntDomWithDefaultIkind (ID) (IntDomain.PtrDiffIki module Offs = Offset.MakeLattice (IndexDomain) module Mval = Mval.MakeLattice (Offs) module AD = AddressDomain.AddressSet (Mval) (ID) -module Addr = AD.Addr +module Addr = +struct + include AD.Addr + module Offs = Offs + module Mval = Mval +end From 3ec92d4bfd6e8a15045fbd3de5a4e114757f20de Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 12:42:27 +0300 Subject: [PATCH 371/518] Clean up AddressDomain inner modules --- src/analyses/malloc_null.ml | 2 +- src/analyses/uninit.ml | 2 +- src/cdomains/addressDomain.ml | 39 ++++++++---------------------- src/cdomains/addressDomain_intf.ml | 7 ++---- 4 files changed, 14 insertions(+), 36 deletions(-) diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index 4e9fa98b44..0120db82f3 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -77,7 +77,7 @@ struct (* Generate addresses to all points in an given varinfo. (Depends on type) *) let to_addrs (v:varinfo) : Addr.t list = let make_offs = List.fold_left (fun o f -> `Field (f, o)) `NoOffset in - let rec add_fields (base: Addr.field list) fs acc = + let rec add_fields (base: fieldinfo list) fs acc = match fs with | [] -> acc | f :: fs -> diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 4ca4b1fb1a..3cbbac9a6a 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -181,7 +181,7 @@ struct let to_addrs (v:varinfo) : Addr.t list = let make_offs = List.fold_left (fun o f -> `Field (f, o)) `NoOffset in - let rec add_fields (base: Addr.field list) fs acc = + let rec add_fields (base: fieldinfo list) fs acc = match fs with | [] -> acc | f :: fs -> diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index c055ec3338..219dab4562 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -4,6 +4,7 @@ open GoblintCil open IntOps module M = Messages +module Mval_outer = Mval module AddressBase (Mval: Printable.S) = @@ -73,12 +74,7 @@ end module AddressPrintable (Mval: Mval.Printable) = struct - type field = fieldinfo - (* type idx = Mval.idx *) - (* module Offs = Offset.MakePrintable (Idx) *) - (* module Mval = Mval.MakePrintable (Offs) *) include AddressBase (Mval) - module Mval = Mval let name () = "Normal Lvals" @@ -129,12 +125,9 @@ struct | _ -> false end -module AddressLattice (Mval0: Mval.Lattice) = +module AddressLattice (Mval: Mval.Lattice) = struct - (* open struct module Mval0 = Mval.MakeLattice (Offs) end *) - include AddressPrintable (Mval0) - module Mval = Mval0 - (* module Offs = Offs *) + include AddressPrintable (Mval) let semantic_equal x y = match x, y with | Addr x, Addr y -> Mval.semantic_equal x y @@ -197,12 +190,9 @@ struct let pretty_diff () (x,y) = Pretty.dprintf "%s: %a not leq %a" (name ()) pretty x pretty y end -module AddressLatticeRepr (Mval1: Mval.Lattice) = +module AddressLatticeRepr (Mval: Mval.Lattice) = struct - open struct module Mval0 = Mval end - - include AddressLattice (Mval1) - (* module Offs = Offs *) + include AddressLattice (Mval) module R0: DisjointDomain.Representative with type elt = t = struct @@ -223,15 +213,14 @@ struct module R: DisjointDomain.Representative with type elt = t = struct type elt = t - open Offset.Unit (* Offset module for representative without abstract values for index offsets, i.e. with unit index offsets. Reason: The offset in the representative (used for buckets) should not depend on the integer domains, since different integer domains may be active at different program points. *) - include AddressPrintable (Mval0.Unit) + include AddressPrintable (Mval_outer.Unit) let of_elt (x: elt): t = match x with - | Addr (v, o) -> Addr (v, of_offs o) (* addrs grouped by var and part of offset *) + | Addr (v, o) -> Addr (v, Offset.Unit.of_offs o) (* addrs grouped by var and part of offset *) | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) | NullPtr -> NullPtr @@ -241,17 +230,12 @@ end module AddressSet (Mval: Mval.Lattice) (ID: IntDomain.Z) = struct - (* module Offs = Offset.MakeLattice (Idx) *) - (* module Mval = Mval.MakeLattice (Offs) *) - module Addr = + module Addr = AddressLatticeRepr (Mval) + module J = struct - module Offs = Mval.Offs - include AddressLatticeRepr (Mval) - end - module J = (struct include SetDomain.Joined (Addr) let may_be_equal a b = Option.value (Addr.semantic_equal a b) ~default:true - end) + end module OffsetSplit = DisjointDomain.ProjectiveSetPairwiseMeet (Addr) (J) (Addr.R) (* module H = HoareDomain.SetEM (Addr) *) @@ -280,9 +264,6 @@ struct if M.tracing then M.traceu "ad" "-> %B\n" r; r - type field = Addr.field - (* type idx = Idx.t *) - let null_ptr = singleton Addr.NullPtr let unknown_ptr = singleton Addr.UnknownPtr let not_null = unknown_ptr diff --git a/src/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml index 9b083d1254..e41aea3dfc 100644 --- a/src/cdomains/addressDomain_intf.ml +++ b/src/cdomains/addressDomain_intf.ml @@ -19,7 +19,6 @@ sig module AddressPrintable (Mval: Mval.Printable): sig - type field = GoblintCil.fieldinfo (* TODO: remove *) include module type of AddressBase (Mval) include MapDomain.Groupable with type t := t and type group = Basetype.Variables.group (** @closed *) @@ -70,9 +69,9 @@ sig end (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) - module AddressLatticeRepr (Mval1: Mval.Lattice): + module AddressLatticeRepr (Mval: Mval.Lattice): sig - include module type of AddressLattice (Mval1) (** @closed *) + include module type of AddressLattice (Mval) (** @closed *) module R0: DisjointDomain.Representative with type elt = t @@ -83,8 +82,6 @@ sig module AddressSet (Mval: Mval.Lattice) (ID: IntDomain.Z): sig module Addr: module type of AddressLattice (Mval) - type field = Addr.field (* TODO: remove *) - include SetDomain.S with type elt = Addr.t (** @closed *) val null_ptr: t From 63c716c23c8bf8696521358b0783416011fa67c9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 12:44:06 +0300 Subject: [PATCH 372/518] Clean up Mval inner modules --- src/cdomains/mval.ml | 1 - src/cdomains/mval_intf.ml | 2 -- 2 files changed, 3 deletions(-) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 4e8005ae9b..9c42bd8ce0 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -42,7 +42,6 @@ end module MakeLattice (Offs: Offset.Lattice): Lattice with type idx = Offs.idx = struct include MakePrintable (Offs) - module Offs = Offs let semantic_equal (x, xoffs) (y, yoffs) = if CilType.Varinfo.equal x y then diff --git a/src/cdomains/mval_intf.ml b/src/cdomains/mval_intf.ml index 256a29f107..74ce86d6e6 100644 --- a/src/cdomains/mval_intf.ml +++ b/src/cdomains/mval_intf.ml @@ -21,8 +21,6 @@ sig include Printable (** @closed *) include Lattice.S with type t := t (** @closed *) - module Offs: Offset.Lattice with type idx = idx (* TODO: remove *) - val semantic_equal: t -> t -> bool option end From 99084c9ce9b77758356f5c866db35aafb039c341 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 12:50:27 +0300 Subject: [PATCH 373/518] Rename CilLval -> Lval --- src/analyses/base.ml | 4 ++-- src/cdomains/{cilLval.ml => lval.ml} | 0 src/domains/invariant.ml | 4 ++-- src/domains/queries.ml | 2 +- src/goblint_lib.ml | 2 +- src/transform/evalAssert.ml | 4 ++-- src/witness/yamlWitness.ml | 10 +++++----- 7 files changed, 13 insertions(+), 13 deletions(-) rename src/cdomains/{cilLval.ml => lval.ml} (100%) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 850e1cac67..de61b7051f 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1154,7 +1154,7 @@ struct Invariant.none in - if CilLval.Set.is_top context.Invariant.lvals then ( + if Lval.Set.is_top context.Invariant.lvals then ( if !earlyglobs || ThreadFlag.has_ever_been_multi ask then ( let cpa_invariant = CPA.fold (fun k v a -> @@ -1179,7 +1179,7 @@ struct ) ) else ( - CilLval.Set.fold (fun k a -> + Lval.Set.fold (fun k a -> let i = match k with | (Var v, offset) when not (InvariantCil.var_is_heap v) -> diff --git a/src/cdomains/cilLval.ml b/src/cdomains/lval.ml similarity index 100% rename from src/cdomains/cilLval.ml rename to src/cdomains/lval.ml diff --git a/src/domains/invariant.ml b/src/domains/invariant.ml index 042554c4e3..1a0c3c033c 100644 --- a/src/domains/invariant.ml +++ b/src/domains/invariant.ml @@ -43,10 +43,10 @@ let ( || ) = join type context = { path: int option; - lvals: CilLval.Set.t; + lvals: Lval.Set.t; } let default_context = { path = None; - lvals = CilLval.Set.top (); + lvals = Lval.Set.top (); } diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 544e236dcf..9e168a0ab0 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -62,7 +62,7 @@ type access = [@@deriving ord, hash] (* TODO: fix ppx_deriving_hash on variant with inline record *) type invariant_context = Invariant.context = { path: int option; - lvals: CilLval.Set.t; + lvals: Lval.Set.t; } [@@deriving ord, hash] diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 837a047e03..663886a062 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -231,7 +231,7 @@ module PthreadDomain = PthreadDomain module Basetype = Basetype module Offset = Offset module Mval = Mval -module CilLval = CilLval +module Lval = Lval module Access = Access module AccessDomain = AccessDomain diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index fbfbce68d9..91bdb82ce1 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -52,8 +52,8 @@ module EvalAssert = struct let make_assert ~node loc lval = let lvals = match lval with - | None -> CilLval.Set.top () - | Some lval -> CilLval.(Set.singleton lval) + | None -> Lval.Set.top () + | Some lval -> Lval.(Set.singleton lval) in let context = {Invariant.default_context with lvals} in match (ask ~node loc).f (Queries.Invariant context) with diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 31fd4dccc2..a0b6023365 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -171,15 +171,15 @@ struct if GobConfig.get_bool "witness.invariant.accessed" then ( match R.ask_local_node n ~local MayAccessed with | `Top -> - CilLval.Set.top () + Lval.Set.top () | (`Lifted _) as es -> let lvals = AccessDomain.EventSet.fold (fun e lvals -> match e with | {var_opt = Some var; offs_opt = Some offs; kind = Write} -> - CilLval.Set.add (Var var, offs) lvals + Lval.Set.add (Var var, offs) lvals | _ -> lvals - ) es (CilLval.Set.empty ()) + ) es (Lval.Set.empty ()) in let lvals = FileCfg.Cfg.next n @@ -192,7 +192,7 @@ struct |> fun es -> AccessDomain.EventSet.fold (fun e lvals -> match e with | {var_opt = Some var; offs_opt = Some offs; kind = Read} -> - CilLval.Set.add (Var var, offs) lvals + Lval.Set.add (Var var, offs) lvals | _ -> lvals ) es lvals @@ -200,7 +200,7 @@ struct lvals ) else - CilLval.Set.top () + Lval.Set.top () in let entries = [] in From afae4e3c3ef7c8932a2da5dc776e82a9e38b8fdc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 13:07:00 +0300 Subject: [PATCH 374/518] Partially reuse Mval for MusteqDomain.VF --- src/cdomains/musteqDomain.ml | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index bc9b595339..af5f89f316 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -73,15 +73,7 @@ end (* TODO: Mval *) module VF = struct - include Printable.ProdSimple (V) (F) - let show (v,fd) = - let v_str = V.show v in - let fd_str = F.show fd in - v_str ^ fd_str - let pretty () x = Pretty.text (show x) - - let printXml f (v,fi) = - BatPrintf.fprintf f "\n\n%s%a\n\n\n" (XmlUtil.escape (V.show v)) F.printXml fi + include Mval.MakePrintable (F) (* Indicates if the two var * offset pairs should collapse or not. *) let collapse (v1,f1) (v2,f2) = V.equal v1 v2 && F.collapse f1 f2 @@ -90,9 +82,6 @@ struct let join (v1,f1) (v2,f2) = (v1,F.join f1 f2) let kill x (v,f) = v, F.kill x f let replace x exp (v,fd) = v, F.replace x exp fd - - let prefix (v1,fd1: t) (v2,fd2: t): F.t option = - if V.equal v1 v2 then F.prefix fd1 fd2 else None end module P = Printable.ProdSimple (V) (V) From 5fa956eb6ddc34c8bff67f9a30d0ea613fcd35b4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 13:45:47 +0300 Subject: [PATCH 375/518] Add names to addresses --- src/cdomains/addressDomain.ml | 16 +++++++--------- src/cdomains/addressDomain_intf.ml | 4 ++-- src/cdomains/offset.ml | 4 +++- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 219dab4562..e82ff85802 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -17,7 +17,7 @@ struct | StrPtr of string option [@@deriving eq, ord, hash] (* TODO: StrPtr equal problematic if the same literal appears more than once *) - let name () = "address" + let name () = Format.sprintf "address (%s)" (Mval.name ()) let hash x = match x with | StrPtr _ -> @@ -76,8 +76,6 @@ module AddressPrintable (Mval: Mval.Printable) = struct include AddressBase (Mval) - let name () = "Normal Lvals" - type group = Basetype.Variables.group let show_group = Basetype.Variables.show_group let to_group = function @@ -194,14 +192,12 @@ module AddressLatticeRepr (Mval: Mval.Lattice) = struct include AddressLattice (Mval) - module R0: DisjointDomain.Representative with type elt = t = + module VariableRepr: DisjointDomain.Representative with type elt = t = struct type elt = t include AddressBase (Basetype.Variables) - let name () = "BaseAddrRepr.R" - let of_elt (x: elt): t = match x with | Addr (v, o) -> Addr v | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) @@ -210,7 +206,7 @@ struct | UnknownPtr -> UnknownPtr end - module R: DisjointDomain.Representative with type elt = t = + module UnitOffsetRepr: DisjointDomain.Representative with type elt = t = struct type elt = t @@ -236,14 +232,16 @@ struct include SetDomain.Joined (Addr) let may_be_equal a b = Option.value (Addr.semantic_equal a b) ~default:true end - module OffsetSplit = DisjointDomain.ProjectiveSetPairwiseMeet (Addr) (J) (Addr.R) + module OffsetSplit = DisjointDomain.ProjectiveSetPairwiseMeet (Addr) (J) (Addr.UnitOffsetRepr) (* module H = HoareDomain.SetEM (Addr) *) (* Hoare set for bucket doesn't play well with StrPtr limiting: https://github.com/goblint/analyzer/pull/808 *) - module AddressSet : SetDomain.S with type elt = Addr.t = DisjointDomain.ProjectiveSet (Addr) (OffsetSplit) (Addr.R0) + module AddressSet: SetDomain.S with type elt = Addr.t = DisjointDomain.ProjectiveSet (Addr) (OffsetSplit) (Addr.VariableRepr) include AddressSet + let name () = Format.sprintf "address set (%s)" (Mval.name ()) + (* short-circuit with physical equality, makes a difference at long-scale: https://github.com/goblint/analyzer/pull/809#issuecomment-1206174751 *) let equal x y = x == y || equal x y diff --git a/src/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml index e41aea3dfc..63e75a0802 100644 --- a/src/cdomains/addressDomain_intf.ml +++ b/src/cdomains/addressDomain_intf.ml @@ -73,9 +73,9 @@ sig sig include module type of AddressLattice (Mval) (** @closed *) - module R0: DisjointDomain.Representative with type elt = t + module VariableRepr: DisjointDomain.Representative with type elt = t - module R: DisjointDomain.Representative with type elt = t + module UnitOffsetRepr: DisjointDomain.Representative with type elt = t (** Representatives for lvalue sublattices as defined by {!AddressLattice}. *) end diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index ae1aa6f352..1610ded685 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -16,6 +16,7 @@ struct module Unit: Printable with type t = unit = struct include Lattice.Unit + let name () = "unit index" let equal_to _ _ = `Top let to_int _ = None end @@ -23,6 +24,7 @@ struct module Exp: Printable with type t = exp = struct include CilType.Exp + let name () = "exp index" (* Override output *) let pretty () x = @@ -52,7 +54,7 @@ struct type t = Idx.t offs [@@deriving eq, ord, hash] include Printable.StdLeaf - let name () = "offset" + let name () = Format.sprintf "offset (%s)" (Idx.name ()) let is_first_field x = match x.fcomp.cfields with | [] -> false From 8ca27d6bb13dd9ff178375f039ffc55d7eb9bf28 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 13:50:03 +0300 Subject: [PATCH 376/518] Print Mvals with RichVarinfo --- src/cdomains/mval.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 9c42bd8ce0..2f9c06d7f6 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -9,8 +9,8 @@ module MakePrintable (Offs: Offset.Printable): Printable with type idx = Offs.id struct type idx = Offs.idx include Printable.StdLeaf - (* TODO: version with Basetype.Variables and RichVarinfo for AddressDomain *) - type t = CilType.Varinfo.t * Offs.t [@@deriving eq, ord, hash] + (* Use Basetype.Variables to print with RichVarinfo. *) + type t = Basetype.Variables.t * Offs.t [@@deriving eq, ord, hash] let name () = Format.sprintf "lval (%s)" (Offs.name ()) From 434a62c4f3089b1ff50ac4c1878c2f71879cb27f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 13:57:45 +0300 Subject: [PATCH 377/518] Fix unused-value-declaration warnings in ValueDomain --- src/cdomains/valueDomain.ml | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 3cac7dec5d..cf81106361 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -77,20 +77,20 @@ module Threads = ConcDomain.ThreadSet module JmpBufs = JmpBufDomain.JmpBufSetTaint module rec Compound: sig - type t = | Top - | Int of ID.t - | Float of FD.t - | Address of AD.t - | Struct of Structs.t - | Union of Unions.t - | Array of CArrays.t - | Blob of Blobs.t - | Thread of Threads.t - | JmpBuf of JmpBufs.t - | Mutex - | MutexAttr of MutexAttrDomain.t - | Bot - [@@deriving eq, ord, hash] + type t = + | Top + | Int of ID.t + | Float of FD.t + | Address of AD.t + | Struct of Structs.t + | Union of Unions.t + | Array of CArrays.t + | Blob of Blobs.t + | Thread of Threads.t + | JmpBuf of JmpBufs.t + | Mutex + | MutexAttr of MutexAttrDomain.t + | Bot include S with type t := t and type offs = (fieldinfo,IndexDomain.t) Lval.offs end = struct From 7ac94736d3b9aae942cf22a72d81e46aacbf7eab Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 15:27:28 +0300 Subject: [PATCH 378/518] Use more Offset --- src/analyses/taintPartialContexts.ml | 8 +------- src/analyses/threadEscape.ml | 6 ------ src/analyses/uninit.ml | 10 ++-------- src/cdomains/valueDomain.ml | 6 +----- 4 files changed, 4 insertions(+), 26 deletions(-) diff --git a/src/analyses/taintPartialContexts.ml b/src/analyses/taintPartialContexts.ml index 2cbfe7d87a..76f4af8f9e 100644 --- a/src/analyses/taintPartialContexts.ml +++ b/src/analyses/taintPartialContexts.ml @@ -14,17 +14,11 @@ struct module D = SetDomain.ToppedSet (Mval.Exp) (struct let topname = "All" end) module C = Lattice.Unit - let rec resolve (offs : offset) : Basetype.CilExp.t Offset.t = - match offs with - | NoOffset -> `NoOffset - | Field (f_info, f_offs) -> `Field (f_info, (resolve f_offs)) - | Index (i_exp, i_offs) -> `Index (i_exp, (resolve i_offs)) - (* Add Lval or any Lval which it may point to to the set *) let taint_lval ctx (lval:lval) : D.t = let d = ctx.local in (match lval with - | (Var v, offs) -> D.add (v, resolve offs) d + | (Var v, offs) -> D.add (v, Offset.Exp.of_cil offs) d | (Mem e, _) -> D.union (ctx.ask (Queries.MayPointTo e)) d ) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 3dd6b9ec07..16001c74c5 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -22,12 +22,6 @@ struct module V = VarinfoV module G = EscapeDomain.EscapedVars - let rec cut_offset x = - match x with - | `NoOffset -> `NoOffset - | `Index (_,o) -> `NoOffset - | `Field (f,o) -> `Field (f, cut_offset o) - let reachable (ask: Queries.ask) e: D.t = match ask.f (Queries.ReachableFrom e) with | a when not (Queries.LS.is_top a) -> diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 3cbbac9a6a..a9cc5247ee 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -114,17 +114,11 @@ struct (* Call to [get_pfx v cx] returns initialized prefixes ... *) let rec get_pfx (v:varinfo) (cx:lval_offs) (ofs:lval_offs) (target:typ) (other:typ) : var_offs list = - let rec cat o i = - match o with - | `NoOffset -> i - | `Field (f, o) -> `Field (f, cat o i) - | `Index (v, o) -> `Index (v, cat o i) - in let rec rev lo = match lo with | `NoOffset -> `NoOffset - | `Field (f, o) -> cat (rev o) (`Field (f, `NoOffset)) - | `Index (v, o) -> cat (rev o) (`Index (v, `NoOffset)) + | `Field (f, o) -> Addr.Offs.add_offset (rev o) (`Field (f, `NoOffset)) + | `Index (v, o) -> Addr.Offs.add_offset (rev o) (`Index (v, `NoOffset)) in let rec bothstruct (t:fieldinfo list) (tf:fieldinfo) (o:fieldinfo list) (no:lval_offs) : var_offs list = match t, o with diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index e1574dd600..698055fc4b 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -1197,11 +1197,7 @@ struct match addr with | Addr.Addr (v, o) -> Addr.Addr (v, project_offs p o) | ptr -> ptr) a - and project_offs p offs = - match offs with - | `NoOffset -> `NoOffset - | `Field (field, offs') -> `Field (field, project_offs p offs') - | `Index (idx, offs') -> `Index (ID.project p idx, project_offs p offs') + and project_offs p offs = Offs.map_indices (ID.project p) offs and project_arr ask p array_attr n = let n = match array_attr with | Some (varAttr,typAttr) -> CArrays.project ~varAttr ~typAttr ask n From 5189b7de0322b4681342bdbca88c9a12af5957cb Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 15:52:51 +0300 Subject: [PATCH 379/518] Clean up and unify Offset, Mval and AddressDomain --- src/analyses/base.ml | 22 +++++++++---------- src/cdomains/addressDomain.ml | 8 +++---- src/cdomains/addressDomain_intf.ml | 4 ++-- src/cdomains/mval.ml | 8 +++---- src/cdomains/mval_intf.ml | 2 +- src/cdomains/offset.ml | 34 ++++++++++++------------------ src/cdomains/offset_intf.ml | 14 ++++++------ src/cdomains/valueDomain.ml | 6 +++--- src/util/cilfacade.ml | 4 ++++ 9 files changed, 50 insertions(+), 52 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index f2f085eca6..a228dbbfd3 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -452,7 +452,7 @@ struct * For the exp argument it is always ok to put None. This means not using precise information about * which part of an array is involved. *) let rec get ?(top=VD.top ()) ?(full=false) a (gs: glob_fun) (st: store) (addrs:address) (exp:exp option): value = - let at = AD.get_type addrs in + let at = AD.type_of addrs in let firstvar = if M.tracing then match AD.to_var_may addrs with [] -> "" | x :: _ -> x.vname else "" in if M.tracing then M.traceli "get" ~var:firstvar "Address: %a\nState: %a\n" AD.pretty addrs CPA.pretty st.cpa; (* Finding a single varinfo*offset pair *) @@ -501,7 +501,7 @@ struct M.info ~category:Unsound "Unknown address given as function argument"; acc | Address adrs when AD.to_var_may adrs = [] -> acc | Address adrs -> - let typ = AD.get_type adrs in + let typ = AD.type_of adrs in if isFunctionType typ then acc else adrs :: acc | Top -> M.info ~category:Unsound "Unknown value type given as function argument"; acc | _ -> acc @@ -538,7 +538,7 @@ struct * pointers. We return a flattend representation, thus simply an address (set). *) let reachable_from_address (ask: Q.ask) (gs:glob_fun) st (adr: address): address = if M.tracing then M.tracei "reachability" "Checking for %a\n" AD.pretty adr; - let res = reachable_from_value ask gs st (get ask gs st adr None) (AD.get_type adr) (AD.show adr) in + let res = reachable_from_value ask gs st (get ask gs st adr None) (AD.type_of adr) (AD.show adr) in if M.tracing then M.traceu "reachability" "Reachable addresses: %a\n" AD.pretty res; res @@ -924,7 +924,7 @@ struct match a with | Addr (x, o) -> begin - let at = Addr.Mval.get_type_addr (x, o) in + let at = Addr.Mval.type_of (x, o) in if M.tracing then M.tracel "evalint" "cast_ok %a %a %a\n" Addr.pretty (Addr (x, o)) CilType.Typ.pretty (Cil.unrollType x.vtype) CilType.Typ.pretty at; if at = TVoid [] then (* HACK: cast from alloc variable is always fine *) true @@ -932,7 +932,7 @@ struct match Cil.getInteger (sizeOf t), Cil.getInteger (sizeOf at) with | Some i1, Some i2 -> Z.compare i1 i2 <= 0 | _ -> - if contains_vla t || contains_vla (Addr.Mval.get_type_addr (x, o)) then + if contains_vla t || contains_vla (Addr.Mval.type_of (x, o)) then begin (* TODO: Is this ok? *) M.info ~category:Unsound "Casting involving a VLA is assumed to work"; @@ -1613,7 +1613,7 @@ struct let set_savetop ~ctx ?lval_raw ?rval_raw ask (gs:glob_fun) st adr lval_t v : store = if M.tracing then M.tracel "set" "savetop %a %a %a\n" AD.pretty adr d_type lval_t VD.pretty v; match v with - | Top -> set ~ctx ask gs st adr lval_t (VD.top_value (AD.get_type adr)) ?lval_raw ?rval_raw + | Top -> set ~ctx ask gs st adr lval_t (VD.top_value (AD.type_of adr)) ?lval_raw ?rval_raw | v -> set ~ctx ask gs st adr lval_t v ?lval_raw ?rval_raw @@ -1835,7 +1835,7 @@ struct (* To invalidate a single address, we create a pair with its corresponding * top value. *) let invalidate_address st a = - let t = AD.get_type a in + let t = AD.type_of a in let v = get ask gs st a None in (* None here is ok, just causes us to be a bit less precise *) let nv = VD.invalidate_value (Queries.to_value_domain_ask ask) t v in (a, t, nv) @@ -2007,7 +2007,7 @@ struct let addr_type_of_exp exp = let lval = mkMem ~addr:(Cil.stripCasts exp) ~off:NoOffset in let addr = eval_lv (Analyses.ask_of_ctx ctx) ctx.global ctx.local lval in - (addr, AD.get_type addr) + (addr, AD.type_of addr) in let forks = forkfun ctx lv f args in if M.tracing then if not (List.is_empty forks) then M.tracel "spawn" "Base.special %s: spawning functions %a\n" f.vname (d_list "," CilType.Varinfo.pretty) (List.map BatTuple.Tuple3.second forks); @@ -2019,7 +2019,7 @@ struct let dest_a, dest_typ = addr_type_of_exp dst in let src_lval = mkMem ~addr:(Cil.stripCasts src) ~off:NoOffset in let src_typ = eval_lv (Analyses.ask_of_ctx ctx) gs st src_lval - |> AD.get_type in + |> AD.type_of in (* when src and destination type coincide, take value from the source, otherwise use top *) let value = if typeSig dest_typ = typeSig src_typ then let src_cast_lval = mkMem ~addr:(Cilfacade.mkCast ~e:src ~newt:(TPtr (dest_typ, []))) ~off:NoOffset in @@ -2153,7 +2153,7 @@ struct begin let get_type lval = let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in - AD.get_type address + AD.type_of address in let dst_lval = mkMem ~addr:(Cil.stripCasts attr) ~off:NoOffset in let dest_typ = get_type dst_lval in @@ -2366,7 +2366,7 @@ struct if CPA.mem v fun_st.cpa then let lval = Mval.Exp.to_cil (v,o) in let address = eval_lv ask ctx.global st lval in - let lval_type = (AD.get_type address) in + let lval_type = (AD.type_of address) in if M.tracing then M.trace "taintPC" "updating %a; type: %a\n" Mval.Exp.pretty (v, o) d_type lval_type; match (CPA.find_opt v (fun_st.cpa)), lval_type with | None, _ -> st diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index e82ff85802..95c7166a97 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -98,8 +98,8 @@ struct | Addr (x, o) -> Some (x, o) | _ -> None - let get_type = function - | Addr (x, o) -> Mval.get_type_addr (x, o) + let type_of = function + | Addr (x, o) -> Mval.type_of (x, o) | StrPtr _ -> charPtrType (* TODO Cil.charConstPtrType? *) | NullPtr -> voidType | UnknownPtr -> voidPtrType @@ -291,8 +291,8 @@ struct else ID.top_of ik - let get_type xs = - try Addr.get_type (choose xs) + let type_of xs = + try Addr.type_of (choose xs) with (* WTF? Returns TVoid when it is unknown and stuff??? *) | _ -> voidType diff --git a/src/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml index 63e75a0802..a6b206669f 100644 --- a/src/cdomains/addressDomain_intf.ml +++ b/src/cdomains/addressDomain_intf.ml @@ -44,7 +44,7 @@ sig val to_exp: t -> GoblintCil.exp - val get_type: t -> GoblintCil.typ + val type_of: t -> GoblintCil.typ (** Finds the type of the address location. *) end @@ -107,7 +107,7 @@ sig val to_int: t -> ID.t val to_bool: t -> bool option - val get_type: t -> GoblintCil.typ + val type_of: t -> GoblintCil.typ val from_string: string -> t val to_string: t -> string list diff --git a/src/cdomains/mval.ml b/src/cdomains/mval.ml index 2f9c06d7f6..2bc5658460 100644 --- a/src/cdomains/mval.ml +++ b/src/cdomains/mval.ml @@ -24,7 +24,7 @@ struct let add_offset (v, o) o' = (v, Offs.add_offset o o') - let get_type_addr (v,o) = try Offs.type_offset v.vtype o with Offs.Type_offset (t,_) -> t + let type_of (v,o) = try Offs.type_of ~base:v.vtype o with Offset.Type_of_error (t,_) -> t let prefix (v1,ofs1) (v2,ofs2) = if CilType.Varinfo.equal v1 v2 then @@ -45,9 +45,9 @@ struct let semantic_equal (x, xoffs) (y, yoffs) = if CilType.Varinfo.equal x y then - let xtyp = x.vtype in - let ytyp = y.vtype in - Offs.semantic_equal ~xtyp ~xoffs ~ytyp ~yoffs + let typ1 = x.vtype in + let typ2 = y.vtype in + Offs.semantic_equal ~typ1 xoffs ~typ2 yoffs else Some false diff --git a/src/cdomains/mval_intf.ml b/src/cdomains/mval_intf.ml index 74ce86d6e6..17581d23b0 100644 --- a/src/cdomains/mval_intf.ml +++ b/src/cdomains/mval_intf.ml @@ -13,7 +13,7 @@ sig val to_cil: t -> GoblintCil.lval val to_cil_exp: t -> GoblintCil.exp - val get_type_addr: t -> GoblintCil.typ + val type_of: t -> GoblintCil.typ end module type Lattice = diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 1610ded685..9dbff8b91b 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -56,10 +56,6 @@ struct let name () = Format.sprintf "offset (%s)" (Idx.name ()) - let is_first_field x = match x.fcomp.cfields with - | [] -> false - | f :: _ -> CilType.Fieldinfo.equal f x - let rec cmp_zero_offset : t -> [`MustZero | `MustNonzero | `MayZero] = function | `NoOffset -> `MustZero | `Index (x, o) -> (match cmp_zero_offset o, Idx.equal_to (IntOps.BigIntOps.zero) x with @@ -68,9 +64,7 @@ struct | `MustZero, `Eq -> `MustZero | _, _ -> `MayZero) | `Field (x, o) -> - if is_first_field x then cmp_zero_offset o else `MustNonzero - - let is_zero_offset x = cmp_zero_offset x = `MustZero + if Cilfacade.is_first_field x then cmp_zero_offset o else `MustNonzero let rec show: t -> string = function | `NoOffset -> "" @@ -140,23 +134,21 @@ struct let top_indices = map_indices (fun _ -> Idx.top ()) - (* exception if the offset can't be followed completely *) - exception Type_offset of typ * string (* tries to follow o in t *) - let rec type_offset t o = match unrollType t, o with (* resolves TNamed *) + let rec type_of ~base:t o = match unrollType t, o with (* resolves TNamed *) | t, `NoOffset -> t | TArray (t,_,_), `Index (i,o) - | TPtr (t,_), `Index (i,o) -> type_offset t o + | TPtr (t,_), `Index (i,o) -> type_of ~base:t o | TComp (ci,_), `Field (f,o) -> let fi = try getCompField ci f.fname with Not_found -> let s = GobPretty.sprintf "Addr.type_offset: field %s not found in type %a" f.fname d_plaintype t in - raise (Type_offset (t, s)) - in type_offset fi.ftype o - | TComp _, `Index (_,o) -> type_offset t o (* this happens (hmmer, perlbench). safe? *) + raise (Type_of_error (t, s)) + in type_of ~base:fi.ftype o + | TComp _, `Index (_,o) -> type_of ~base:t o (* this happens (hmmer, perlbench). safe? *) | t,o -> let s = GobPretty.sprintf "Addr.type_offset: could not follow offset in type. type: %a, offset: %a" d_plaintype t pretty o in - raise (Type_offset (t, s)) + raise (Type_of_error (t, s)) let rec prefix (x: t) (y: t): t option = match x,y with | `Index (x, xs), `Index (y, ys) when Idx.equal x y -> prefix xs ys @@ -197,7 +189,7 @@ struct | `Index (_,o) -> `Index (Idx.top (), of_exp o) | `Field (f,o) -> `Field (f, of_exp o) - let offset_to_index_offset typ (offs: t): Idx.t = + let to_index ?typ (offs: t): Idx.t = let idx_of_int x = Idx.of_int (Cilfacade.ptrdiff_ikind ()) (Z.of_int x) in @@ -222,12 +214,12 @@ struct let remaining_offset = offset_to_index_offset ?typ:item_typ o in Idx.add bits_offset remaining_offset in - offset_to_index_offset ~typ offs + offset_to_index_offset ?typ offs - let semantic_equal ~xtyp ~xoffs ~ytyp ~yoffs = - let x_index = offset_to_index_offset xtyp xoffs in - let y_index = offset_to_index_offset ytyp yoffs in - if M.tracing then M.tracel "addr" "xoffs=%a xtyp=%a xindex=%a yoffs=%a ytyp=%a yindex=%a\n" pretty xoffs d_plaintype xtyp Idx.pretty x_index pretty yoffs d_plaintype ytyp Idx.pretty y_index; + let semantic_equal ~typ1 xoffs ~typ2 yoffs = + let x_index = to_index ~typ:typ1 xoffs in + let y_index = to_index ~typ:typ2 yoffs in + if M.tracing then M.tracel "addr" "xoffs=%a typ1=%a xindex=%a yoffs=%a typ2=%a yindex=%a\n" pretty xoffs d_plaintype typ1 Idx.pretty x_index pretty yoffs d_plaintype typ2 Idx.pretty y_index; Idx.to_bool (Idx.eq x_index y_index) include Lattice.NoBotTop diff --git a/src/cdomains/offset_intf.ml b/src/cdomains/offset_intf.ml index 83c178694c..0ea3f8eff5 100644 --- a/src/cdomains/offset_intf.ml +++ b/src/cdomains/offset_intf.ml @@ -23,6 +23,9 @@ struct module type Lattice = IntDomain.Z end +exception Type_of_error of GoblintCil.typ * string +(** exception if the offset can't be followed completely *) + module type Printable = sig type idx @@ -42,12 +45,9 @@ sig val to_cil_offset: t -> GoblintCil.offset (** Version of {!to_cil} which drops indices for {!ArrayDomain}. *) - val is_first_field: GoblintCil.fieldinfo -> bool val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] - val is_zero_offset: t -> bool - exception Type_offset of GoblintCil.typ * string - val type_offset: GoblintCil.typ -> t -> GoblintCil.typ + val type_of: base:GoblintCil.typ -> t -> GoblintCil.typ end module type Lattice = @@ -57,8 +57,8 @@ sig val of_exp: GoblintCil.exp offs -> t - val offset_to_index_offset: GoblintCil.typ -> t -> idx - val semantic_equal: xtyp:GoblintCil.typ -> xoffs:t -> ytyp:GoblintCil.typ -> yoffs:t -> bool option + val to_index: ?typ:GoblintCil.typ -> t -> idx + val semantic_equal: typ1:GoblintCil.typ -> t -> typ2:GoblintCil.typ -> t -> bool option end module type Offset = @@ -77,6 +77,8 @@ sig module Exp: Printable with type t = GoblintCil.exp end + exception Type_of_error of GoblintCil.typ * string + module type Printable = Printable module type Lattice = Lattice diff --git a/src/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml index 698055fc4b..94b4c06a4c 100644 --- a/src/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -350,7 +350,7 @@ struct | t -> t in let rec adjust_offs v o d = - let ta = try Addr.Offs.type_offset v.vtype o with Addr.Offs.Type_offset (t,s) -> raise (CastError s) in + let ta = try Addr.Offs.type_of ~base:v.vtype o with Offset.Type_of_error (t,s) -> raise (CastError s) in let info = GobPretty.sprintf "Ptr-Cast %a from %a to %a" Addr.pretty (Addr.Addr (v,o)) d_type ta d_type t in M.tracel "casta" "%s\n" info; let err s = raise (CastError (s ^ " (" ^ info ^ ")")) in @@ -363,7 +363,7 @@ struct M.tracel "casta" "cast to bigger size\n"; if d = Some false then err "Ptr-cast to type of incompatible size!" else if o = `NoOffset then err "Ptr-cast to outer type, but no offset to remove." - else if Addr.Offs.is_zero_offset o then adjust_offs v (Addr.Offs.remove_offset o) (Some true) + else if Addr.Offs.cmp_zero_offset o = `MustZero then adjust_offs v (Addr.Offs.remove_offset o) (Some true) else err "Ptr-cast to outer type, but possibly from non-zero offset." | _ -> (* cast to smaller/inner type *) M.tracel "casta" "cast to smaller size\n"; @@ -379,7 +379,7 @@ struct | TArray _, _ -> M.tracel "casta" "cast array to its first element\n"; adjust_offs v (Addr.Offs.add_offset o (`Index (IndexDomain.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset))) (Some false) - | _ -> err @@ Format.sprintf "Cast to neither array index nor struct field. is_zero_offset: %b" (Addr.Offs.is_zero_offset o) + | _ -> err @@ Format.sprintf "Cast to neither array index nor struct field. is_zero_offset: %b" (Addr.Offs.cmp_zero_offset o = `MustZero) end in let one_addr = let open Addr in function diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml index 18ff9bf234..09231b4f45 100644 --- a/src/util/cilfacade.ml +++ b/src/util/cilfacade.ml @@ -33,6 +33,10 @@ let rec isVLAType t = variable_len || isVLAType et | _ -> false +let is_first_field x = match x.fcomp.cfields with + | [] -> false + | f :: _ -> CilType.Fieldinfo.equal f x + let init_options () = Mergecil.merge_inlines := get_bool "cil.merge.inlines"; Cil.cstd := Cil.cstd_of_string (get_string "cil.cstd"); From 088724ec8c2498ba1d9587657130a992effd472f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 15:58:58 +0300 Subject: [PATCH 380/518] Rename from_* -> of_* in AddressDomain --- src/analyses/base.ml | 44 ++++++++++++++--------------- src/analyses/commonPriv.ml | 4 +-- src/analyses/malloc_null.ml | 22 +++++++-------- src/analyses/mayLocks.ml | 4 +-- src/analyses/mutexAnalysis.ml | 4 +-- src/analyses/mutexEventsAnalysis.ml | 6 ++-- src/analyses/pthreadSignals.ml | 4 +-- src/analyses/symbLocks.ml | 2 +- src/analyses/threadEscape.ml | 4 +-- src/analyses/uninit.ml | 20 ++++++------- src/cdomains/addressDomain.ml | 18 ++++++------ src/cdomains/addressDomain_intf.ml | 17 ++++++----- src/cdomains/lockDomain.ml | 6 ++-- src/cdomains/symbLocksDomain.ml | 2 +- 14 files changed, 78 insertions(+), 79 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index a228dbbfd3..239b3dfe04 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -145,7 +145,7 @@ struct let return_varstore = ref dummyFunDec.svar let return_varinfo () = !return_varstore - let return_var () = AD.from_var (return_varinfo ()) + let return_var () = AD.of_var (return_varinfo ()) let return_lval (): lval = (Var (return_varinfo ()), NoOffset) let longjmp_return = ref dummyFunDec.svar @@ -295,8 +295,8 @@ struct | Addr.NullPtr when GobOption.exists (BI.equal BI.zero) (ID.to_int n) -> Addr.NullPtr | _ -> Addr.UnknownPtr in - match Addr.to_var_offset addr with - | Some (x, o) -> Addr.from_var_offset (x, addToOffset n (Some x.vtype) o) + match Addr.to_mval addr with + | Some (x, o) -> Addr.of_mval (x, addToOffset n (Some x.vtype) o) | None -> default addr in let addToAddrOp p (n:ID.t):value = @@ -385,7 +385,7 @@ struct | _ -> Int (ID.top_of ik) in if AD.is_definite p1 && AD.is_definite p2 then - match Addr.to_var_offset (AD.choose p1), Addr.to_var_offset (AD.choose p2) with + match Addr.to_mval (AD.choose p1), Addr.to_mval (AD.choose p2) with | Some (x, xo), Some (y, yo) when CilType.Varinfo.equal x y -> calculateDiffFromOffset xo yo | _, _ -> @@ -408,8 +408,8 @@ struct (* We need the previous function with the varinfo carried along, so we can * map it on the address sets. *) let add_offset_varinfo add ad = - match Addr.to_var_offset ad with - | Some (x,ofs) -> Addr.from_var_offset (x, Addr.Offs.add_offset ofs add) + match Addr.to_mval ad with + | Some (x,ofs) -> Addr.of_mval (x, Addr.Offs.add_offset ofs add) | None -> ad @@ -461,7 +461,7 @@ struct (* get hold of the variable value, either from local or global state *) let var = get_var a gs st x in let v = VD.eval_offset (Queries.to_value_domain_ask a) (fun x -> get a gs st x exp) var offs exp (Some (Var x, Offs.to_cil_offset offs)) x.vtype in - if M.tracing then M.tracec "get" "var = %a, %a = %a\n" VD.pretty var AD.pretty (AD.from_var_offset (x, offs)) VD.pretty v; + if M.tracing then M.tracec "get" "var = %a, %a = %a\n" VD.pretty var AD.pretty (AD.of_mval (x, offs)) VD.pretty v; if full then v else match v with | Blob (c,s,_) -> c | x -> x @@ -769,11 +769,11 @@ struct | Const (CReal (_,fkind, Some str)) when not (Cilfacade.isComplexFKind fkind) -> Float (FD.of_string fkind str) (* prefer parsing from string due to higher precision *) | Const (CReal (num, fkind, None)) when not (Cilfacade.isComplexFKind fkind) -> Float (FD.of_const fkind num) (* String literals *) - | Const (CStr (x,_)) -> Address (AD.from_string x) (* normal 8-bit strings, type: char* *) + | Const (CStr (x,_)) -> Address (AD.of_string x) (* normal 8-bit strings, type: char* *) | Const (CWStr (xs,_) as c) -> (* wide character strings, type: wchar_t* *) let x = CilType.Constant.show c in (* escapes, see impl. of d_const in cil.ml *) let x = String.sub x 2 (String.length x - 3) in (* remove surrounding quotes: L"foo" -> foo *) - Address (AD.from_string x) (* Address (AD.str_ptr ()) *) + Address (AD.of_string x) (* Address (AD.str_ptr ()) *) | Const _ -> VD.top () (* Variables and address expressions *) | Lval lv -> @@ -1041,7 +1041,7 @@ struct (* The simpler case with an explicit variable, e.g. for [x.field] we just * create the address { (x,field) } *) | Var x, ofs -> - AD.singleton (Addr.from_var_offset (x, convert_offset a gs st ofs)) + AD.singleton (Addr.of_mval (x, convert_offset a gs st ofs)) (* The more complicated case when [exp = & x.field] and we are asked to * evaluate [(\*exp).subfield]. We first evaluate [exp] to { (x,field) } * and then add the subfield to it: { (x,field.subfield) }. *) @@ -1416,7 +1416,7 @@ struct else new_value in - if M.tracing then M.tracel "set" ~var:firstvar "update_one_addr: start with '%a' (type '%a') \nstate:%a\n\n" AD.pretty (AD.from_var_offset (x,offs)) d_type x.vtype D.pretty st; + if M.tracing then M.tracel "set" ~var:firstvar "update_one_addr: start with '%a' (type '%a') \nstate:%a\n\n" AD.pretty (AD.of_mval (x,offs)) d_type x.vtype D.pretty st; if isFunctionType x.vtype then begin if M.tracing then M.tracel "set" ~var:firstvar "update_one_addr: returning: '%a' is a function type \n" d_type x.vtype; st @@ -1521,7 +1521,7 @@ struct end in let update_one x store = - match Addr.to_var_offset x with + match Addr.to_mval x with | Some x -> update_one_addr x store | None -> store in try @@ -1695,13 +1695,13 @@ struct in begin match current_val with | Bot -> (* current value is VD Bot *) - begin match Addr.to_var_offset (AD.choose lval_val) with + begin match Addr.to_mval (AD.choose lval_val) with | Some (x,offs) -> let t = v.vtype in let iv = VD.bot_value ~varAttr:v.vattr t in (* correct bottom value for top level variable *) if M.tracing then M.tracel "set" "init bot value: %a\n" VD.pretty iv; let nv = VD.update_offset (Queries.to_value_domain_ask (Analyses.ask_of_ctx ctx)) iv offs rval_val (Some (Lval lval)) lval t in (* do desired update to value *) - set_savetop ~ctx (Analyses.ask_of_ctx ctx) ctx.global ctx.local (AD.from_var v) lval_t nv ~lval_raw:lval ~rval_raw:rval (* set top-level variable to updated value *) + set_savetop ~ctx (Analyses.ask_of_ctx ctx) ctx.global ctx.local (AD.of_var v) lval_t nv ~lval_raw:lval ~rval_raw:rval (* set top-level variable to updated value *) | None -> set_savetop ~ctx (Analyses.ask_of_ctx ctx) ctx.global ctx.local lval_val lval_t rval_val ~lval_raw:lval ~rval_raw:rval end @@ -1759,7 +1759,7 @@ struct let body ctx f = (* First we create a variable-initvalue pair for each variable *) - let init_var v = (AD.from_var v, v.vtype, VD.init_value ~varAttr:v.vattr v.vtype) in + let init_var v = (AD.of_var v, v.vtype, VD.init_value ~varAttr:v.vattr v.vtype) in (* Apply it to all the locals and then assign them all *) let inits = List.map init_var f.slocals in set_many ~ctx (Analyses.ask_of_ctx ctx) ctx.global ctx.local inits @@ -2253,8 +2253,8 @@ struct | Some lv -> let heap_var = if (get_bool "sem.malloc.fail") - then AD.join (AD.from_var (heap_var ctx)) AD.null_ptr - else AD.from_var (heap_var ctx) + then AD.join (AD.of_var (heap_var ctx)) AD.null_ptr + else AD.of_var (heap_var ctx) in (* ignore @@ printf "malloc will allocate %a bytes\n" ID.pretty (eval_int ctx.ask gs st size); *) set_many ~ctx (Analyses.ask_of_ctx ctx) gs st [(heap_var, TVoid [], Blob (VD.bot (), eval_int (Analyses.ask_of_ctx ctx) gs st size, true)); @@ -2272,8 +2272,8 @@ struct let ik = Cilfacade.ptrdiff_ikind () in let blobsize = ID.mul (ID.cast_to ik @@ eval_int (Analyses.ask_of_ctx ctx) gs st size) (ID.cast_to ik @@ eval_int (Analyses.ask_of_ctx ctx) gs st n) 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 (Analyses.ask_of_ctx ctx) gs st [(add_null (AD.from_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.one) (Blob (VD.bot (), blobsize, false)))); - (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.from_var_offset (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset)))))] + set_many ~ctx (Analyses.ask_of_ctx ctx) gs st [(add_null (AD.of_var heap_var), TVoid [], Array (CArrays.make (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.one) (Blob (VD.bot (), blobsize, false)))); + (eval_lv (Analyses.ask_of_ctx ctx) gs st lv, (Cilfacade.typeOfLval lv), Address (add_null (AD.of_mval (heap_var, `Index (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero, `NoOffset)))))] | _ -> st end | Realloc { ptr = p; size }, _ -> @@ -2293,7 +2293,7 @@ struct let p_addr_get = get ask gs st p_addr' None in (* implicitly includes join of malloc value (VD.bot) *) let size_int = eval_int ask gs st size in let heap_val:value = Blob (p_addr_get, size_int, true) in (* copy old contents with new size *) - let heap_addr = AD.from_var (heap_var ctx) in + let heap_addr = AD.of_var (heap_var ctx) in let heap_addr' = if get_bool "sem.malloc.fail" then AD.join heap_addr AD.null_ptr @@ -2344,7 +2344,7 @@ struct in let rv = ensure_not_zero @@ eval_rv ask ctx.global ctx.local value in let t = Cilfacade.typeOf value in - set ~ctx ~t_override:t ask ctx.global ctx.local (AD.from_var !longjmp_return) t rv (* Not raising Deadcode here, deadcode is raised at a higher level! *) + set ~ctx ~t_override:t ask ctx.global ctx.local (AD.of_var !longjmp_return) t rv (* Not raising Deadcode here, deadcode is raised at a higher level! *) | _, _ -> let st = special_unknown_invalidate ctx (Analyses.ask_of_ctx ctx) gs st f args @@ -2612,7 +2612,7 @@ struct let e_d' = WideningTokens.with_side_tokens (WideningTokens.TS.of_list uuids) (fun () -> CPA.fold (fun x v acc -> - let addr: AD.t = AD.from_var_offset (x, `NoOffset) in + let addr: AD.t = AD.of_mval (x, `NoOffset) in set (Analyses.ask_of_ctx ctx) ~ctx ~invariant:false ctx.global acc addr x.vtype v ) e_d.cpa ctx.local ) diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index f838c9a12a..151bc94a91 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -62,7 +62,7 @@ struct let protected_vars (ask: Q.ask): varinfo list = let module VS = Set.Make (CilType.Varinfo) in Q.LS.fold (fun (v, _) acc -> - let m = ValueDomain.Addr.from_var v in (* TODO: don't ignore offsets *) + let m = ValueDomain.Addr.of_var v in (* TODO: don't ignore offsets *) Q.LS.fold (fun l acc -> VS.add (fst l) acc (* always `NoOffset from mutex analysis *) ) (ask.f (Q.MustProtectedVars {mutex = m; write = true})) acc @@ -132,7 +132,7 @@ struct else let ls = ask.f Queries.MustLockset in Q.LS.fold (fun (var, offs) acc -> - Lockset.add (Lock.from_var_offset (var, Lock.Offs.of_exp offs)) acc + Lockset.add (Lock.of_mval (var, Lock.Offs.of_exp offs)) acc ) ls (Lockset.empty ()) (* TODO: reversed SetDomain.Hoare *) diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index 0120db82f3..656e1e6f14 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -24,16 +24,16 @@ struct (* We just had to dereference an lval --- warn if it was null *) let warn_lval (st:D.t) (v :Addr.Mval.t) : unit = try - if D.exists (fun x -> GobOption.exists (fun x -> is_prefix_of x v) (Addr.to_var_offset x)) st + if D.exists (fun x -> GobOption.exists (fun x -> is_prefix_of x v) (Addr.to_mval x)) st then - let var = Addr.from_var_offset v in + let var = Addr.of_mval v in Messages.warn ~category:Messages.Category.Behavior.Undefined.nullpointer_dereference "Possible dereferencing of null on variable '%a'." Addr.pretty var with SetDomain.Unsupported _ -> () (* Warn null-lval dereferences, but not normal (null-) lvals*) let rec warn_deref_exp (a: Queries.ask) (st:D.t) (e:exp): unit = let warn_lval_mem e offs = - (* begin try List.iter (warn_lval st) (AD.to_var_offset (BS.eval_lv gl s (Mem e, offs))) + (* begin try List.iter (warn_lval st) (AD.to_mval (BS.eval_lv gl s (Mem e, offs))) with SetDomain.Unsupported _ -> () end;*) match e with | Lval (Var v, offs) -> @@ -83,11 +83,11 @@ struct | f :: fs -> match unrollType f.ftype with | TComp ({cfields=ffs; _},_) -> add_fields base fs (List.rev_append (add_fields (f::base) ffs []) acc) - | _ -> add_fields base fs ((Addr.from_var_offset (v,make_offs (f::base))) :: acc) + | _ -> add_fields base fs ((Addr.of_mval (v,make_offs (f::base))) :: acc) in match unrollType v.vtype with | TComp ({cfields=fs; _},_) -> add_fields [] fs [] - | _ -> [Addr.from_var v] + | _ -> [Addr.of_var v] (* Remove null values from state that are unreachable from exp.*) let remove_unreachable (ask: Queries.ask) (args: exp list) (st: D.t) : D.t = @@ -95,7 +95,7 @@ struct let do_exp e = match ask.f (Queries.ReachableFrom e) with | a when not (Queries.LS.is_top a) -> - let to_extra (v,o) xs = AD.from_var_offset (v, Offs.of_exp o) :: xs in + let to_extra (v,o) xs = AD.of_mval (v, Offs.of_exp o) :: xs in Queries.LS.fold to_extra (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) [] (* Ignore soundness warnings, as invalidation proper will raise them. *) | _ -> [] @@ -129,7 +129,7 @@ struct match ask.f (Queries.MayPointTo (mkAddrOf lv)) with | a when not (Queries.LS.is_top a) && not (Queries.LS.mem (dummyFunDec.svar,`NoOffset) a) -> let one_addr_might (v,o) = - D.exists (fun x -> GobOption.exists (fun x -> is_prefix_of (v, Offs.of_exp o) x) (Addr.to_var_offset x)) st + D.exists (fun x -> GobOption.exists (fun x -> is_prefix_of (v, Offs.of_exp o) x) (Addr.to_mval x)) st in Queries.LS.exists one_addr_might a | _ -> false @@ -144,7 +144,7 @@ struct warn_deref_exp (Analyses.ask_of_ctx ctx) ctx.local rval; match get_concrete_exp rval ctx.global ctx.local, get_concrete_lval (Analyses.ask_of_ctx ctx) lval with | Some rv , Some (Var vt,ot) when might_be_null (Analyses.ask_of_ctx ctx) rv ctx.global ctx.local -> - D.add (Addr.from_var_offset (vt,ot)) ctx.local + D.add (Addr.of_mval (vt,ot)) ctx.local | _ -> ctx.local let branch ctx (exp:exp) (tv:bool) : D.t = @@ -185,7 +185,7 @@ struct match lval, D.mem (return_addr ()) au with | Some lv, true -> begin match get_concrete_lval (Analyses.ask_of_ctx ctx) lv with - | Some (Var v,ofs) -> D.add (Addr.from_var_offset (v,ofs)) ctx.local + | Some (Var v,ofs) -> D.add (Addr.of_mval (v,ofs)) ctx.local | _ -> ctx.local end | _ -> ctx.local @@ -200,7 +200,7 @@ struct match get_concrete_lval (Analyses.ask_of_ctx ctx) lv with | Some (Var v, offs) -> ctx.split ctx.local [Events.SplitBranch ((Lval lv), true)]; - ctx.split (D.add (Addr.from_var_offset (v,offs)) ctx.local) [Events.SplitBranch ((Lval lv), false)]; + ctx.split (D.add (Addr.of_mval (v,offs)) ctx.local) [Events.SplitBranch ((Lval lv), false)]; raise Analyses.Deadcode | _ -> ctx.local end @@ -214,7 +214,7 @@ struct let exitstate v = D.empty () let init marshal = - return_addr_ := Addr.from_var (Cilfacade.create_var @@ makeVarinfo false "RETURN" voidType) + return_addr_ := Addr.of_var (Cilfacade.create_var @@ makeVarinfo false "RETURN" voidType) end let _ = diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index e6da4fd329..853005de87 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -16,7 +16,7 @@ struct M.warn ~category:M.Category.Behavior.Undefined.double_locking "Acquiring a (possibly non-recursive) mutex that may be already held"; ctx.local in - match D.Addr.to_var_offset l with + match D.Addr.to_mval l with | Some (v,o) -> (let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in match mtype with @@ -31,7 +31,7 @@ struct let remove ctx l = if not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; - match D.Addr.to_var_offset l with + match D.Addr.to_mval l with | Some (v,o) -> (let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in match mtype with diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 93c114e1d4..9029c1b4a1 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -182,7 +182,7 @@ struct | Queries.MustLockset -> let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in let ls = Mutexes.fold (fun addr ls -> - match Addr.to_var_offset addr with + match Addr.to_mval addr with | Some (var, offs) -> Queries.LS.add (var, Addr.Offs.to_exp offs) ls | None -> ls ) held_locks (Queries.LS.empty ()) @@ -190,7 +190,7 @@ struct ls | Queries.MustBeAtomic -> let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in - Mutexes.mem (LockDomain.Addr.from_var LF.verifier_atomic_var) held_locks + Mutexes.mem (LockDomain.Addr.of_var LF.verifier_atomic_var) held_locks | Queries.MustProtectedVars {mutex = m; write} -> let protected = GProtected.get ~write Strong (G.protected (ctx.global (V.protected m))) in VarSet.fold (fun v acc -> diff --git a/src/analyses/mutexEventsAnalysis.ml b/src/analyses/mutexEventsAnalysis.ml index 54ae92d8bb..24e5dd07d8 100644 --- a/src/analyses/mutexEventsAnalysis.ml +++ b/src/analyses/mutexEventsAnalysis.ml @@ -20,7 +20,7 @@ struct (* TODO: Lval *) let eval_exp_addr (a: Queries.ask) exp = - let gather_addr (v,o) b = ValueDomain.Addr.from_var_offset (v, Addr.Offs.of_exp o) :: b in + let gather_addr (v,o) b = ValueDomain.Addr.of_mval (v, Addr.Offs.of_exp o) :: b in match a.f (Queries.MayPointTo exp) with | a when Queries.LS.is_top a -> [Addr.UnknownPtr] @@ -57,12 +57,12 @@ struct let return ctx exp fundec : D.t = (* deprecated but still valid SV-COMP convention for atomic block *) if get_bool "ana.sv-comp.functions" && String.starts_with fundec.svar.vname "__VERIFIER_atomic_" then - ctx.emit (Events.Unlock (LockDomain.Addr.from_var LF.verifier_atomic_var)) + ctx.emit (Events.Unlock (LockDomain.Addr.of_var LF.verifier_atomic_var)) let body ctx f : D.t = (* deprecated but still valid SV-COMP convention for atomic block *) if get_bool "ana.sv-comp.functions" && String.starts_with f.svar.vname "__VERIFIER_atomic_" then - ctx.emit (Events.Lock (LockDomain.Addr.from_var LF.verifier_atomic_var, true)) + ctx.emit (Events.Lock (LockDomain.Addr.of_var LF.verifier_atomic_var, true)) let special (ctx: (unit, _, _, _) ctx) lv f arglist : D.t = let remove_rw x = x in diff --git a/src/analyses/pthreadSignals.ml b/src/analyses/pthreadSignals.ml index f31f5cfa4e..eb8e5567e6 100644 --- a/src/analyses/pthreadSignals.ml +++ b/src/analyses/pthreadSignals.ml @@ -19,7 +19,7 @@ struct (* TODO: Lval *) let eval_exp_addr (a: Queries.ask) exp = - let gather_addr (v,o) b = ValueDomain.Addr.from_var_offset (v, ValueDomain.Addr.Offs.of_exp o) :: b in + let gather_addr (v,o) b = ValueDomain.Addr.of_mval (v, ValueDomain.Addr.Offs.of_exp o) :: b in match a.f (Queries.MayPointTo exp) with | a when not (Queries.LS.is_top a) && not (Queries.LS.mem (dummyFunDec.svar,`NoOffset) a) -> Queries.LS.fold gather_addr (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) [] @@ -65,7 +65,7 @@ struct end in let open Signalled in - let add_if_singleton conds = match conds with | [a] -> Signals.add (ValueDomain.Addr.from_var a) ctx.local | _ -> ctx.local in + let add_if_singleton conds = match conds with | [a] -> Signals.add (ValueDomain.Addr.of_var a) ctx.local | _ -> ctx.local in let conds = possible_vinfos (Analyses.ask_of_ctx ctx) cond in (match List.fold_left (fun acc cond -> can_be_signalled cond ||| acc) Never conds with | PossiblySignalled -> add_if_singleton conds diff --git a/src/analyses/symbLocks.ml b/src/analyses/symbLocks.ml index 0c23d5a37b..d8cebf51d2 100644 --- a/src/analyses/symbLocks.ml +++ b/src/analyses/symbLocks.ml @@ -155,7 +155,7 @@ struct let one_lockstep (_,a,m) xs = match m with | AddrOf (Var v,o) -> - let lock = ILock.from_var_offset (v, o) in + let lock = ILock.of_mval (v, o) in A.add (`Right lock) xs | _ -> Messages.info ~category:Unsound "Internal error: found a strange lockstep pattern."; diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 16001c74c5..8e90561002 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -25,7 +25,7 @@ struct let reachable (ask: Queries.ask) e: D.t = match ask.f (Queries.ReachableFrom e) with | a when not (Queries.LS.is_top a) -> - (* let to_extra (v,o) set = D.add (Addr.from_var_offset (v, cut_offset o)) set in *) + (* let to_extra (v,o) set = D.add (Addr.of_mval (v, cut_offset o)) set in *) let to_extra (v,o) set = D.add v set in Queries.LS.fold to_extra (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) (D.empty ()) (* Ignore soundness warnings, as invalidation proper will raise them. *) @@ -36,7 +36,7 @@ struct let mpt (ask: Queries.ask) e: D.t = match ask.f (Queries.MayPointTo e) with | a when not (Queries.LS.is_top a) -> - (* let to_extra (v,o) set = D.add (Addr.from_var_offset (v, cut_offset o)) set in *) + (* let to_extra (v,o) set = D.add (Addr.of_mval (v, cut_offset o)) set in *) let to_extra (v,o) set = D.add v set in Queries.LS.fold to_extra (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) (D.empty ()) (* Ignore soundness warnings, as invalidation proper will raise them. *) diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index a9cc5247ee..26f1cfba17 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -83,20 +83,20 @@ struct List.fold_left f [] (access_one_byval a false rval) let vars a (rval:exp) : Addr.t list = - List.map Addr.from_var_offset (varoffs a rval) + List.map Addr.of_mval (varoffs a rval) let is_prefix_of m1 m2 = Option.is_some (Addr.Mval.prefix m1 m2) (* Does it contain non-initialized variables? *) let is_expr_initd a (expr:exp) (st:D.t) : bool = let variables = vars a expr in - let raw_vars = List.filter_map Addr.to_var_offset variables in + let raw_vars = List.filter_map Addr.to_mval variables in let will_addr_init (t:bool) a = let f addr = - GobOption.exists (is_prefix_of a) (Addr.to_var_offset addr) + GobOption.exists (is_prefix_of a) (Addr.to_mval addr) in if D.exists f st then begin - M.error ~category:M.Category.Behavior.Undefined.uninitialized ~tags:[CWE 457] "Uninitialized variable %a accessed." Addr.pretty (Addr.from_var_offset a); + M.error ~category:M.Category.Behavior.Undefined.uninitialized ~tags:[CWE 457] "Uninitialized variable %a accessed." Addr.pretty (Addr.of_mval a); false end else t in @@ -104,7 +104,7 @@ struct let remove_if_prefix (pr: Addr.Mval.t) (uis: D.t) : D.t = let f ad = - let vals = Addr.to_var_offset ad in + let vals = Addr.to_mval ad in GobOption.for_all (fun a -> not (is_prefix_of pr a)) vals in D.filter f uis @@ -129,7 +129,7 @@ struct | x::xs, y::ys -> [] (* found a mismatch *) | _ -> - M.info ~category:Unsound "Failed to analyze union at point %a -- did not find %s" Addr.pretty (Addr.from_var_offset (v,rev cx)) tf.fname; + M.info ~category:Unsound "Failed to analyze union at point %a -- did not find %s" Addr.pretty (Addr.of_mval (v,rev cx)) tf.fname; [] in let utar, uoth = unrollType target, unrollType other in @@ -157,7 +157,7 @@ struct (* step into all other fields *) List.concat (List.rev_map (fun oth_f -> get_pfx v (`Field (oth_f, cx)) ofs utar oth_f.ftype) c2.cfields) | _ -> - M.info ~category:Unsound "Failed to analyze union at point %a" Addr.pretty (Addr.from_var_offset (v,rev cx)); + M.info ~category:Unsound "Failed to analyze union at point %a" Addr.pretty (Addr.of_mval (v,rev cx)); [] @@ -181,12 +181,12 @@ struct | f :: fs -> match unrollType f.ftype with | TComp ({cfields=ffs; _},_) -> add_fields base fs (List.rev_append (add_fields (f::base) ffs []) acc) - | _ -> add_fields base fs ((Addr.from_var_offset (v,make_offs (f::base))) :: acc) + | _ -> add_fields base fs ((Addr.of_mval (v,make_offs (f::base))) :: acc) in match unrollType v.vtype with | TComp ({cfields=fs; _},_) -> add_fields [] fs [] - | _ -> [Addr.from_var v] + | _ -> [Addr.of_var v] let remove_unreachable (ask: Queries.ask) (args: exp list) (st: D.t) : D.t = @@ -194,7 +194,7 @@ struct let do_exp e = match ask.f (Queries.ReachableFrom e) with | a when not (Queries.LS.is_top a) -> - let to_extra (v,o) xs = AD.from_var_offset (v, Addr.Offs.of_exp o) :: xs in + let to_extra (v,o) xs = AD.of_mval (v, Addr.Offs.of_exp o) :: xs in Queries.LS.fold to_extra (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) [] (* Ignore soundness warnings, as invalidation proper will raise them. *) | _ -> [] diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 95c7166a97..555f648f47 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -42,7 +42,7 @@ struct ) (* strings *) - let from_string x = StrPtr (Some x) + let of_string x = StrPtr (Some x) let to_string = function | StrPtr (Some x) -> Some x | _ -> None @@ -82,8 +82,8 @@ struct | Addr (x,_) -> Basetype.Variables.to_group x | _ -> Some Basetype.Variables.Local - let from_var x = Addr (x, `NoOffset) - let from_var_offset (x, o) = Addr (x, o) + let of_var x = Addr (x, `NoOffset) + let of_mval (x, o) = Addr (x, o) let to_var = function | Addr (x,_) -> Some x @@ -94,7 +94,7 @@ struct let to_var_must = function | Addr (x,`NoOffset) -> Some x | _ -> None - let to_var_offset = function + let to_mval = function | Addr (x, o) -> Some (x, o) | _ -> None @@ -296,17 +296,17 @@ struct with (* WTF? Returns TVoid when it is unknown and stuff??? *) | _ -> voidType - let from_var x = singleton (Addr.from_var x) - let from_var_offset x = singleton (Addr.from_var_offset x) + let of_var x = singleton (Addr.of_var x) + let of_mval x = singleton (Addr.of_mval x) let to_var_may x = List.filter_map Addr.to_var_may (elements x) let to_var_must x = List.filter_map Addr.to_var_must (elements x) - let to_var_offset x = List.filter_map Addr.to_var_offset (elements x) + let to_mval x = List.filter_map Addr.to_mval (elements x) let is_definite x = match elements x with | [x] when Addr.is_definite x -> true | _ -> false (* strings *) - let from_string x = singleton (Addr.from_string x) + let of_string x = singleton (Addr.of_string x) let to_string x = List.filter_map Addr.to_string (elements x) @@ -327,7 +327,7 @@ struct (* helper functions *) let extract_lval_string = function - | Some s -> from_string s + | Some s -> of_string s | None -> null_ptr in let compute_substring s1 s2 = try diff --git a/src/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml index a6b206669f..fd2fde56f1 100644 --- a/src/cdomains/addressDomain_intf.ml +++ b/src/cdomains/addressDomain_intf.ml @@ -10,7 +10,7 @@ sig include Printable.S with type t := t (** @closed *) include MapDomain.Groupable with type t := t (** @closed *) - val from_string: string -> t + val of_string: string -> t val to_string: t -> string option val to_c_string: t -> string option val to_n_c_string: int -> t -> string option @@ -25,11 +25,10 @@ sig val is_definite: t -> bool val add_offset: t -> Mval.idx Offset.t -> t - (* TODO: rename to of_* *) - val from_var: GoblintCil.varinfo -> t + val of_var: GoblintCil.varinfo -> t (** Creates an address from variable. *) - val from_var_offset: Mval.t -> t + val of_mval: Mval.t -> t (** Creates an address from a variable and offset. *) val to_var: t -> GoblintCil.varinfo option @@ -39,7 +38,7 @@ sig val to_var_must: t -> GoblintCil.varinfo option (** Strips the varinfo out of the address representation. *) - val to_var_offset: t -> Mval.t option + val to_mval: t -> Mval.t option (** Get the offset *) val to_exp: t -> GoblintCil.exp @@ -97,19 +96,19 @@ sig val may_be_unknown: t -> bool val is_element: Addr.t -> t -> bool - val from_var: GoblintCil.varinfo -> t - val from_var_offset: Mval.t -> t + val of_var: GoblintCil.varinfo -> t + val of_mval: Mval.t -> t val of_int: ID.t -> t val to_var_may: t -> GoblintCil.varinfo list val to_var_must: t -> GoblintCil.varinfo list - val to_var_offset: t -> Mval.t list + val to_mval: t -> Mval.t list val to_int: t -> ID.t val to_bool: t -> bool option val type_of: t -> GoblintCil.typ - val from_string: string -> t + val of_string: string -> t val to_string: t -> string list val to_string_length: t -> ID.t val substring_extraction: t -> t -> t diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 0e5eb7dd35..3a6ea3b52d 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -51,18 +51,18 @@ struct true let add (addr,rw) set = - match (Addr.to_var_offset addr) with + match (Addr.to_mval addr) with | Some (_,x) when Offs.is_definite x -> add (addr,rw) set | _ -> set let remove (addr,rw) set = let collect_diff_varinfo_with (vi,os) (addr,rw) = - match (Addr.to_var_offset addr) with + match (Addr.to_mval addr) with | Some (v,o) when CilType.Varinfo.equal vi v -> not (may_be_same_offset o os) | Some (v,o) -> true | None -> false in - match (Addr.to_var_offset addr) with + match (Addr.to_mval addr) with | Some (_,x) when Offs.is_definite x -> remove (addr,rw) set | Some x -> filter (collect_diff_varinfo_with x) set | _ -> top () diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index 71aa6cc4ca..4a44911a53 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -314,5 +314,5 @@ struct | Index (_,o) -> `Index (Idx.Unknown, conv_const_offset o) | Field (f,o) -> `Field (f, conv_const_offset o) - let from_var_offset (v, o) = from_var_offset (v, conv_const_offset o) + let of_mval (v, o) = of_mval (v, conv_const_offset o) end From af12112ebc11663981bd5b1f37821a9c6f3fed9a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 16:10:48 +0300 Subject: [PATCH 381/518] Clean up and optimize some AddressSet functions --- src/analyses/base.ml | 2 +- src/cdomains/addressDomain.ml | 20 +++++++++----------- src/cdomains/addressDomain_intf.ml | 3 +-- 3 files changed, 11 insertions(+), 14 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 239b3dfe04..f7248b83c6 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -646,7 +646,7 @@ struct | Top -> (empty, TS.top (), true) | Bot -> (empty, TS.bot (), false) | Address adrs when AD.is_top adrs -> (empty,TS.bot (), true) - | Address adrs -> (adrs,TS.bot (), AD.has_unknown adrs) + | Address adrs -> (adrs,TS.bot (), AD.may_be_unknown adrs) | Union (t,e) -> with_field (reachable_from_value e) t | Array a -> reachable_from_value (ValueDomain.CArrays.get (Queries.to_value_domain_ask (Analyses.ask_of_ctx ctx)) a (None, ValueDomain.ArrIdxDomain.top ())) | Blob (e,_,_) -> reachable_from_value e diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 555f648f47..1a784a89be 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -265,14 +265,14 @@ struct let null_ptr = singleton Addr.NullPtr let unknown_ptr = singleton Addr.UnknownPtr let not_null = unknown_ptr - let top_ptr = of_list Addr.([UnknownPtr; NullPtr]) - let may_be_unknown x = exists (fun e -> e = Addr.UnknownPtr) x + let top_ptr = of_list Addr.[UnknownPtr; NullPtr] + let is_element a x = cardinal x = 1 && Addr.equal (choose x) a - let is_null x = is_element Addr.NullPtr x - let is_not_null x = for_all (fun e -> e <> Addr.NullPtr) x - let may_be_null x = exists (fun e -> e = Addr.NullPtr) x + let is_null x = is_element Addr.NullPtr x + let may_be_null x = mem Addr.NullPtr x + let is_not_null x = not (may_be_null x) + let may_be_unknown x = mem Addr.UnknownPtr x let to_bool x = if is_null x then Some false else if is_not_null x then Some true else None - let has_unknown x = mem Addr.UnknownPtr x let of_int i = match ID.to_int i with @@ -301,9 +301,7 @@ struct let to_var_may x = List.filter_map Addr.to_var_may (elements x) let to_var_must x = List.filter_map Addr.to_var_must (elements x) let to_mval x = List.filter_map Addr.to_mval (elements x) - let is_definite x = match elements x with - | [x] when Addr.is_definite x -> true - | _ -> false + let is_definite x = cardinal x = 1 && Addr.is_definite (choose x) (* strings *) let of_string x = singleton (Addr.of_string x) @@ -420,8 +418,8 @@ struct | false, false -> join x y *) - (* TODO: overrides is_top, but not top? *) - let is_top a = mem Addr.UnknownPtr a + let is_top = may_be_unknown + let top () = top_ptr let merge uop cop x y = let no_null x y = diff --git a/src/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml index fd2fde56f1..4451d8d5cb 100644 --- a/src/cdomains/addressDomain_intf.ml +++ b/src/cdomains/addressDomain_intf.ml @@ -91,9 +91,8 @@ sig val is_null: t -> bool val is_not_null: t -> bool val may_be_null: t -> bool - val is_definite: t -> bool - val has_unknown: t -> bool val may_be_unknown: t -> bool + val is_definite: t -> bool val is_element: Addr.t -> t -> bool val of_var: GoblintCil.varinfo -> t From 800d11142695dea70e77f3475a8c3485539e99bc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Jun 2023 16:26:14 +0300 Subject: [PATCH 382/518] Fix LvalTest Compilation after AddressDomain renames --- unittest/cdomains/lvalTest.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/unittest/cdomains/lvalTest.ml b/unittest/cdomains/lvalTest.ml index 04e3a6e32f..387e3bde3e 100644 --- a/unittest/cdomains/lvalTest.ml +++ b/unittest/cdomains/lvalTest.ml @@ -9,15 +9,15 @@ module LV = AddressDomain.AddressLattice (Mval.MakeLattice (Offs)) let ikind = IntDomain.PtrDiffIkind.ikind () let a_var = Cil.makeGlobalVar "a" Cil.intPtrType -let a_lv = LV.from_var a_var +let a_lv = LV.of_var a_var let i_0 = ID.of_int ikind Z.zero -let a_lv_0 = LV.from_var_offset (a_var, `Index (i_0, `NoOffset)) +let a_lv_0 = LV.of_mval (a_var, `Index (i_0, `NoOffset)) let i_1 = ID.of_int ikind Z.one -let a_lv_1 = LV.from_var_offset (a_var, `Index (i_1, `NoOffset)) +let a_lv_1 = LV.of_mval (a_var, `Index (i_1, `NoOffset)) let i_top = ID.join i_0 i_1 -let a_lv_top = LV.from_var_offset (a_var, `Index (i_top, `NoOffset)) +let a_lv_top = LV.of_mval (a_var, `Index (i_top, `NoOffset)) let i_not_0 = ID.join i_1 (ID.of_int ikind (Z.of_int 2)) -let a_lv_not_0 = LV.from_var_offset (a_var, `Index (i_not_0, `NoOffset)) +let a_lv_not_0 = LV.of_mval (a_var, `Index (i_not_0, `NoOffset)) let assert_leq x y = From 0d71ae14256ab8cfd0324fb3a325abdc2038547a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 10:37:08 +0300 Subject: [PATCH 383/518] Move any_index_exp and all_index_exp into Index.Exp submodule --- src/analyses/base.ml | 2 +- src/cdomains/arrayDomain.ml | 14 +++++++------- src/cdomains/offset.ml | 17 ++++++++--------- src/cdomains/offset_intf.ml | 25 ++++++++++++++----------- src/framework/cfgTools.ml | 2 +- 5 files changed, 31 insertions(+), 29 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index f7248b83c6..49df005f83 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -1025,7 +1025,7 @@ struct match ofs with | NoOffset -> `NoOffset | Field (fld, ofs) -> `Field (fld, convert_offset a gs st ofs) - | Index (exp, ofs) when CilType.Exp.equal exp Offset.any_index_exp -> (* special offset added by convertToQueryLval *) + | Index (exp, ofs) when CilType.Exp.equal exp Offset.Index.Exp.any -> (* special offset added by convertToQueryLval *) `Index (IdxDom.top (), convert_offset a gs st ofs) | Index (exp, ofs) -> match eval_rv a gs st exp with diff --git a/src/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml index 2aac3ea8e1..c099a94f96 100644 --- a/src/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -88,7 +88,7 @@ struct let get ?(checkBounds=true) (ask: VDQ.t) a i = a let set (ask: VDQ.t) a (ie, i) v = match ie with - | Some ie when CilType.Exp.equal ie Offset.all_index_exp -> + | Some ie when CilType.Exp.equal ie Offset.Index.Exp.all -> v | _ -> join a v @@ -111,7 +111,7 @@ struct match offset with (* invariants for all indices *) | NoOffset when get_bool "witness.invariant.goblint" -> - let i_lval = Cil.addOffsetLval (Index (Offset.all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Offset.Index.Exp.all, NoOffset)) lval in value_invariant ~offset ~lval:i_lval x | NoOffset -> Invariant.none @@ -193,7 +193,7 @@ struct else ((update_unrolled_values min_i (Z.of_int ((factor ())-1))), (Val.join xr v)) let set ask (xl, xr) (ie, i) v = match ie with - | Some ie when CilType.Exp.equal ie Offset.all_index_exp -> + | Some ie when CilType.Exp.equal ie Offset.Index.Exp.all -> (* TODO: Doesn't seem to work for unassume because unrolled elements are top-initialized, not bot-initialized. *) (BatList.make (factor ()) v, v) | _ -> @@ -226,7 +226,7 @@ struct if Val.is_bot xr then Invariant.top () else if get_bool "witness.invariant.goblint" then ( - let i_lval = Cil.addOffsetLval (Index (Offset.all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Offset.Index.Exp.all, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) ) else @@ -481,10 +481,10 @@ struct let set_with_length length (ask:VDQ.t) x (i,_) a = if M.tracing then M.trace "update_offset" "part array set_with_length %a %s %a\n" pretty x (BatOption.map_default Basetype.CilExp.show "None" i) Val.pretty a; match i with - | Some ie when CilType.Exp.equal ie Offset.all_index_exp -> + | Some ie when CilType.Exp.equal ie Offset.Index.Exp.all -> (* TODO: Doesn't seem to work for unassume. *) Joint a - | Some i when CilType.Exp.equal i Offset.any_index_exp -> + | Some i when CilType.Exp.equal i Offset.Index.Exp.any -> (assert !AnalysisState.global_initialization; (* just joining with xm here assumes that all values will be set, which is guaranteed during inits *) (* the join is needed here! see e.g 30/04 *) let o = match x with Partitioned (_, (_, xm, _)) -> xm | Joint v -> v in @@ -765,7 +765,7 @@ struct match offset with (* invariants for all indices *) | NoOffset when get_bool "witness.invariant.goblint" -> - let i_lval = Cil.addOffsetLval (Index (Offset.all_index_exp, NoOffset)) lval in + let i_lval = Cil.addOffsetLval (Index (Offset.Index.Exp.all, NoOffset)) lval in value_invariant ~offset ~lval:i_lval (join_of_all_parts x) | NoOffset -> Invariant.none diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 9dbff8b91b..ebc7cfb1a9 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -4,10 +4,6 @@ open GoblintCil module M = Messages -let any_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") - -let all_index_exp = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") - module Index = struct @@ -21,14 +17,17 @@ struct let to_int _ = None end - module Exp: Printable with type t = exp = + module Exp = struct include CilType.Exp let name () = "exp index" + let any = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") + let all = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") + (* Override output *) let pretty () x = - if equal x any_index_exp then + if equal x any then Pretty.text "?" else dn_exp () x @@ -42,7 +41,7 @@ struct let equal_to _ _ = `Top (* TODO: more precise for definite indices *) let to_int _ = None (* TODO: more precise for definite indices *) - let top () = any_index_exp + let top () = any end end @@ -107,7 +106,7 @@ struct | `Index (i,o) -> let i_exp = match Idx.to_int i with | Some i -> Const (CInt (i, Cilfacade.ptrdiff_ikind (), Some (Z.to_string i))) - | None -> any_index_exp + | None -> Index.Exp.any in `Index (i_exp, to_exp o) | `Field (f,o) -> `Field (f, to_exp o) @@ -117,7 +116,7 @@ struct | `Index (i,o) -> let i_exp = match Idx.to_int i with | Some i -> Const (CInt (i, Cilfacade.ptrdiff_ikind (), Some (Z.to_string i))) - | None -> any_index_exp + | None -> Index.Exp.any in Index (i_exp, to_cil o) | `Field (f,o) -> Field (f, to_cil o) diff --git a/src/cdomains/offset_intf.ml b/src/cdomains/offset_intf.ml index 0ea3f8eff5..0c8277e0c4 100644 --- a/src/cdomains/offset_intf.ml +++ b/src/cdomains/offset_intf.ml @@ -74,7 +74,20 @@ sig (** Unit index. Usually represents an arbitrary index. *) - module Exp: Printable with type t = GoblintCil.exp + module Exp: + sig + include Printable with type t = GoblintCil.exp + + (** Special index expression for some unknown index. + Weakly updates array in assignment. + Used for exp.fast_global_inits. *) + val any: GoblintCil.exp + + (** Special index expression for all indices. + Strongly updates array in assignment. + Used for Goblint-specific witness invariants. *) + val all: GoblintCil.exp + end end exception Type_of_error of GoblintCil.typ * string @@ -100,14 +113,4 @@ sig val of_cil : GoblintCil.offset -> t val to_cil : t -> GoblintCil.offset end - - (** Special index expression for some unknown index. - Weakly updates array in assignment. - Used for exp.fast_global_inits. *) - val any_index_exp: GoblintCil.exp - - (** Special index expression for all indices. - Strongly updates array in assignment. - Used for Goblint-specific witness invariants. *) - val all_index_exp: GoblintCil.exp end diff --git a/src/framework/cfgTools.ml b/src/framework/cfgTools.ml index 19ecc38fb6..8f98a48e84 100644 --- a/src/framework/cfgTools.ml +++ b/src/framework/cfgTools.ml @@ -685,7 +685,7 @@ let getGlobalInits (file: file) : edges = lval in let rec any_index_offset = function - | Index (e,o) -> Index (Offset.any_index_exp, any_index_offset o) + | Index (e,o) -> Index (Offset.Index.Exp.any, any_index_offset o) | Field (f,o) -> Field (f, any_index_offset o) | NoOffset -> NoOffset in From 5850d84601ac032e1c7dcf5f46c335f1640c6cf7 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 10:42:46 +0300 Subject: [PATCH 384/518] Explain remaining Mval TODOs --- src/analyses/base.ml | 4 ++-- src/analyses/mutexEventsAnalysis.ml | 2 +- src/analyses/pthreadSignals.ml | 2 +- src/analyses/uninit.ml | 2 +- src/cdomains/musteqDomain.ml | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 49df005f83..6196baf847 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -404,7 +404,7 @@ struct | _, Bot -> Bot | _ -> VD.top () - (* TODO: move to Lval *) + (* TODO: Use AddressDomain for queries *) (* We need the previous function with the varinfo carried along, so we can * map it on the address sets. *) let add_offset_varinfo add ad = @@ -611,7 +611,7 @@ struct %> f (ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.base.context.interval" ~removeAttr:"base.no-interval" ~keepAttr:"base.interval" fd) drop_interval %> f (ContextUtil.should_keep ~isAttr:GobContext ~keepOption:"ana.base.context.interval_set" ~removeAttr:"base.no-interval_set" ~keepAttr:"base.interval_set" fd) drop_intervalSet - (* TODO: Lval *) + (* TODO: Use AddressDomain for queries *) let convertToQueryLval = function | ValueDomain.AD.Addr.Addr (v,o) -> [v, Addr.Offs.to_exp o] | _ -> [] diff --git a/src/analyses/mutexEventsAnalysis.ml b/src/analyses/mutexEventsAnalysis.ml index 24e5dd07d8..2c57fa360b 100644 --- a/src/analyses/mutexEventsAnalysis.ml +++ b/src/analyses/mutexEventsAnalysis.ml @@ -18,7 +18,7 @@ struct include UnitAnalysis.Spec let name () = "mutexEvents" - (* TODO: Lval *) + (* TODO: Use AddressDomain for queries *) let eval_exp_addr (a: Queries.ask) exp = let gather_addr (v,o) b = ValueDomain.Addr.of_mval (v, Addr.Offs.of_exp o) :: b in match a.f (Queries.MayPointTo exp) with diff --git a/src/analyses/pthreadSignals.ml b/src/analyses/pthreadSignals.ml index eb8e5567e6..036d1bd2c6 100644 --- a/src/analyses/pthreadSignals.ml +++ b/src/analyses/pthreadSignals.ml @@ -17,7 +17,7 @@ struct module C = MustSignals module G = SetDomain.ToppedSet (MHP) (struct let topname = "All Threads" end) - (* TODO: Lval *) + (* TODO: Use AddressDomain for queries *) let eval_exp_addr (a: Queries.ask) exp = let gather_addr (v,o) b = ValueDomain.Addr.of_mval (v, ValueDomain.Addr.Offs.of_exp o) :: b in match a.f (Queries.MayPointTo exp) with diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 26f1cfba17..c0368375f2 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -29,7 +29,7 @@ struct let threadspawn ctx lval f args fctx = ctx.local let exitstate v : D.t = D.empty () - (* TODO: Lval *) + (* TODO: Use AddressDomain for queries *) let access_address (ask: Queries.ask) write lv = match ask.f (Queries.MayPointTo (AddrOf lv)) with | a when not (Queries.LS.is_top a) -> diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index af5f89f316..8979ab939d 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -70,7 +70,7 @@ struct | `NoOffset -> false end -(* TODO: Mval *) +(* TODO: Use Mval.MakeLattice, but weakened with smaller offset signature. *) module VF = struct include Mval.MakePrintable (F) From ad0c7f4eba6d06c77da0bfe10ec3b13989d61546 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 11:05:18 +0300 Subject: [PATCH 385/518] Update AddressDomain.AddressLattice documentation --- src/cdomains/addressDomain_intf.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml index 4451d8d5cb..d79e79bb34 100644 --- a/src/cdomains/addressDomain_intf.ml +++ b/src/cdomains/addressDomain_intf.ml @@ -47,12 +47,12 @@ sig (** Finds the type of the address location. *) end - (** Lvalue lattice. + (** Address lattice. Actually a disjoint union of lattices without top or bottom. - Lvalues are grouped as follows: + Addresses are grouped as follows: - - Each {!Addr}, modulo precise index expressions in offset, is a sublattice with ordering induced by {!Offset}. + - Each {!Addr}, modulo precise index expressions in the offset, is a sublattice with ordering induced by {!Mval}. - {!NullPtr} is a singleton sublattice. - {!UnknownPtr} is a singleton sublattice. - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) From acdebe008ea97c4e24fc51634ac9013468e613b8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 11:08:25 +0300 Subject: [PATCH 386/518] Rename LvalMapDomain -> MvalMapDomain --- src/cdomains/fileDomain.ml | 2 +- src/cdomains/{lvalMapDomain.ml => mvalMapDomain.ml} | 4 ++-- src/cdomains/specDomain.ml | 2 +- src/goblint_lib.ml | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) rename src/cdomains/{lvalMapDomain.ml => mvalMapDomain.ml} (99%) diff --git a/src/cdomains/fileDomain.ml b/src/cdomains/fileDomain.ml index 3a10d7f8b7..ca585b8bce 100644 --- a/src/cdomains/fileDomain.ml +++ b/src/cdomains/fileDomain.ml @@ -2,7 +2,7 @@ open Batteries -module D = LvalMapDomain +module D = MvalMapDomain module Val = diff --git a/src/cdomains/lvalMapDomain.ml b/src/cdomains/mvalMapDomain.ml similarity index 99% rename from src/cdomains/lvalMapDomain.ml rename to src/cdomains/mvalMapDomain.ml index 2e62645d28..9d7625c4f5 100644 --- a/src/cdomains/lvalMapDomain.ml +++ b/src/cdomains/mvalMapDomain.ml @@ -1,4 +1,4 @@ -(** Domains for lvalue maps. *) +(** Domains for {{!Mval} mvalue} maps. *) open Batteries open GoblintCil @@ -73,7 +73,7 @@ struct module R = struct include Printable.StdLeaf type t = { key: k; loc: Node.t list; state: s } [@@deriving eq, ord, hash] - let name () = "LValMapDomainValue" + let name () = "MValMapDomainValue" let pretty () {key; loc; state} = Pretty.dprintf "{key=%a; loc=%a; state=%s}" Mval.Exp.pretty key (Pretty.d_list ", " Node.pretty) loc (Impl.string_of_state state) diff --git a/src/cdomains/specDomain.ml b/src/cdomains/specDomain.ml index 364657d2f7..75a9d8edc5 100644 --- a/src/cdomains/specDomain.ml +++ b/src/cdomains/specDomain.ml @@ -2,7 +2,7 @@ open Batteries -module D = LvalMapDomain +module D = MvalMapDomain module Val = diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 663886a062..00d6048a55 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -240,7 +240,7 @@ module RegionDomain = RegionDomain module FileDomain = FileDomain module StackDomain = StackDomain -module LvalMapDomain = LvalMapDomain +module MvalMapDomain = MvalMapDomain module SpecDomain = SpecDomain (** {2 Testing} From 511e39d82a943da6f99ad302f15227faf100b6e2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 11:13:11 +0300 Subject: [PATCH 387/518] Remove commented out cut_offset code from ThreadEscape --- src/analyses/threadEscape.ml | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 8e90561002..43d3ac4de5 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -25,7 +25,6 @@ struct let reachable (ask: Queries.ask) e: D.t = match ask.f (Queries.ReachableFrom e) with | a when not (Queries.LS.is_top a) -> - (* let to_extra (v,o) set = D.add (Addr.of_mval (v, cut_offset o)) set in *) let to_extra (v,o) set = D.add v set in Queries.LS.fold to_extra (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) (D.empty ()) (* Ignore soundness warnings, as invalidation proper will raise them. *) @@ -36,7 +35,6 @@ struct let mpt (ask: Queries.ask) e: D.t = match ask.f (Queries.MayPointTo e) with | a when not (Queries.LS.is_top a) -> - (* let to_extra (v,o) set = D.add (Addr.of_mval (v, cut_offset o)) set in *) let to_extra (v,o) set = D.add v set in Queries.LS.fold to_extra (Queries.LS.remove (dummyFunDec.svar, `NoOffset) a) (D.empty ()) (* Ignore soundness warnings, as invalidation proper will raise them. *) From 8f22303aa68f97bc486ccab59583c3e0bf15a964 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 12:02:32 +0300 Subject: [PATCH 388/518] Document Offset completely --- src/cdomains/offset.mli | 2 +- src/cdomains/offset_intf.ml | 73 +++++++++++++++++++++++++++++++++---- 2 files changed, 67 insertions(+), 8 deletions(-) diff --git a/src/cdomains/offset.mli b/src/cdomains/offset.mli index ae78921c9d..ceaa0af5a5 100644 --- a/src/cdomains/offset.mli +++ b/src/cdomains/offset.mli @@ -1,3 +1,3 @@ -(** Domains for offsets. *) +(** Domains for variable offsets, i.e. array indices and struct fields. *) include Offset_intf.Offset (** @inline *) diff --git a/src/cdomains/offset_intf.ml b/src/cdomains/offset_intf.ml index 0c8277e0c4..1ed2bf72e3 100644 --- a/src/cdomains/offset_intf.ml +++ b/src/cdomains/offset_intf.ml @@ -1,7 +1,7 @@ type 'i t = [ - | `NoOffset - | `Field of CilType.Fieldinfo.t * 'i t - | `Index of 'i * 'i t + | `NoOffset (** No offset. Marks the end of offset list. *) + | `Field of CilType.Fieldinfo.t * 'i t (** Offset starting with a struct field. *) + | `Index of 'i * 'i t (** Offset starting with an array index. *) ] [@@deriving eq, ord, hash] (* TODO: remove? *) @@ -14,40 +14,74 @@ struct module type Printable = sig include Printable.S (** @closed *) + val top: unit -> t + (** Unknown index. *) val equal_to: Z.t -> t -> [`Eq | `Neq | `Top] + (** Check semantic equality of an integer and the index. + + @return [`Eq] if definitely equal, [`Neq] if definitely not equal, [`Top] if unknown. *) + val to_int: t -> Z.t option + (** Convert to definite integer if possible. *) end module type Lattice = IntDomain.Z end exception Type_of_error of GoblintCil.typ * string -(** exception if the offset can't be followed completely *) module type Printable = sig type idx + (** Type of indices in offset. *) + include Printable.S with type t = idx offs (** @closed *) val is_definite: t -> bool + (** Whether offset has only definite integer indexing (and fields). *) + val contains_index: t -> bool + (** Whether offset contains any indexing. *) + val add_offset: t -> t -> t + (** [add_offset o1 o2] appends [o2] to [o1]. *) + val remove_offset: t -> t + (** Remove last indexing or field from offset. *) + val prefix: t -> t -> t option + (** [prefix o1 o2] checks if [o1] is a prefix of [o2]. + + @return [Some o] if it is (such that [add_offset o1 o = o2]), [None] if it is not. *) + val map_indices: (idx -> idx) -> t -> t + (** Apply function to all indexing. *) + val top_indices: t -> t + (** Change all indices to top indices. *) val to_cil: t -> GoblintCil.offset + (** Convert to CIL offset. *) + val to_exp: t -> GoblintCil.exp offs + (** Convert to Goblint offset with {!GoblintCil.exp} indices. *) val to_cil_offset: t -> GoblintCil.offset (** Version of {!to_cil} which drops indices for {!ArrayDomain}. *) val cmp_zero_offset: t -> [`MustZero | `MustNonzero | `MayZero] + (** Compare offset to zero offset. + + Zero indices and first fields of a struct are in the same physical memory location as the outer object. + + @return [`MustZero] if definitely zero, [`MustNonzero] if definitely not zero, [`MayZero] if unknown.*) val type_of: base:GoblintCil.typ -> t -> GoblintCil.typ + (** Type of the offset on the [base] type. + + @raise Type_of_error if could not follow offset completely. *) end module type Lattice = @@ -56,14 +90,28 @@ sig include Lattice.S with type t := t (** @closed *) val of_exp: GoblintCil.exp offs -> t + (** Convert from Goblint offset with {!GoblintCil.exp} indices. *) val to_index: ?typ:GoblintCil.typ -> t -> idx + (** Physical memory offset in bytes of the entire offset. + Used for {!semantic_equal}. + + @param typ base type. *) + val semantic_equal: typ1:GoblintCil.typ -> t -> typ2:GoblintCil.typ -> t -> bool option + (** Check semantic equality of two offsets. + + @param typ1 base type of first offset. + @param typ2 base type of second offset. + @return [Some true] if definitely equal, [Some false] if definitely not equal, [None] if unknown. *) end module type Offset = sig type nonrec 'i t = 'i t [@@deriving eq, ord, hash] + (** List of nested offsets. + + @param 'i Type of indices. *) (** Domains for offset indices. *) module Index: @@ -80,7 +128,7 @@ sig (** Special index expression for some unknown index. Weakly updates array in assignment. - Used for exp.fast_global_inits. *) + Used for [exp.fast_global_inits]. *) val any: GoblintCil.exp (** Special index expression for all indices. @@ -91,26 +139,37 @@ sig end exception Type_of_error of GoblintCil.typ * string + (** {!Printable.type_of} could not follow offset completely. *) module type Printable = Printable module type Lattice = Lattice module MakePrintable (Idx: Index.Printable): Printable with type idx = Idx.t + (** Make {!Printable} offset from {{!Index.Printable} printable indices}. *) + module MakeLattice (Idx: Index.Lattice): Lattice with type idx = Idx.t + (** Make offset {!Lattice} from {{!Index.Lattice} lattice indices}. *) - (** Offset instantiated with {!Index.Unit}. *) + (** Offset with {!Index.Unit} indices. *) module Unit: sig include Printable with type idx = unit val of_offs : 'i offs -> t + (** Convert from Goblint offset with arbitrary indices. *) + val of_cil : GoblintCil.offset -> t + (** Convert from CIL offset. *) end - (** Offset instantiated with {!Index.Exp}. *) + (** Offset with {!Index.Exp} indices. *) module Exp: sig include Printable with type idx = GoblintCil.exp + val of_cil : GoblintCil.offset -> t + (** Convert from CIL offset. *) + val to_cil : t -> GoblintCil.offset + (** Convert to CIL offset. *) end end From 36d777f2afc6dc5267f6bce7ccbcb45564da8190 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 12:06:33 +0300 Subject: [PATCH 389/518] Document Mval completely --- src/cdomains/mval_intf.ml | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/src/cdomains/mval_intf.ml b/src/cdomains/mval_intf.ml index 17581d23b0..ac0e6c4666 100644 --- a/src/cdomains/mval_intf.ml +++ b/src/cdomains/mval_intf.ml @@ -1,19 +1,34 @@ module type Printable = sig type idx + (** Type of indices in mvalue offset. *) + type t = GoblintCil.varinfo * idx Offset.t include Printable.S with type t := t (** @closed *) include MapDomain.Groupable with type t := t (** @closed *) val is_definite: t -> bool + (** Whether offset of mvalue has only definite integer indexing (and fields). *) + val add_offset: t -> idx Offset.t -> t + (** [add_offset m o] appends [o] to [m]. *) + val prefix: t -> t -> idx Offset.t option + (** [prefix m1 m2] checks if [m1] is a prefix of [m2]. + + @return [Some o] if it is (such that the variables are equal and [add_offset m1 o = m2]), [None] if it is not. *) + val top_indices: t -> t + (** Change all indices to top indices. *) val to_cil: t -> GoblintCil.lval + (** Convert to CIL lvalue. *) + val to_cil_exp: t -> GoblintCil.exp + (** Convert to CIL lvalue expression. *) val type_of: t -> GoblintCil.typ + (** Type of mvalue. *) end module type Lattice = @@ -22,6 +37,9 @@ sig include Lattice.S with type t := t (** @closed *) val semantic_equal: t -> t -> bool option + (** Check semantic equality of two mvalues. + + @return [Some true] if definitely equal, [Some false] if definitely not equal, [None] if unknown. *) end module type Mval = @@ -30,11 +48,14 @@ sig module type Lattice = Lattice module MakePrintable (Offs: Offset.Printable): Printable with type idx = Offs.idx + (** Make {!Printable} mvalue from {{!Offset.Printable} printable offset}. *) + module MakeLattice (Offs: Offset.Lattice): Lattice with type idx = Offs.idx + (** Make mvalue {!Lattice} from {{!Offset.Lattice} offset lattice}. *) - (** Mval instantiated with {!Offset.Unit}. *) + (** Mvalue with {!Offset.Unit} indices in offset. *) module Unit: Printable with type idx = unit - (** Mval instantiated with {!Offset.Unit}. *) + (** Mvalue with {!Offset.Exp} indices in offset. *) module Exp: Printable with type idx = GoblintCil.exp end From 8fe210b534f3f50c030098f706b8e3431d10f987 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 12:30:18 +0300 Subject: [PATCH 390/518] Document AddressDomain completely --- src/analyses/base.ml | 2 +- src/cdomains/addressDomain.ml | 2 +- src/cdomains/addressDomain_intf.ml | 87 ++++++++++++++++++++++++++---- 3 files changed, 78 insertions(+), 13 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 6196baf847..72cc6a614f 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -591,7 +591,7 @@ struct | Struct n -> Struct (ValueDomain.Structs.map replace_val n) | Union (f,v) -> Union (f,replace_val v) | Blob (n,s,o) -> Blob (replace_val n,s,o) - | Address x -> Address (ValueDomain.AD.map ValueDomain.Addr.drop_ints x) + | Address x -> Address (ValueDomain.AD.map ValueDomain.Addr.top_indices x) | x -> x in CPA.map replace_val st diff --git a/src/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml index 1a784a89be..d6b4ed577b 100644 --- a/src/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -146,7 +146,7 @@ struct | Addr x, Addr y -> Mval.leq x y | _ -> x = y - let drop_ints = function + let top_indices = function | Addr x -> Addr (Mval.top_indices x) | x -> x diff --git a/src/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml index d79e79bb34..e80922d7f9 100644 --- a/src/cdomains/addressDomain_intf.ml +++ b/src/cdomains/addressDomain_intf.ml @@ -1,9 +1,10 @@ module type AddressDomain = sig + module AddressBase (Mval: Printable.S): sig type t = - | Addr of Mval.t (** Pointer to offset of a variable. *) + | Addr of Mval.t (** Pointer to mvalue. *) | NullPtr (** NULL pointer. *) | UnknownPtr (** Unknown pointer. Could point to globals, heap and escaped variables. *) | StrPtr of string option (** String literal pointer. [StrPtr None] abstracts any string pointer *) @@ -11,10 +12,21 @@ sig include MapDomain.Groupable with type t := t (** @closed *) val of_string: string -> t + (** Convert string to {!StrPtr}. *) + val to_string: t -> string option + (** Convert {!StrPtr} to string if possible. *) + + (** C strings are different from OCaml strings as they are not processed after the first [NUL] byte, even though the OCaml string (and a C string literal) may be longer. *) + val to_c_string: t -> string option + (** Convert {!StrPtr} to C string if possible. *) + val to_n_c_string: int -> t -> string option + (** Convert {!StrPtr} to C string of given maximum length if possible. *) + val to_string_length: t -> int option + (** Find length of C string if possible. *) end module AddressPrintable (Mval: Mval.Printable): @@ -23,28 +35,34 @@ sig include MapDomain.Groupable with type t := t and type group = Basetype.Variables.group (** @closed *) val is_definite: t -> bool + (** Whether address is a [NULL] pointer or an mvalue that has only definite integer indexing (and fields). *) + val add_offset: t -> Mval.idx Offset.t -> t + (** [add_offset a o] appends [o] to an mvalue address [a]. *) val of_var: GoblintCil.varinfo -> t - (** Creates an address from variable. *) + (** Convert from variable (without offset). *) val of_mval: Mval.t -> t - (** Creates an address from a variable and offset. *) + (** Convert from mvalue. *) val to_var: t -> GoblintCil.varinfo option - (** Strips the varinfo out of the address representation. *) + (** Convert to variable if possible. *) val to_var_may: t -> GoblintCil.varinfo option + (** Convert to variable with any offset if possible. *) + val to_var_must: t -> GoblintCil.varinfo option - (** Strips the varinfo out of the address representation. *) + (** Convert to variable without offset if possible. *) val to_mval: t -> Mval.t option - (** Get the offset *) + (** Convert to mvalue if possible. *) val to_exp: t -> GoblintCil.exp + (** Convert to CIL expression. *) val type_of: t -> GoblintCil.typ - (** Finds the type of the address location. *) + (** Type of address. *) end (** Address lattice. @@ -61,55 +79,102 @@ sig include module type of AddressPrintable (Mval) include Lattice.S with type t := t (** @closed *) - val drop_ints: t -> t + val top_indices: t -> t + (** Change all indices to top indices. *) val semantic_equal: t -> t -> bool option - (** Semantic equal. [Some true] if definitely equal, [Some false] if definitely not equal, [None] otherwise *) + (** Check semantic equality of two addresses. + + @return [Some true] if definitely equal, [Some false] if definitely not equal, [None] if unknown. *) end - (** Lvalue lattice with sublattice representatives for {!DisjointDomain}. *) + (** Address lattice with sublattice representatives for {!DisjointDomain}. *) module AddressLatticeRepr (Mval: Mval.Lattice): sig include module type of AddressLattice (Mval) (** @closed *) module VariableRepr: DisjointDomain.Representative with type elt = t + (** Representative without mvalue offsets. *) module UnitOffsetRepr: DisjointDomain.Representative with type elt = t - (** Representatives for lvalue sublattices as defined by {!AddressLattice}. *) + (** Representative without mvalue offset indices. *) end + (** Address set lattice. + + @param Mval mvalue used in addresses. + @param ID integers used for conversions. *) module AddressSet (Mval: Mval.Lattice) (ID: IntDomain.Z): sig module Addr: module type of AddressLattice (Mval) include SetDomain.S with type elt = Addr.t (** @closed *) val null_ptr: t + (** Address set containing only the [NULL] pointer. *) + val unknown_ptr: t + (** Address set containing the unknown pointer, which is non-[NULL]. *) + val not_null: t + (** Address set containing the unknown pointer, which is non-[NULL]. *) + val top_ptr: t + (** Address set containing any pointer, [NULL] or not. *) val is_null: t -> bool + (** Whether address set contains only the [NULL] pointer. *) + val is_not_null: t -> bool + (** Whether address set does not contain the [NULL] pointer. *) + val may_be_null: t -> bool + (** Whether address set contains the [NULL] pointer. *) + val may_be_unknown: t -> bool + (** Whether address set contains the unknown pointer. *) + val is_definite: t -> bool + (** Whether address set is a single [NULL] pointer or mvalue that has only definite integer indexing (and fields). *) + val is_element: Addr.t -> t -> bool + (** Whether address set contains only the given address. *) val of_var: GoblintCil.varinfo -> t + (** Convert from variable (without offset). *) + val of_mval: Mval.t -> t + (** Convert from mvalue. *) + val of_int: ID.t -> t + (** Convert from integer. *) val to_var_may: t -> GoblintCil.varinfo list + (** Convert to variables with any offset. *) + val to_var_must: t -> GoblintCil.varinfo list + (** Convert to variables without offset. *) + val to_mval: t -> Mval.t list + (** Convert to mvalues. *) + val to_int: t -> ID.t + (** Convert to integer. *) + val to_bool: t -> bool option + (** Convert to boolean if possible. *) val type_of: t -> GoblintCil.typ + (** Type of address set. *) val of_string: string -> t + (** Convert from string literal. *) + val to_string: t -> string list + (** Convert to string literals. *) + val to_string_length: t -> ID.t + (** Find length of C string. *) + val substring_extraction: t -> t -> t val string_comparison: t -> t -> int option -> ID.t val string_writing_defined: t -> bool From b7bea9229aa4be3dcf93b72ac0b454bc80c56add Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 12:44:28 +0300 Subject: [PATCH 391/518] Describe mvalues in API docs --- src/goblint_lib.ml | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 00d6048a55..367e998a8d 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -192,15 +192,35 @@ module FlagHelper = FlagHelper Domains for {!Base} analysis. *) -module BaseDomain = BaseDomain -module ValueDomain = ValueDomain +(** {5 Numeric} *) + module IntDomain = IntDomain module FloatDomain = FloatDomain + +(** {5 Addresses} + + Memory locations are identified by {{!Mval} mvalues}, which consist of a {{!GoblintCil.varinfo} variable} and an {{!Offset.t} offset}. + Mvalues are used throughout Goblint, not just the {!Base} analysis. + + Addresses extend mvalues with [NULL], unknown pointers and string literals. *) + +module Mval = Mval +module Offset = Offset module AddressDomain = AddressDomain + +(** {5 Complex} *) + module StructDomain = StructDomain module UnionDomain = UnionDomain module ArrayDomain = ArrayDomain module JmpBufDomain = JmpBufDomain + +(** {5 Combined} + + These combine the above domains together for {!Base} analysis. *) + +module BaseDomain = BaseDomain +module ValueDomain = ValueDomain module ValueDomainQueries = ValueDomainQueries (** {4 Relational} @@ -229,8 +249,6 @@ module PthreadDomain = PthreadDomain (** {3 Other} *) module Basetype = Basetype -module Offset = Offset -module Mval = Mval module Lval = Lval module Access = Access module AccessDomain = AccessDomain From 5e231dc1e72ba9b0f0ef1008d7df83811fcc1a7c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 13:08:21 +0300 Subject: [PATCH 392/518] Add region analysis TODO about specific indices --- src/analyses/region.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/analyses/region.ml b/src/analyses/region.ml index 966e22dc35..6d2ae246c3 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -82,6 +82,7 @@ struct | Memory {exp = e; _} -> (* TODO: remove regions that cannot be reached from the var*) (* forget specific indices *) + (* TODO: If indices are topped, could they not be collected in the first place? *) Option.map (Lvals.of_list % List.map (Tuple2.map2 Offset.Exp.top_indices)) (get_region ctx e) (* transfer functions *) From ad6a2b0904bd16861ffe7e7ddebf64cde69dd269 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Mon, 5 Jun 2023 14:01:37 +0300 Subject: [PATCH 393/518] Add test with an escaping __thread variable Co-authored-by: Michael Schwarz --- .../04-mutex/83-thread-local-storage-escape.c | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 tests/regression/04-mutex/83-thread-local-storage-escape.c diff --git a/tests/regression/04-mutex/83-thread-local-storage-escape.c b/tests/regression/04-mutex/83-thread-local-storage-escape.c new file mode 100644 index 0000000000..6698b57baa --- /dev/null +++ b/tests/regression/04-mutex/83-thread-local-storage-escape.c @@ -0,0 +1,24 @@ +#include +#include + +__thread int myglobal; +pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + int* ptr = (int*) arg; + pthread_mutex_lock(&mutex1); + *ptr=*ptr+1; //RACE + pthread_mutex_unlock(&mutex1); + return NULL; +} + +int main(void) { + pthread_t id; + pthread_create(&id, NULL, t_fun, (void*) &myglobal); + pthread_mutex_lock(&mutex2); + myglobal=myglobal+1; //RACE + pthread_mutex_unlock(&mutex2); + pthread_join (id, NULL); + return 0; +} \ No newline at end of file From bbb851b3e50e2663733480aacbf9dc0f67b936d6 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Mon, 5 Jun 2023 14:04:50 +0300 Subject: [PATCH 394/518] Limit ignore of __thread variable accesses to only when v.vaddrof is false --- src/domains/access.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index c433d72c5d..9bd50a438f 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -20,7 +20,7 @@ let is_ignorable_type (t: typ): bool = let is_ignorable = function | None -> false - | Some (v,os) when hasAttribute "thread" v.vattr -> true (* Thread-Local Storage *) + | Some (v,os) when hasAttribute "thread" v.vattr && not (v.vaddrof) -> true (* Thread-Local Storage *) | Some (v,os) -> try isFunctionType v.vtype || is_ignorable_type v.vtype with Not_found -> false From 721ff9f6113651d0a1c8caaa157c941b4c78b26a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 14:30:21 +0300 Subject: [PATCH 395/518] Simplify Uninit is_expr_initd --- src/analyses/uninit.ml | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index c0368375f2..850bd677bd 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -82,25 +82,23 @@ struct let f vs (v,o,_) = (v,o) :: vs in List.fold_left f [] (access_one_byval a false rval) - let vars a (rval:exp) : Addr.t list = - List.map Addr.of_mval (varoffs a rval) - let is_prefix_of m1 m2 = Option.is_some (Addr.Mval.prefix m1 m2) (* Does it contain non-initialized variables? *) let is_expr_initd a (expr:exp) (st:D.t) : bool = - let variables = vars a expr in - let raw_vars = List.filter_map Addr.to_mval variables in - let will_addr_init (t:bool) a = + let mvals = varoffs a expr in + let will_mval_init (t:bool) mval = let f addr = - GobOption.exists (is_prefix_of a) (Addr.to_mval addr) + GobOption.exists (is_prefix_of mval) (Addr.to_mval addr) in - if D.exists f st then begin - M.error ~category:M.Category.Behavior.Undefined.uninitialized ~tags:[CWE 457] "Uninitialized variable %a accessed." Addr.pretty (Addr.of_mval a); + if D.exists f st then ( + M.error ~category:M.Category.Behavior.Undefined.uninitialized ~tags:[CWE 457] "Uninitialized variable %a accessed." Addr.Mval.pretty mval; false - end else - t in - List.fold_left will_addr_init true raw_vars + ) + else + t + in + List.fold_left will_mval_init true mvals let remove_if_prefix (pr: Addr.Mval.t) (uis: D.t) : D.t = let f ad = From 46c389f31b8f5369b1f291cdae5a6fe5d4edcfab Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Jun 2023 14:35:36 +0300 Subject: [PATCH 396/518] Remove Offset_intf TODO --- src/cdomains/offset_intf.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/offset_intf.ml b/src/cdomains/offset_intf.ml index 1ed2bf72e3..2bf3dedf6e 100644 --- a/src/cdomains/offset_intf.ml +++ b/src/cdomains/offset_intf.ml @@ -4,8 +4,8 @@ type 'i t = [ | `Index of 'i * 'i t (** Offset starting with an array index. *) ] [@@deriving eq, ord, hash] -(* TODO: remove? *) type 'i offs = 'i t [@@deriving eq, ord, hash] +(** Outer alias to allow referring to {!t} in inner signatures. *) module Index = struct From a7662f49af8f128871dbc92e5c35010b61a40f06 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 5 Jun 2023 13:48:45 +0200 Subject: [PATCH 397/518] Track multiplicities for mustLocks --- src/analyses/deadlock.ml | 2 +- src/analyses/locksetAnalysis.ml | 2 +- src/analyses/mayLocks.ml | 4 +- src/analyses/mutexAnalysis.ml | 84 +++++++++++++++++++++++-------- src/analyses/mutexTypeAnalysis.ml | 3 ++ 5 files changed, 70 insertions(+), 25 deletions(-) diff --git a/src/analyses/deadlock.ml b/src/analyses/deadlock.ml index c23d6f4294..38468f9edd 100644 --- a/src/analyses/deadlock.ml +++ b/src/analyses/deadlock.ml @@ -37,7 +37,7 @@ struct ) ctx.local; D.add after ctx.local - let remove ctx l = + let remove ctx ?(warn=true) l = let inLockAddrs (e, _, _) = Lock.equal l e in D.filter (neg inLockAddrs) ctx.local end diff --git a/src/analyses/locksetAnalysis.ml b/src/analyses/locksetAnalysis.ml index 2e9e08f03d..9f636471ae 100644 --- a/src/analyses/locksetAnalysis.ml +++ b/src/analyses/locksetAnalysis.ml @@ -30,7 +30,7 @@ sig module V: SpecSysVar val add: (D.t, G.t, D.t, V.t) ctx -> LockDomain.Lockset.Lock.t -> D.t - val remove: (D.t, G.t, D.t, V.t) ctx -> ValueDomain.Addr.t -> D.t + val remove: (D.t, G.t, D.t, V.t) ctx -> ?warn:bool -> ValueDomain.Addr.t -> D.t end module MakeMay (Arg: MayArg) = diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 0f636f6f7e..d8c85df4c6 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -29,8 +29,8 @@ struct else D.add l ctx.local - let remove ctx l = - if not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; + let remove ctx ?(warn=true) l = + if warn && not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; match D.Addr.to_var_offset l with | Some (v,o) -> (let mtype = ctx.ask (Queries.MutexType (v, Lval.OffsetNoIdx.of_offs o)) in diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 6b063067c0..c76209390b 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -15,7 +15,32 @@ module Spec = struct module Arg = struct - module D = Lockset + module Count = Lattice.Reverse( + Lattice.Chain (struct + let n () = 5 + let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x + end)) + + module Multiplicity = struct + include MapDomain.MapBot_LiftTop (ValueDomain.Addr) (Count) + let increment v x = + let current = find v x in + if current = (4) then + x + else + add v (current + 1) x + + let decrement v x = + let current = find v x in + if current = 0 then + (x, true) + else + (add v (current - 1) x, current-1 = 0) + end + module D = struct include Lattice.Prod(Lockset)(Multiplicity) + let empty () = (Lockset.empty (), Multiplicity.empty ()) + end + (** Global data is collected using dirty side-effecting. *) @@ -111,12 +136,26 @@ struct let create_protected protected = `Lifted2 protected end - let add ctx l = - D.add l ctx.local - - let remove ctx l = - if not (D.mem (l,true) ctx.local || D.mem (l,false) ctx.local) then M.warn "unlocking mutex which may not be held"; - D.remove (l, true) (D.remove (l, false) ctx.local) + let add ctx (l:Mutexes.elt*bool) = + let s,m = ctx.local in + let s' = Lockset.add l s in + match Addr.to_var_offset (fst l) with + | Some mval when MutexTypeAnalysis.must_be_recursive ctx mval -> + (s', Multiplicity.increment (fst l) m) + | _ -> (s', m) + + let remove ctx ?(warn=true) l = + let s, m = ctx.local in + let rm s = Lockset.remove (l, true) (Lockset.remove (l, false) s) in + if warn && (not (Lockset.mem (l,true) s || Lockset.mem (l,false) s)) then M.warn "unlocking mutex which may not be held"; + match Addr.to_var_offset l with + | Some mval when MutexTypeAnalysis.must_be_recursive ctx mval -> + let m',rmed = Multiplicity.decrement l m in + if rmed then + (rm s, m') + else + (s, m') + | _ -> (rm s, m) let remove_all ctx = (* Mutexes.iter (fun m -> @@ -124,7 +163,9 @@ struct ) (D.export_locks ctx.local); *) (* TODO: used to have remove_nonspecial, which kept v.vname.[0] = '{' variables *) M.warn "unlocking unknown mutex which may not be held"; - D.empty () + (Lockset.empty (), Multiplicity.empty ()) + + let empty () = (Lockset.empty (), Multiplicity.empty ()) end include LocksetAnalysis.MakeMust (Arg) let name () = "mutex" @@ -160,22 +201,23 @@ struct `Index (i_exp, conv_offset_inv o) let query ctx (type a) (q: a Queries.t): a Queries.result = + let ls, m = ctx.local in (* get the set of mutexes protecting the variable v in the given mode *) let protecting ~write mode v = GProtecting.get ~write mode (G.protecting (ctx.global (V.protecting v))) in let non_overlapping locks1 locks2 = Mutexes.is_empty @@ Mutexes.inter locks1 locks2 in match q with - | Queries.MayBePublic _ when Lockset.is_bot ctx.local -> false + | Queries.MayBePublic _ when Lockset.is_bot ls -> false | Queries.MayBePublic {global=v; write; protection} -> - let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in + let held_locks = Lockset.export_locks (Lockset.filter snd ls) in let protecting = protecting ~write protection v in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks ctx.local) then false else *) non_overlapping held_locks protecting - | Queries.MayBePublicWithout _ when Lockset.is_bot ctx.local -> false + | Queries.MayBePublicWithout _ when Lockset.is_bot ls -> false | Queries.MayBePublicWithout {global=v; write; without_mutex; protection} -> - let held_locks = Lockset.export_locks (Lockset.remove (without_mutex, true) (Lockset.filter snd ctx.local)) in + let held_locks = Lockset.export_locks @@ fst @@ Arg.remove ctx ~warn:false without_mutex in let protecting = protecting ~write protection v in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks (Lockset.remove (without_mutex, true) ctx.local)) then @@ -191,7 +233,7 @@ struct else *) Mutexes.leq mutex_lockset protecting | Queries.MustLockset -> - let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in + let held_locks = Lockset.export_locks (Lockset.filter snd ls) in let ls = Mutexes.fold (fun addr ls -> match Addr.to_var_offset addr with | Some (var, offs) -> Queries.LS.add (var, conv_offset_inv offs) ls @@ -200,7 +242,7 @@ struct in ls | Queries.MustBeAtomic -> - let held_locks = Lockset.export_locks (Lockset.filter snd ctx.local) in + let held_locks = Lockset.export_locks (Lockset.filter snd ls) in Mutexes.mem (LockDomain.Addr.from_var LF.verifier_atomic_var) held_locks | Queries.MustProtectedVars {mutex = m; write} -> let protected = GProtected.get ~write Strong (G.protected (ctx.global (V.protected m))) in @@ -234,17 +276,17 @@ struct struct include D let name () = "lock" - let may_race ls1 ls2 = + let may_race (ls1,_) (ls2,_) = (* not mutually exclusive *) - not @@ D.exists (fun ((m1, w1) as l1) -> + not @@ Lockset.exists (fun ((m1, w1) as l1) -> if w1 then (* write lock is exclusive with write lock or read lock *) - D.mem l1 ls2 || D.mem (m1, false) ls2 + Lockset.mem l1 ls2 || Lockset.mem (m1, false) ls2 else (* read lock is exclusive with just write lock *) - D.mem (m1, true) ls2 + Lockset.mem (m1, true) ls2 ) ls1 - let should_print ls = not (is_empty ls) + let should_print ls = not (Lockset.is_empty (fst ls)) end let access ctx (a: Queries.access) = @@ -260,8 +302,8 @@ struct (*privatization*) match var_opt with | Some v -> - if not (Lockset.is_bot octx.local) then - let locks = Lockset.export_locks (Lockset.filter snd octx.local) in + if not (Lockset.is_bot (fst octx.local)) then + let locks = Lockset.export_locks (Lockset.filter snd (fst octx.local)) in let write = match kind with | Write | Free -> true | Read -> false diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 3ce2fc3308..c3226fa4f9 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -71,5 +71,8 @@ struct | _ -> Queries.Result.top q end +let must_be_recursive ctx (v,o) = + ctx.ask (Queries.MutexType (v, Lval.OffsetNoIdx.of_offs o)) = `Lifted MutexAttrDomain.MutexKind.Recursive + let _ = MCP.register_analysis (module Spec : MCPSpec) From f453888ffcbeab951e63d5d809742e94afa5d1f0 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 5 Jun 2023 13:53:23 +0200 Subject: [PATCH 398/518] Add test for recursive mutex --- .../71-doublelocking/14-rec-dyn-no-race.c | 45 +++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 tests/regression/71-doublelocking/14-rec-dyn-no-race.c diff --git a/tests/regression/71-doublelocking/14-rec-dyn-no-race.c b/tests/regression/71-doublelocking/14-rec-dyn-no-race.c new file mode 100644 index 0000000000..b49f481eee --- /dev/null +++ b/tests/regression/71-doublelocking/14-rec-dyn-no-race.c @@ -0,0 +1,45 @@ +// PARAM: --set ana.activated[+] 'pthreadMutexType' +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; + +void* f1(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_lock(mut); //NOWARN + pthread_mutex_unlock(mut); + g = 8; //NORACE + pthread_mutex_unlock(mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_mutex_t mut; + + pthread_mutexattr_t attr; + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + pthread_mutex_init(&mut, &attr); + + + pthread_create(&t1,NULL,f1,&mut); + + + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_lock(&mut); //NOWARN + pthread_mutex_unlock(&mut); + g = 9; //NORACE + pthread_mutex_unlock(&mut); + + pthread_join(t1, NULL); + + + return 0; +} From d652f7aff1aff5331e4dbc6aa8957d700834c4db Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 5 Jun 2023 14:08:43 +0200 Subject: [PATCH 399/518] Add test for termination with nesting --- .../71-doublelocking/15-rec-dyn-nested.c | 41 +++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 tests/regression/71-doublelocking/15-rec-dyn-nested.c diff --git a/tests/regression/71-doublelocking/15-rec-dyn-nested.c b/tests/regression/71-doublelocking/15-rec-dyn-nested.c new file mode 100644 index 0000000000..d5dac9cd81 --- /dev/null +++ b/tests/regression/71-doublelocking/15-rec-dyn-nested.c @@ -0,0 +1,41 @@ +// PARAM: --set ana.activated[+] 'pthreadMutexType' +// Check we don't have a stack overflow because of tracking multiplicities +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; + +void f2(pthread_mutex_t* mut) { + int top1, top2; + pthread_mutex_lock(mut); + if(top1 == top2) { + // This would cause the number of contexts to explode + f2(mut); + } + pthread_mutex_unlock(mut); +} + +void* f1(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + f2(mut); + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_mutex_t mut; + + pthread_mutexattr_t attr; + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + pthread_mutex_init(&mut, &attr); + + + pthread_create(&t1,NULL,f1,&mut); + pthread_join(t1, NULL); + return 0; +} From da808f4c756b9e04e5192b4c012646c480931706 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 5 Jun 2023 15:37:09 +0200 Subject: [PATCH 400/518] Do not record multiplicites in accesses --- src/analyses/mutexAnalysis.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index c76209390b..4eaca1395d 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -274,9 +274,9 @@ struct module A = struct - include D + include Lockset let name () = "lock" - let may_race (ls1,_) (ls2,_) = + let may_race ls1 ls2 = (* not mutually exclusive *) not @@ Lockset.exists (fun ((m1, w1) as l1) -> if w1 then @@ -286,11 +286,11 @@ struct (* read lock is exclusive with just write lock *) Lockset.mem (m1, true) ls2 ) ls1 - let should_print ls = not (Lockset.is_empty (fst ls)) + let should_print ls = not (Lockset.is_empty ls) end let access ctx (a: Queries.access) = - ctx.local + fst ctx.local let event ctx e octx = match e with From 1565056dc776d66b1cf88be74082a7193ad83467 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 5 Jun 2023 15:46:45 +0200 Subject: [PATCH 401/518] Cleanup --- src/analyses/mutexAnalysis.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 4eaca1395d..f6d44b1670 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -278,15 +278,15 @@ struct let name () = "lock" let may_race ls1 ls2 = (* not mutually exclusive *) - not @@ Lockset.exists (fun ((m1, w1) as l1) -> + not @@ exists (fun ((m1, w1) as l1) -> if w1 then (* write lock is exclusive with write lock or read lock *) - Lockset.mem l1 ls2 || Lockset.mem (m1, false) ls2 + mem l1 ls2 || mem (m1, false) ls2 else (* read lock is exclusive with just write lock *) - Lockset.mem (m1, true) ls2 + mem (m1, true) ls2 ) ls1 - let should_print ls = not (Lockset.is_empty ls) + let should_print ls = not (is_empty ls) end let access ctx (a: Queries.access) = From 2836dedb126f5370bfb18ef3f8e2b929f34a70c2 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 6 Jun 2023 09:59:54 +0200 Subject: [PATCH 402/518] Fix lattice order --- src/analyses/mutexAnalysis.ml | 22 +++++--- .../16-rec-dyn-no-path-sense.c | 51 +++++++++++++++++++ 2 files changed, 65 insertions(+), 8 deletions(-) create mode 100644 tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index f6d44b1670..f9babec97f 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -15,17 +15,22 @@ module Spec = struct module Arg = struct - module Count = Lattice.Reverse( + module Multiplicity = struct + (* the maximum multiplicity which we keep track of precisely *) + let max_count () = 4 + + module Count = Lattice.Reverse( Lattice.Chain (struct - let n () = 5 - let names x = if x = (n () - 1) then "top" else Format.asprintf "%d" x - end)) + let n () = max_count () + 1 + let names x = if x = max_count () then Format.asprintf ">= %d" x else Format.asprintf "%d" x + end) + ) + + include MapDomain.MapTop_LiftBot (ValueDomain.Addr) (Count) - module Multiplicity = struct - include MapDomain.MapBot_LiftTop (ValueDomain.Addr) (Count) let increment v x = let current = find v x in - if current = (4) then + if current = 4 then x else add v (current + 1) x @@ -35,8 +40,9 @@ struct if current = 0 then (x, true) else - (add v (current - 1) x, current-1 = 0) + (add v (current - 1) x, current - 1 = 0) end + module D = struct include Lattice.Prod(Lockset)(Multiplicity) let empty () = (Lockset.empty (), Multiplicity.empty ()) end diff --git a/tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c b/tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c new file mode 100644 index 0000000000..463a080ba0 --- /dev/null +++ b/tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c @@ -0,0 +1,51 @@ +// PARAM: --set ana.activated[+] 'pthreadMutexType' --set ana.path_sens[-] 'mutex' +// Test that multiplicity also works when path-sensitivity is disabled. +#define _GNU_SOURCE +#include +#include +#include +#include + +int g; + +void* f1(void* ptr) { + pthread_mutex_t* mut = (pthread_mutex_t*) ptr; + int top; + + + pthread_mutex_lock(mut); + + if(top) { + pthread_mutex_lock(mut); + } + + pthread_mutex_unlock(mut); + g = 8; //RACE! + + + return NULL; +} + + +int main(int argc, char const *argv[]) +{ + pthread_t t1; + pthread_mutex_t mut; + + pthread_mutexattr_t attr; + pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE); + pthread_mutex_init(&mut, &attr); + + + pthread_create(&t1,NULL,f1,&mut); + + + pthread_mutex_lock(&mut); + g = 9; + pthread_mutex_unlock(&mut); + + pthread_join(t1, NULL); + + + return 0; +} From 46a8103e1ef6ae3477cd5c864ca07c2e17e7c810 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 6 Jun 2023 10:01:36 +0200 Subject: [PATCH 403/518] Use `max_count` --- src/analyses/mutexAnalysis.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index f9babec97f..c4d2a850db 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -30,7 +30,7 @@ struct let increment v x = let current = find v x in - if current = 4 then + if current = max_count () then x else add v (current + 1) x From 4e884c65eeb851c73d2a9debfd72ff97a3fba021 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 11:13:01 +0300 Subject: [PATCH 404/518] Remove unnecessary type definitions --- src/domains/access.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 9bd50a438f..2f06bfeb57 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -130,10 +130,8 @@ let get_type fb e = -type var_o = varinfo option -type off_o = offset option -let get_val_type e (vo: var_o) (oo: off_o) : acc_typ = +let get_val_type e (vo: varinfo option) (oo: offset option) : acc_typ = match Cilfacade.typeOf e with | t -> begin match vo, oo with From 2d7d09c730f9de67c550d89dc9d584968ea24e75 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 12:02:57 +0300 Subject: [PATCH 405/518] Replace failwith with exception and catch that instead --- src/domains/access.ml | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 2f06bfeb57..7edf4dd2a3 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -147,6 +147,8 @@ let add_one side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv:(varinf side ty lv (conf, kind, loc, e, a) end +exception Type_offset_error + let type_from_type_offset : acc_typ -> typ = function | `Type t -> t | `Struct (s,o) -> @@ -154,7 +156,7 @@ let type_from_type_offset : acc_typ -> typ = function match unrollType t with | TPtr (t,_) -> t (*?*) | TArray (t,_,_) -> t - | _ -> failwith "type_from_type_offset: indexing non-pointer type" + | _ -> raise Type_offset_error (* indexing non-pointer type *) in let rec type_from_offs (t,o) = match o with @@ -185,10 +187,11 @@ let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (va | Some (v, os1) -> Some (v, addOffs os1 os) | None -> None in - begin try - let oss = dist_fields (type_from_type_offset ty) in + begin match type_from_type_offset ty with + | t -> + let oss = dist_fields t in List.iter (fun os -> add_one side e kind conf (`Struct (s,addOffs os2 os)) (add_lv os) a) oss - with Failure _ -> + | exception Type_offset_error -> add_one side e kind conf ty lv a end | _ when lv = None && !unsound -> From 96f67f526dd1dcfb363c7028b3b1b20b656e9332 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 12:14:43 +0300 Subject: [PATCH 406/518] Refactor pattern matching --- src/domains/access.ml | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 7edf4dd2a3..594d0f8a2b 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -204,15 +204,10 @@ let add_propagate side e kind conf ty ls a = (* ignore (printf "%a:\n" d_exp e); *) let rec only_fields = function | `NoOffset -> true - | `Field (_,os) -> only_fields os + | `Field (_, os) -> only_fields os | `Index _ -> false in - let struct_inv (f:offs) = - let fi = - match f with - | `Field (fi,_) -> fi - | _ -> failwith "add_propagate: no field found" - in + let struct_inv (f:offs) (fi:fieldinfo) = let ts = typeSig (TComp (fi.fcomp,[])) in let vars = Hashtbl.find_all typeVar ts in (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) @@ -225,14 +220,14 @@ let add_propagate side e kind conf ty ls a = in add_struct side e kind conf ty None a; match ty with - | `Struct (c,os) when only_fields os && os <> `NoOffset -> + | `Struct (c, (`Field (fi, _) as os)) when only_fields os -> (* ignore (printf " * type is a struct\n"); *) - struct_inv os + struct_inv os fi | _ -> (* ignore (printf " * type is NOT a struct\n"); *) let t = type_from_type_offset ty in let incl = Hashtbl.find_all typeIncl (typeSig t) in - List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset))) incl; + List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi) incl; let vars = Hashtbl.find_all typeVar (typeSig t) in List.iter (just_vars t) vars From 8270028b1deaab29f48a5892c87d653d1b54ac5f Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 12:24:54 +0300 Subject: [PATCH 407/518] Refactor: remove typeSig function calls --- src/domains/access.ml | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 594d0f8a2b..9b4b0c5266 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -25,22 +25,24 @@ let is_ignorable = function try isFunctionType v.vtype || is_ignorable_type v.vtype with Not_found -> false -let typeVar = Hashtbl.create 101 -let typeIncl = Hashtbl.create 101 +module TH = Hashtbl.Make (CilType.Typ) + +let typeVar = TH.create 101 +let typeIncl = TH.create 101 let unsound = ref false let init (f:file) = unsound := get_bool "ana.mutex.disjoint_types"; let visited_vars = Hashtbl.create 100 in let visit_field fi = - Hashtbl.add typeIncl (typeSig fi.ftype) fi + TH.add typeIncl fi.ftype fi in let visit_glob = function | GCompTag (c,_) -> List.iter visit_field c.cfields | GVarDecl (v,_) | GVar (v,_,_) -> if not (Hashtbl.mem visited_vars v.vid) then begin - Hashtbl.add typeVar (typeSig v.vtype) v; + TH.add typeVar v.vtype v; (* ignore (printf "init adding %s : %a" v.vname d_typsig ((typeSig v.vtype))); *) Hashtbl.replace visited_vars v.vid true end @@ -49,8 +51,8 @@ let init (f:file) = List.iter visit_glob f.globals let reset () = - Hashtbl.clear typeVar; - Hashtbl.clear typeIncl + TH.clear typeVar; + TH.clear typeIncl type offs = [`NoOffset | `Index of offs | `Field of CilType.Fieldinfo.t * offs] [@@deriving eq, ord, hash] @@ -208,8 +210,7 @@ let add_propagate side e kind conf ty ls a = | `Index _ -> false in let struct_inv (f:offs) (fi:fieldinfo) = - let ts = typeSig (TComp (fi.fcomp,[])) in - let vars = Hashtbl.find_all typeVar ts in + let vars = TH.find_all typeVar (TComp (fi.fcomp,[])) in (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) let add_vars v = add_struct side e kind conf (`Struct (fi.fcomp, f)) (Some (v, f)) a in List.iter add_vars vars; @@ -226,9 +227,9 @@ let add_propagate side e kind conf ty ls a = | _ -> (* ignore (printf " * type is NOT a struct\n"); *) let t = type_from_type_offset ty in - let incl = Hashtbl.find_all typeIncl (typeSig t) in + let incl = TH.find_all typeIncl t in List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi) incl; - let vars = Hashtbl.find_all typeVar (typeSig t) in + let vars = TH.find_all typeVar t in List.iter (just_vars t) vars let rec distribute_access_lval f lv = From e07ee474eb60e28f1f64084cb449ecf30d704c23 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 14:49:21 +0300 Subject: [PATCH 408/518] Add type race cram tests Co-authored-by: Simmo Saan --- src/domains/access.ml | 21 +-- .../regression/04-mutex/49-type-invariants.t | 46 +++++++ tests/regression/06-symbeq/16-type_rc.t | 108 +++++++++++++++ tests/regression/06-symbeq/21-mult_accs_rc.t | 126 ++++++++++++++++++ tests/regression/06-symbeq/dune | 2 + 5 files changed, 295 insertions(+), 8 deletions(-) create mode 100644 tests/regression/04-mutex/49-type-invariants.t create mode 100644 tests/regression/06-symbeq/16-type_rc.t create mode 100644 tests/regression/06-symbeq/21-mult_accs_rc.t create mode 100644 tests/regression/06-symbeq/dune diff --git a/src/domains/access.ml b/src/domains/access.ml index 9b4b0c5266..311280d123 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -169,7 +169,7 @@ let type_from_type_offset : acc_typ -> typ = function unrollType (type_from_offs (TComp (s, []), o)) let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (varinfo * offs) option) a: unit = - let rec dist_fields ty = + let rec dist_fields ty : offs list = match unrollType ty with | TComp (ci,_) -> let one_field fld = @@ -192,6 +192,7 @@ let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (va begin match type_from_type_offset ty with | t -> let oss = dist_fields t in + (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) List.iter (fun os -> add_one side e kind conf (`Struct (s,addOffs os2 os)) (add_lv os) a) oss | exception Type_offset_error -> add_one side e kind conf ty lv a @@ -202,7 +203,7 @@ let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (va | _ -> add_one side e kind conf ty lv a -let add_propagate side e kind conf ty ls a = +let add_propagate side e kind conf ty a = (* ignore (printf "%a:\n" d_exp e); *) let rec only_fields = function | `NoOffset -> true @@ -212,24 +213,28 @@ let add_propagate side e kind conf ty ls a = let struct_inv (f:offs) (fi:fieldinfo) = let vars = TH.find_all typeVar (TComp (fi.fcomp,[])) in (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) + (* 1 test(s) failed: ["04/49 type-invariants"] *) let add_vars v = add_struct side e kind conf (`Struct (fi.fcomp, f)) (Some (v, f)) a in List.iter add_vars vars; + (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) add_struct side e kind conf (`Struct (fi.fcomp, f)) None a; in let just_vars t v = add_struct side e kind conf (`Type t) (Some (v, `NoOffset)) a; in - add_struct side e kind conf ty None a; match ty with | `Struct (c, (`Field (fi, _) as os)) when only_fields os -> (* ignore (printf " * type is a struct\n"); *) - struct_inv os fi + (* 1 test(s) failed: ["04/49 type-invariants"] *) + struct_inv os fi | _ -> (* ignore (printf " * type is NOT a struct\n"); *) let t = type_from_type_offset ty in let incl = TH.find_all typeIncl t in + (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi) incl; let vars = TH.find_all typeVar t in + (* TODO: not tested *) List.iter (just_vars t) vars let rec distribute_access_lval f lv = @@ -315,10 +320,10 @@ let add side e kind conf vo oo a = match vo, oo with | Some v, Some o -> add_struct side e kind conf ty (Some (v, remove_idx o)) a | _ -> - if !unsound && isArithmeticType (type_from_type_offset ty) then - add_struct side e kind conf ty None a - else - add_propagate side e kind conf ty None a + (* 8 test(s) failed: ["02/69 ipmi-struct-blob-fixpoint", "04/33 kernel_rc", "04/34 kernel_nr", "04/39 rw_lock_nr", "04/40 rw_lock_rc", "04/44 malloc_sound", "04/45 escape_rc", "04/46 escape_nr"] *) + add_struct side e kind conf ty None a; + if not (!unsound && isArithmeticType (type_from_type_offset ty)) then + add_propagate side e kind conf ty a (* Access table as Lattice. *) diff --git a/tests/regression/04-mutex/49-type-invariants.t b/tests/regression/04-mutex/49-type-invariants.t new file mode 100644 index 0000000000..c4612f4e2a --- /dev/null +++ b/tests/regression/04-mutex/49-type-invariants.t @@ -0,0 +1,46 @@ + $ goblint --disable ana.mutex.disjoint_types --enable allglobs 49-type-invariants.c + [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Unknown address in {&tmp} has escaped. (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (49-type-invariants.c:22:3-22:21) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Write to unknown address: privatization is unsound. (49-type-invariants.c:22:3-22:21) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 0 + total lines: 7 + [Success][Race] Memory location (struct S).field (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) + [Warning][Race] Memory location s.field@49-type-invariants.c:9:10-9:11 (race with conf. 110): + write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) + read with [mhp:{tid=[main, t_fun@49-type-invariants.c:21:3-21:40#top]}, thread:[main, t_fun@49-type-invariants.c:21:3-21:40#top]] (conf. 110) (exp: & s.field) (49-type-invariants.c:12:3-12:23) + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 1 + total memory locations: 2 + + $ goblint --enable ana.mutex.disjoint_types --enable allglobs 49-type-invariants.c + [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Unknown address in {&tmp} has escaped. (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (49-type-invariants.c:22:3-22:21) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Write to unknown address: privatization is unsound. (49-type-invariants.c:22:3-22:21) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 0 + total lines: 7 + [Success][Race] Memory location (struct S).field (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) + [Success][Race] Memory location s.field@49-type-invariants.c:9:10-9:11 (safe): + read with [mhp:{tid=[main, t_fun@49-type-invariants.c:21:3-21:40#top]}, thread:[main, t_fun@49-type-invariants.c:21:3-21:40#top]] (conf. 110) (exp: & s.field) (49-type-invariants.c:12:3-12:23) + [Info][Race] Memory locations race summary: + safe: 2 + vulnerable: 0 + unsafe: 0 + total memory locations: 2 diff --git a/tests/regression/06-symbeq/16-type_rc.t b/tests/regression/06-symbeq/16-type_rc.t new file mode 100644 index 0000000000..0d122ae37e --- /dev/null +++ b/tests/regression/06-symbeq/16-type_rc.t @@ -0,0 +1,108 @@ + $ goblint --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c + [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:23:3-23:14) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (16-type_rc.c:23:3-23:14) + [Info][Unsound] Unknown address in {&s} has escaped. (16-type_rc.c:23:3-23:14) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (16-type_rc.c:23:3-23:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:24:3-24:16) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:25:3-25:16) + [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:12:12-12:24) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:12:12-12:24) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (16-type_rc.c:12:12-12:24) + [Info][Unsound] Unknown address in {&tmp} has escaped. (16-type_rc.c:12:12-12:24) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (16-type_rc.c:12:12-12:24) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:13:3-13:15) + [Info][Unsound] Write to unknown address: privatization is unsound. (16-type_rc.c:13:3-13:15) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:28:3-28:9) + [Info][Unsound] Write to unknown address: privatization is unsound. (16-type_rc.c:28:3-28:9) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Success][Race] Memory location (struct __anonstruct___cancel_jmp_buf_572769531).__mask_was_saved (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __anonunion_pthread_mutexattr_t_488594144).__align (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct _pthread_cleanup_buffer).__canceltype (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (int ) (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Warning][Race] Memory location (struct s).datum (race with conf. 100): + write with [mhp:{tid=[main, t_fun@16-type_rc.c:27:3-27:37#top]}, thread:[main, t_fun@16-type_rc.c:27:3-27:37#top]] (conf. 100) (exp: & s->datum) (16-type_rc.c:13:3-13:15) + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __anonunion_pthread_condattr_t_488594145).__align (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_year (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_isdst (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location __daylight@/usr/include/time.h:160:12-160:22 (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __pthread_mutex_s).__lock (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_sec (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_min (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __pthread_cleanup_frame).__do_it (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_mday (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __pthread_mutex_s).__owner (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_wday (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_yday (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __pthread_mutex_s).__kind (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_mon (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __pthread_rwlock_arch_t).__cur_writer (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __pthread_cleanup_frame).__cancel_type (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct sched_param).sched_priority (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct tm).tm_hour (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __anonunion_pthread_barrierattr_t_951761806).__align (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location daylight@/usr/include/time.h:174:12-174:20 (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Success][Race] Memory location (struct __pthread_rwlock_arch_t).__shared (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) + [Info][Race] Memory locations race summary: + safe: 25 + vulnerable: 0 + unsafe: 1 + total memory locations: 26 + + $ goblint --enable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c + [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:23:3-23:14) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (16-type_rc.c:23:3-23:14) + [Info][Unsound] Unknown address in {&s} has escaped. (16-type_rc.c:23:3-23:14) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (16-type_rc.c:23:3-23:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:24:3-24:16) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:25:3-25:16) + [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:12:12-12:24) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:12:12-12:24) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (16-type_rc.c:12:12-12:24) + [Info][Unsound] Unknown address in {&tmp} has escaped. (16-type_rc.c:12:12-12:24) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (16-type_rc.c:12:12-12:24) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:13:3-13:15) + [Info][Unsound] Write to unknown address: privatization is unsound. (16-type_rc.c:13:3-13:15) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:28:3-28:9) + [Info][Unsound] Write to unknown address: privatization is unsound. (16-type_rc.c:28:3-28:9) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 11 + dead: 0 + total lines: 11 + [Success][Race] Memory location (struct s).datum (safe): + write with [mhp:{tid=[main, t_fun@16-type_rc.c:27:3-27:37#top]}, thread:[main, t_fun@16-type_rc.c:27:3-27:37#top]] (conf. 100) (exp: & s->datum) (16-type_rc.c:13:3-13:15) + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 diff --git a/tests/regression/06-symbeq/21-mult_accs_rc.t b/tests/regression/06-symbeq/21-mult_accs_rc.t new file mode 100644 index 0000000000..dc7abc76f8 --- /dev/null +++ b/tests/regression/06-symbeq/21-mult_accs_rc.t @@ -0,0 +1,126 @@ + $ goblint --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:27:3-27:14) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:27:3-27:14) + [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:27:3-27:14) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:27:3-27:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:13:3-13:14) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:13:3-13:14) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:13:3-13:14) + [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:13:3-13:14) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:13:3-13:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:15:3-15:14) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:15:3-15:14) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:15:3-15:14) + [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:15:3-15:14) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:15:3-15:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:16:3-16:14) + [Info][Unsound] Write to unknown address: privatization is unsound. (21-mult_accs_rc.c:16:3-16:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:32) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:34:3-34:9) + [Info][Unsound] Write to unknown address: privatization is unsound. (21-mult_accs_rc.c:34:3-34:9) + [Info][Unsound] Unknown mutex unlocked, base privatization unsound (21-mult_accs_rc.c:35:3-35:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 16 + dead: 0 + total lines: 16 + [Success][Race] Memory location (struct __anonstruct___cancel_jmp_buf_572769531).__mask_was_saved (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __anonunion_pthread_mutexattr_t_488594144).__align (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct _pthread_cleanup_buffer).__canceltype (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (int ) (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __anonunion_pthread_condattr_t_488594145).__align (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_year (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_isdst (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location __daylight@/usr/include/time.h:160:12-160:22 (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __pthread_mutex_s).__lock (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_sec (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_min (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __pthread_cleanup_frame).__do_it (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_mday (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __pthread_mutex_s).__owner (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_wday (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_yday (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __pthread_mutex_s).__kind (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Warning][Race] Memory location (struct s).data (race with conf. 100): + write with [mhp:{tid=[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}, thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_mon (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __pthread_rwlock_arch_t).__cur_writer (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __pthread_cleanup_frame).__cancel_type (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct sched_param).sched_priority (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct tm).tm_hour (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __anonunion_pthread_barrierattr_t_951761806).__align (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location daylight@/usr/include/time.h:174:12-174:20 (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Success][Race] Memory location (struct __pthread_rwlock_arch_t).__shared (safe): + write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) + [Info][Race] Memory locations race summary: + safe: 25 + vulnerable: 0 + unsafe: 1 + total memory locations: 26 + + $ goblint --enable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:27:3-27:14) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:27:3-27:14) + [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:27:3-27:14) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:27:3-27:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:13:3-13:14) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:13:3-13:14) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:13:3-13:14) + [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:13:3-13:14) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:13:3-13:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:15:3-15:14) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:15:3-15:14) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:15:3-15:14) + [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:15:3-15:14) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:15:3-15:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:16:3-16:14) + [Info][Unsound] Write to unknown address: privatization is unsound. (21-mult_accs_rc.c:16:3-16:14) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:32) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:34:3-34:9) + [Info][Unsound] Write to unknown address: privatization is unsound. (21-mult_accs_rc.c:34:3-34:9) + [Info][Unsound] Unknown mutex unlocked, base privatization unsound (21-mult_accs_rc.c:35:3-35:26) + [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 16 + dead: 0 + total lines: 16 + [Success][Race] Memory location (struct s).data (safe): + write with [mhp:{tid=[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}, thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) + [Info][Race] Memory locations race summary: + safe: 1 + vulnerable: 0 + unsafe: 0 + total memory locations: 1 diff --git a/tests/regression/06-symbeq/dune b/tests/regression/06-symbeq/dune new file mode 100644 index 0000000000..23c0dd3290 --- /dev/null +++ b/tests/regression/06-symbeq/dune @@ -0,0 +1,2 @@ +(cram + (deps (glob_files *.c))) From 41c2b11fa8ef1aefdc62b422f4faa4106c944890 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 15:01:46 +0300 Subject: [PATCH 409/518] Remove unused function parameters from access Co-authored-by: Simmo Saan --- src/analyses/raceAnalysis.ml | 7 ++++--- src/domains/access.ml | 29 ++++++++++++++--------------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index 099dc1bd62..5b44499568 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -59,7 +59,7 @@ struct | None -> () - let side_access ctx ty lv_opt (conf, w, loc, e, a) = + let side_access ctx (conf, w, loc, e, a) ty lv_opt = let ty = if Option.is_some lv_opt then `Type Cil.voidType (* avoid unsound type split for alloc variables *) @@ -100,13 +100,14 @@ struct (*partitions & locks*) Obj.obj (octx.ask (PartAccess (Memory {exp=e; var_opt=vo; kind}))) in + let loc = Option.get !Node.current_node in let add_access conf vo oo = let a = part_access vo oo in - Access.add (side_access octx) e kind conf vo oo a; + Access.add (side_access octx (conf, kind, loc, e, a)) e vo oo; in let add_access_struct conf ci = let a = part_access None None in - Access.add_struct (side_access octx) e kind conf (`Struct (ci,`NoOffset)) None a + Access.add_struct (side_access octx (conf, kind, loc, e, a)) (`Struct (ci,`NoOffset)) None in let has_escaped g = octx.ask (Queries.MayEscape g) in (* The following function adds accesses to the lval-set ls diff --git a/src/domains/access.ml b/src/domains/access.ml index 311280d123..31db10313a 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -143,10 +143,9 @@ let get_val_type e (vo: varinfo option) (oo: offset option) : acc_typ = end | exception (Cilfacade.TypeOfError _) -> get_type voidType e -let add_one side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv:(varinfo*offs) option) a: unit = +let add_one side (ty:acc_typ) (lv:(varinfo*offs) option): unit = if is_ignorable lv then () else begin - let loc = Option.get !Node.current_node in - side ty lv (conf, kind, loc, e, a) + side ty lv end exception Type_offset_error @@ -168,7 +167,7 @@ let type_from_type_offset : acc_typ -> typ = function in unrollType (type_from_offs (TComp (s, []), o)) -let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (varinfo * offs) option) a: unit = +let add_struct side (ty:acc_typ) (lv: (varinfo * offs) option): unit = let rec dist_fields ty : offs list = match unrollType ty with | TComp (ci,_) -> @@ -193,17 +192,17 @@ let add_struct side (e:exp) (kind:AccessKind.t) (conf:int) (ty:acc_typ) (lv: (va | t -> let oss = dist_fields t in (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) - List.iter (fun os -> add_one side e kind conf (`Struct (s,addOffs os2 os)) (add_lv os) a) oss + List.iter (fun os -> add_one side (`Struct (s,addOffs os2 os)) (add_lv os)) oss | exception Type_offset_error -> - add_one side e kind conf ty lv a + add_one side ty lv end | _ when lv = None && !unsound -> (* don't recognize accesses to locations such as (long ) and (int ). *) () | _ -> - add_one side e kind conf ty lv a + add_one side ty lv -let add_propagate side e kind conf ty a = +let add_propagate side ty = (* ignore (printf "%a:\n" d_exp e); *) let rec only_fields = function | `NoOffset -> true @@ -214,13 +213,13 @@ let add_propagate side e kind conf ty a = let vars = TH.find_all typeVar (TComp (fi.fcomp,[])) in (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) (* 1 test(s) failed: ["04/49 type-invariants"] *) - let add_vars v = add_struct side e kind conf (`Struct (fi.fcomp, f)) (Some (v, f)) a in + let add_vars v = add_struct side (`Struct (fi.fcomp, f)) (Some (v, f)) in List.iter add_vars vars; (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) - add_struct side e kind conf (`Struct (fi.fcomp, f)) None a; + add_struct side (`Struct (fi.fcomp, f)) None; in let just_vars t v = - add_struct side e kind conf (`Type t) (Some (v, `NoOffset)) a; + add_struct side (`Type t) (Some (v, `NoOffset)); in match ty with | `Struct (c, (`Field (fi, _) as os)) when only_fields os -> @@ -313,17 +312,17 @@ and distribute_access_type f = function | TBuiltin_va_list _ -> () -let add side e kind conf vo oo a = +let add side e vo oo = let ty = get_val_type e vo oo in (* let loc = !Tracing.current_loc in *) (* ignore (printf "add %a %b -- %a\n" d_exp e w d_loc loc); *) match vo, oo with - | Some v, Some o -> add_struct side e kind conf ty (Some (v, remove_idx o)) a + | Some v, Some o -> add_struct side ty (Some (v, remove_idx o)) | _ -> (* 8 test(s) failed: ["02/69 ipmi-struct-blob-fixpoint", "04/33 kernel_rc", "04/34 kernel_nr", "04/39 rw_lock_nr", "04/40 rw_lock_rc", "04/44 malloc_sound", "04/45 escape_rc", "04/46 escape_nr"] *) - add_struct side e kind conf ty None a; + add_struct side ty None; if not (!unsound && isArithmeticType (type_from_type_offset ty)) then - add_propagate side e kind conf ty a + add_propagate side ty (* Access table as Lattice. *) From 96c26ff22028b6b4e8722d1f90063c69bdf5fd82 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 15:56:22 +0300 Subject: [PATCH 410/518] Refactor offset option type in access Co-authored-by: Simmo Saan --- src/analyses/raceAnalysis.ml | 16 ++++++++-------- src/domains/access.ml | 33 ++++++++++++++++----------------- 2 files changed, 24 insertions(+), 25 deletions(-) diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index 5b44499568..d15dd7d598 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -96,17 +96,17 @@ struct (* must use original (pre-assign, etc) ctx queries *) let conf = 110 in let module LS = Queries.LS in - let part_access (vo:varinfo option) (oo: offset option): MCPAccess.A.t = + let part_access (vo:varinfo option): MCPAccess.A.t = (*partitions & locks*) Obj.obj (octx.ask (PartAccess (Memory {exp=e; var_opt=vo; kind}))) in let loc = Option.get !Node.current_node in - let add_access conf vo oo = - let a = part_access vo oo in - Access.add (side_access octx (conf, kind, loc, e, a)) e vo oo; + let add_access conf voffs = + let a = part_access (Option.map fst voffs) in + Access.add (side_access octx (conf, kind, loc, e, a)) e voffs; in let add_access_struct conf ci = - let a = part_access None None in + let a = part_access None in Access.add_struct (side_access octx (conf, kind, loc, e, a)) (`Struct (ci,`NoOffset)) None in let has_escaped g = octx.ask (Queries.MayEscape g) in @@ -119,9 +119,9 @@ struct let f (var, offs) = let coffs = Lval.CilLval.to_ciloffs offs in if CilType.Varinfo.equal var dummyFunDec.svar then - add_access conf None (Some coffs) + add_access conf None else - add_access conf (Some var) (Some coffs) + add_access conf (Some (var, coffs)) in LS.iter f ls in @@ -148,7 +148,7 @@ struct end; on_lvals ls !includes_uk | _ -> - add_access (conf - 60) None None + add_access (conf - 60) None end; ctx.local | _ -> diff --git a/src/domains/access.ml b/src/domains/access.ml index 31db10313a..07abb0c6ff 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -133,13 +133,12 @@ let get_type fb e = -let get_val_type e (vo: varinfo option) (oo: offset option) : acc_typ = +let get_val_type e (voffs: (varinfo * offset) option) : acc_typ = match Cilfacade.typeOf e with | t -> - begin match vo, oo with - | Some v, Some o -> get_type t (AddrOf (Var v, o)) - | Some v, None -> get_type t (AddrOf (Var v, NoOffset)) - | _ -> get_type t e + begin match voffs with + | Some (v, o) -> get_type t (AddrOf (Var v, o)) + | None -> get_type t e end | exception (Cilfacade.TypeOfError _) -> get_type voidType e @@ -236,6 +235,18 @@ let add_propagate side ty = (* TODO: not tested *) List.iter (just_vars t) vars +let add side e voffs = + let ty = get_val_type e voffs in + (* let loc = !Tracing.current_loc in *) + (* ignore (printf "add %a %b -- %a\n" d_exp e w d_loc loc); *) + match voffs with + | Some (v, o) -> add_struct side ty (Some (v, remove_idx o)) + | None -> + (* 8 test(s) failed: ["02/69 ipmi-struct-blob-fixpoint", "04/33 kernel_rc", "04/34 kernel_nr", "04/39 rw_lock_nr", "04/40 rw_lock_rc", "04/44 malloc_sound", "04/45 escape_rc", "04/46 escape_nr"] *) + add_struct side ty None; + if not (!unsound && isArithmeticType (type_from_type_offset ty)) then + add_propagate side ty + let rec distribute_access_lval f lv = (* Use unoptimized AddrOf so RegionDomain.Reg.eval_exp knows about dereference *) (* f (mkAddrOf lv); *) @@ -312,18 +323,6 @@ and distribute_access_type f = function | TBuiltin_va_list _ -> () -let add side e vo oo = - let ty = get_val_type e vo oo in - (* let loc = !Tracing.current_loc in *) - (* ignore (printf "add %a %b -- %a\n" d_exp e w d_loc loc); *) - match vo, oo with - | Some v, Some o -> add_struct side ty (Some (v, remove_idx o)) - | _ -> - (* 8 test(s) failed: ["02/69 ipmi-struct-blob-fixpoint", "04/33 kernel_rc", "04/34 kernel_nr", "04/39 rw_lock_nr", "04/40 rw_lock_rc", "04/44 malloc_sound", "04/45 escape_rc", "04/46 escape_nr"] *) - add_struct side ty None; - if not (!unsound && isArithmeticType (type_from_type_offset ty)) then - add_propagate side ty - (* Access table as Lattice. *) (* (varinfo ->) offset -> type -> 2^(confidence, write, loc, e, acc) *) From 913a2a72a135946e452b7ae10bca34e4d4a9d9da Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 16:17:38 +0300 Subject: [PATCH 411/518] Refactor pattern matching in add in access Co-authored-by: Simmo Saan --- src/domains/access.ml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 07abb0c6ff..77ef91f38b 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -239,13 +239,15 @@ let add side e voffs = let ty = get_val_type e voffs in (* let loc = !Tracing.current_loc in *) (* ignore (printf "add %a %b -- %a\n" d_exp e w d_loc loc); *) - match voffs with - | Some (v, o) -> add_struct side ty (Some (v, remove_idx o)) - | None -> - (* 8 test(s) failed: ["02/69 ipmi-struct-blob-fixpoint", "04/33 kernel_rc", "04/34 kernel_nr", "04/39 rw_lock_nr", "04/40 rw_lock_rc", "04/44 malloc_sound", "04/45 escape_rc", "04/46 escape_nr"] *) - add_struct side ty None; - if not (!unsound && isArithmeticType (type_from_type_offset ty)) then - add_propagate side ty + let voffs' = + match voffs with + | Some (v, o) -> Some (v, remove_idx o) + | None -> None + in + add_struct side ty voffs'; + (* TODO: maybe this should not depend on whether voffs = None? *) + if voffs = None && not (!unsound && isArithmeticType (type_from_type_offset ty)) then + add_propagate side ty let rec distribute_access_lval f lv = (* Use unoptimized AddrOf so RegionDomain.Reg.eval_exp knows about dereference *) From 1115bb725a328e30ce4e5cfb382024e7f180644a Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 6 Jun 2023 16:10:13 +0200 Subject: [PATCH 412/518] Add tests & option Co-authored-by:FelixKrayer --- src/analyses/threadId.ml | 6 ++ src/util/options.schema.json | 15 +++- tests/regression/74-threadCreate/01-simple.c | 32 ++++++++ tests/regression/74-threadCreate/02-deep.c | 76 +++++++++++++++++++ .../74-threadCreate/03-createEdges.c | 37 +++++++++ .../74-threadCreate/04-fromThread.c | 35 +++++++++ 6 files changed, 200 insertions(+), 1 deletion(-) create mode 100644 tests/regression/74-threadCreate/01-simple.c create mode 100644 tests/regression/74-threadCreate/02-deep.c create mode 100644 tests/regression/74-threadCreate/03-createEdges.c create mode 100644 tests/regression/74-threadCreate/04-fromThread.c diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index ff47cf10b8..b3c88f4651 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -40,6 +40,12 @@ struct let name () = "threadid" + let context fd ((n,current,td) as d) = + if GobConfig.get_bool "ana.thread.context.create-edges" then + d + else + (n, current, TD.bot ()) + let startstate v = (N.bot (), ThreadLifted.bot (), TD.bot ()) let exitstate v = (N.bot (), `Lifted (Thread.threadinit v ~multiple:false), TD.bot ()) diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 02fc929a8a..ae2a8509bb 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -989,8 +989,21 @@ "description": "Number of unique thread IDs allocated for each pthread_create node.", "type": "integer", "default": 0 + }, + "context": { + "title": "ana.thread.context", + "type": "object", + "properties": { + "create-edges": { + "title": "ana.thread.context.create-edges", + "description": "threadID analysis: Encountered create edges in context.", + "type": "boolean", + "default": true + } + }, + "additionalProperties": false } - }, + }, "additionalProperties": false }, "race": { diff --git a/tests/regression/74-threadCreate/01-simple.c b/tests/regression/74-threadCreate/01-simple.c new file mode 100644 index 0000000000..cc2c0cbdfc --- /dev/null +++ b/tests/regression/74-threadCreate/01-simple.c @@ -0,0 +1,32 @@ +// PARAM: --disable ana.thread.context.create-edges --set ana.activated[+] threadCreateEdges +#include +#include + +int glob; + +void *t_FST(void *arg) { +} + +void *t_SND(void *arg) { + glob = 1; //NORACE +} + +int nothing () { +} + + +int main() { + + pthread_t id; + pthread_create(&id, NULL, t_FST, NULL); + + nothing(); + + glob = 2; //NORACE + + pthread_t id; + pthread_create(&id, NULL, t_SND, NULL); + + nothing(); + +} diff --git a/tests/regression/74-threadCreate/02-deep.c b/tests/regression/74-threadCreate/02-deep.c new file mode 100644 index 0000000000..3d0ab2ea4b --- /dev/null +++ b/tests/regression/74-threadCreate/02-deep.c @@ -0,0 +1,76 @@ +// PARAM: --disable ana.thread.context.create-edges --set ana.activated[+] threadCreateEdges +#include +#include + +int glob_noCreate; +int glob_create; + +void *t_INIT(void *arg) { +} + +void *t_noCreate(void *arg) { + glob_noCreate =1; //NORACE +} + +void *t_create(void *arg) { + glob_create =1; //RACE +} + +void noCreate1 () { + noCreate2(); +} +void noCreate2 () { + noCreate3(); +} +void noCreate3 () { + noCreate4(); +} +void noCreate4 () { + noCreate5(); +} +void noCreate5 () { +} + +void create1 () { + create2(); +} +void create2 () { + create3(); +} +void create3 () { + create4(); +} +void create4 () { + create5(); +} +void create5 () { + pthread_t id; + pthread_create(&id, NULL, t_create, NULL); +} + +int main() { + + pthread_t id; + pthread_create(&id, NULL, t_INIT, NULL); + + //no create + noCreate1(); + + glob_noCreate = 2; //NORACE + + pthread_t id; + pthread_create(&id, NULL, t_noCreate, NULL); + + noCreate1(); + + //create + create1(); + + glob_create = 2; //RACE + + pthread_t id; + pthread_create(&id, NULL, t_create, NULL); + + create1(); + +} diff --git a/tests/regression/74-threadCreate/03-createEdges.c b/tests/regression/74-threadCreate/03-createEdges.c new file mode 100644 index 0000000000..2a6ba04328 --- /dev/null +++ b/tests/regression/74-threadCreate/03-createEdges.c @@ -0,0 +1,37 @@ +// PARAM: --disable ana.thread.context.create-edges --set ana.activated[+] threadCreateEdges +#include +#include + +int glob; + +void *t_init(void *arg) { +} + +void *t_norace(void *arg) { + glob = 1; //NORACE +} + +void *t_other(void *arg) { +} + +int create_other () { + pthread_t id; + pthread_create(&id, NULL, t_other, NULL); +} + + +int main() { + //enter multithreaded mode + pthread_t id; + pthread_create(&id, NULL, t_init, NULL); + + create_other(); + + glob = 2; //NORACE + + pthread_t id; + pthread_create(&id, NULL, t_norace, NULL); + + create_other(); + +} diff --git a/tests/regression/74-threadCreate/04-fromThread.c b/tests/regression/74-threadCreate/04-fromThread.c new file mode 100644 index 0000000000..3ee56cc833 --- /dev/null +++ b/tests/regression/74-threadCreate/04-fromThread.c @@ -0,0 +1,35 @@ +// PARAM: --disable ana.thread.context.create-edges --set ana.activated[+] threadCreateEdges +#include +#include + +int glob; + +void *t_norace(void *arg) { + glob = 1; //NORACE +} + +void *t_other(void *arg) { +} + +int create_other () { + pthread_t id; + pthread_create(&id, NULL, t_other, NULL); +} + +void *t_fun(void *arg) { + create_other(); + + glob = 2; //NORACE + + pthread_t id; + pthread_create(&id, NULL, t_norace, NULL); + + create_other(); +} + +int main() { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + + create_other(); +} From c75de0fcc6e62a65cacee1da68849073e6f1a4c2 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 17:25:06 +0300 Subject: [PATCH 413/518] Refactor compinfo in add_propagate in access --- src/domains/access.ml | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 77ef91f38b..ef857194b4 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -208,29 +208,30 @@ let add_propagate side ty = | `Field (_, os) -> only_fields os | `Index _ -> false in - let struct_inv (f:offs) (fi:fieldinfo) = - let vars = TH.find_all typeVar (TComp (fi.fcomp,[])) in + let struct_inv (f:offs) (c:compinfo) = + let vars = TH.find_all typeVar (TComp (c,[])) in (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) (* 1 test(s) failed: ["04/49 type-invariants"] *) - let add_vars v = add_struct side (`Struct (fi.fcomp, f)) (Some (v, f)) in + let add_vars v = add_struct side (`Struct (c, f)) (Some (v, f)) in List.iter add_vars vars; (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) - add_struct side (`Struct (fi.fcomp, f)) None; + add_struct side (`Struct (c, f)) None; in let just_vars t v = add_struct side (`Type t) (Some (v, `NoOffset)); in match ty with | `Struct (c, (`Field (fi, _) as os)) when only_fields os -> + assert (CilType.Compinfo.equal c fi.fcomp); (* ignore (printf " * type is a struct\n"); *) (* 1 test(s) failed: ["04/49 type-invariants"] *) - struct_inv os fi + struct_inv os c | _ -> (* ignore (printf " * type is NOT a struct\n"); *) let t = type_from_type_offset ty in let incl = TH.find_all typeIncl t in (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) - List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi) incl; + List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi.fcomp) incl; let vars = TH.find_all typeVar t in (* TODO: not tested *) List.iter (just_vars t) vars From 39257c8aa9ba4185471d2e3a8552bf2aa89a0373 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Tue, 6 Jun 2023 16:46:29 +0200 Subject: [PATCH 414/518] Add second component to threadId Co-authored-by:FelixKrayer --- src/analyses/threadId.ml | 33 ++++++++++++------- tests/regression/74-threadCreate/01-simple.c | 4 +-- tests/regression/74-threadCreate/02-deep.c | 4 +-- .../74-threadCreate/03-createEdges.c | 2 +- .../74-threadCreate/04-fromThread.c | 2 +- 5 files changed, 28 insertions(+), 17 deletions(-) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index b3c88f4651..bc5bb32288 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -32,7 +32,7 @@ struct module N = Lattice.Flat (VNI) (struct let bot_name = "unknown node" let top_name = "unknown node" end) module TD = Thread.D - module D = Lattice.Prod3 (N) (ThreadLifted) (TD) + module D = Lattice.Prod3 (N) (ThreadLifted) (Lattice.Prod(TD)(TD)) module C = D module P = IdentityP (D) @@ -44,18 +44,18 @@ struct if GobConfig.get_bool "ana.thread.context.create-edges" then d else - (n, current, TD.bot ()) + (n, current, (TD.bot (), TD.bot ())) - let startstate v = (N.bot (), ThreadLifted.bot (), TD.bot ()) - let exitstate v = (N.bot (), `Lifted (Thread.threadinit v ~multiple:false), TD.bot ()) + let startstate v = (N.bot (), ThreadLifted.bot (), (TD.bot (),TD.bot ())) + let exitstate v = (N.bot (), `Lifted (Thread.threadinit v ~multiple:false), (TD.bot (), TD.bot ())) let morphstate v _ = let tid = Thread.threadinit v ~multiple:false in if GobConfig.get_bool "dbg.print_tids" then Hashtbl.replace !tids tid (); - (N.bot (), `Lifted (tid), TD.bot ()) + (N.bot (), `Lifted (tid), (TD.bot (), TD.bot ())) - let create_tid (_, current, td) ((node, index): Node.t * int option) v = + let create_tid (_, current, (td, _)) ((node, index): Node.t * int option) v = match current with | `Lifted current -> let+ tid = Thread.threadenter (current, td) node index v in @@ -68,7 +68,18 @@ struct let is_unique ctx = ctx.ask Queries.MustBeUniqueThread - let created (_, current, td) = + let enter ctx lval f args = + let (n, current, (td, _)) = ctx.local in + [ctx.local, (n, current, (td,TD.bot ()))] + + let combine_env ctx lval fexp f args fc ((n,current,(_, au_ftd)) as au) f_ask = + let (_, _, (td, ftd)) = ctx.local in + if not (GobConfig.get_bool "ana.thread.context.create-edges") then + (n,current,(TD.join td au_ftd, TD.join ftd au_ftd)) + else + au + + let created (_, current, (td, _)) = match current with | `Lifted current -> BatOption.map_default (ConcDomain.ThreadSet.of_list) (ConcDomain.ThreadSet.top ()) (Thread.created current td) | _ -> ConcDomain.ThreadSet.top () @@ -121,15 +132,15 @@ struct | `Lifted node, count -> node, Some count | (`Bot | `Top), _ -> ctx.prev_node, None - let threadenter ctx lval f args = + let threadenter ctx lval f args:D.t list = let n, i = indexed_node_for_ctx ctx in let+ tid = create_tid ctx.local (n, i) f in - (`Lifted (f, n, i), tid, TD.bot ()) + (`Lifted (f, n, i), tid, (TD.bot (), TD.bot ())) let threadspawn ctx lval f args fctx = - let (current_n, current, td) = ctx.local in + let (current_n, current, (td,tdl)) = ctx.local in let v, n, i = match fctx.local with `Lifted vni, _, _ -> vni | _ -> failwith "ThreadId.threadspawn" in - (current_n, current, Thread.threadspawn td n i v) + (current_n, current, (Thread.threadspawn td n i v, Thread.threadspawn tdl n i v)) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) let init (m:marshal option): unit = diff --git a/tests/regression/74-threadCreate/01-simple.c b/tests/regression/74-threadCreate/01-simple.c index cc2c0cbdfc..a5c198097c 100644 --- a/tests/regression/74-threadCreate/01-simple.c +++ b/tests/regression/74-threadCreate/01-simple.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.thread.context.create-edges --set ana.activated[+] threadCreateEdges +// PARAM: --disable ana.thread.context.create-edges #include #include @@ -16,7 +16,7 @@ int nothing () { int main() { - + pthread_t id; pthread_create(&id, NULL, t_FST, NULL); diff --git a/tests/regression/74-threadCreate/02-deep.c b/tests/regression/74-threadCreate/02-deep.c index 3d0ab2ea4b..6578bb355b 100644 --- a/tests/regression/74-threadCreate/02-deep.c +++ b/tests/regression/74-threadCreate/02-deep.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.thread.context.create-edges --set ana.activated[+] threadCreateEdges +// PARAM: --disable ana.thread.context.create-edges #include #include @@ -49,7 +49,7 @@ void create5 () { } int main() { - + pthread_t id; pthread_create(&id, NULL, t_INIT, NULL); diff --git a/tests/regression/74-threadCreate/03-createEdges.c b/tests/regression/74-threadCreate/03-createEdges.c index 2a6ba04328..2d11e13fc1 100644 --- a/tests/regression/74-threadCreate/03-createEdges.c +++ b/tests/regression/74-threadCreate/03-createEdges.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.thread.context.create-edges --set ana.activated[+] threadCreateEdges +// PARAM: --disable ana.thread.context.create-edges #include #include diff --git a/tests/regression/74-threadCreate/04-fromThread.c b/tests/regression/74-threadCreate/04-fromThread.c index 3ee56cc833..4fd37b6f87 100644 --- a/tests/regression/74-threadCreate/04-fromThread.c +++ b/tests/regression/74-threadCreate/04-fromThread.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.thread.context.create-edges --set ana.activated[+] threadCreateEdges +// PARAM: --disable ana.thread.context.create-edges #include #include From f4a692e27d8dabb3c63245a754b2a6a18bd710e4 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Tue, 6 Jun 2023 17:52:11 +0300 Subject: [PATCH 415/518] Add unsound race test with array and struct --- .../06-symbeq/50-type_array_via_ptr_rc.c | 31 +++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 tests/regression/06-symbeq/50-type_array_via_ptr_rc.c diff --git a/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c b/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c new file mode 100644 index 0000000000..2315f59a32 --- /dev/null +++ b/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c @@ -0,0 +1,31 @@ +// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +#include + +struct s { + int datum[2]; + pthread_mutex_t mutex; +}; + +extern struct s *get_s(); + +void *t_fun(void *arg) { + struct s *s = get_s(); + s->datum[1] = 5; // RACE! + return NULL; +} + +int main () { + int *d; + struct s *s; + pthread_t id; + pthread_mutex_t *m; + + s = get_s(); + m = &s->mutex; + d = &s->datum[1]; + + pthread_create(&id,NULL,t_fun,NULL); + *d = 8; // RACE! + + return 0; +} From f5ab141efcc765ac6ec0e41d0c3ae5c5bf9e8b79 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 6 Jun 2023 20:59:02 +0300 Subject: [PATCH 416/518] Fix indentation (PR #1067) --- src/cdomains/musteqDomain.ml | 2 +- src/cdomains/offset.ml | 12 +++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/cdomains/musteqDomain.ml b/src/cdomains/musteqDomain.ml index 8979ab939d..c7a1cbc176 100644 --- a/src/cdomains/musteqDomain.ml +++ b/src/cdomains/musteqDomain.ml @@ -58,7 +58,7 @@ struct | _ -> failwith "Type mismatch!" (* TODO: use the type information to do this properly. Currently, this assumes - * there are no nested arrays, so all indexing is eliminated. *) + there are no nested arrays, so all indexing is eliminated. *) let real_region (fd:t) typ: bool = not (contains_index fd) let pretty_diff () ((x:t),(y:t)): Pretty.doc = diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index ebc7cfb1a9..26c601607f 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -57,11 +57,13 @@ struct let rec cmp_zero_offset : t -> [`MustZero | `MustNonzero | `MayZero] = function | `NoOffset -> `MustZero - | `Index (x, o) -> (match cmp_zero_offset o, Idx.equal_to (IntOps.BigIntOps.zero) x with - | `MustNonzero, _ - | _, `Neq -> `MustNonzero - | `MustZero, `Eq -> `MustZero - | _, _ -> `MayZero) + | `Index (x, o) -> + begin match cmp_zero_offset o, Idx.equal_to (IntOps.BigIntOps.zero) x with + | `MustNonzero, _ + | _, `Neq -> `MustNonzero + | `MustZero, `Eq -> `MustZero + | _, _ -> `MayZero + end | `Field (x, o) -> if Cilfacade.is_first_field x then cmp_zero_offset o else `MustNonzero From 63efc2d78b0707cf6d7052a65567eb917ab38265 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 09:50:20 +0300 Subject: [PATCH 417/518] Fix negated condition in Access --- src/domains/access.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 589ae4a6f9..8d2e1ffb08 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -203,7 +203,7 @@ let add_propagate side e kind conf ty ls a = in add_struct side e kind conf ty None a; match ty with - | `Struct (c,os) when Offset.Unit.contains_index os && os <> `NoOffset -> + | `Struct (c,os) when not (Offset.Unit.contains_index os) && os <> `NoOffset -> (* ignore (printf " * type is a struct\n"); *) struct_inv os | _ -> From e07933e242d8801e2874a94e938300ba56700bfa Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 11:18:48 +0300 Subject: [PATCH 418/518] Refactor Access memory location type to avoid offset redundancy --- src/analyses/raceAnalysis.ml | 39 ++++++++++++------------------ src/domains/access.ml | 47 ++++++++++++++++++++++++++++-------- 2 files changed, 53 insertions(+), 33 deletions(-) diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index b7ce868faf..54bc53068d 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -15,27 +15,26 @@ struct 1. (lval, type) -> accesses -- used for warnings 2. varinfo -> set of (lval, type) -- used for IterSysVars Global *) - module V0 = Printable.Prod (Access.LVOpt) (Access.T) module V = struct - include Printable.Either (V0) (CilType.Varinfo) + include Printable.Either (Access.Memo) (CilType.Varinfo) let name () = "race" let access x = `Left x let vars x = `Right x let is_write_only _ = true end - module V0Set = SetDomain.Make (V0) + module MemoSet = SetDomain.Make (Access.Memo) module G = struct - include Lattice.Lift2 (Access.AS) (V0Set) (Printable.DefaultNames) + include Lattice.Lift2 (Access.AS) (MemoSet) (Printable.DefaultNames) let access = function | `Bot -> Access.AS.bot () | `Lifted1 x -> x | _ -> failwith "Race.access" let vars = function - | `Bot -> V0Set.bot () + | `Bot -> MemoSet.bot () | `Lifted2 x -> x | _ -> failwith "Race.vars" let create_access access = `Lifted1 access @@ -51,24 +50,18 @@ struct vulnerable := 0; unsafe := 0 - let side_vars ctx lv_opt ty = - match lv_opt with - | Some (v, _) -> + let side_vars ctx memo = + match memo with + | (`Var v, _) -> if !AnalysisState.should_warn then - ctx.sideg (V.vars v) (G.create_vars (V0Set.singleton (lv_opt, ty))) - | None -> + ctx.sideg (V.vars v) (G.create_vars (MemoSet.singleton memo)) + | _ -> () - let side_access ctx (conf, w, loc, e, a) ty lv_opt = - let ty = - if Option.is_some lv_opt then - `Type Cil.voidType (* avoid unsound type split for alloc variables *) - else - ty - in + let side_access ctx (conf, w, loc, e, a) memo = if !AnalysisState.should_warn then - ctx.sideg (V.access (lv_opt, ty)) (G.create_access (Access.AS.singleton (conf, w, loc, e, a))); - side_vars ctx lv_opt ty + ctx.sideg (V.access memo) (G.create_access (Access.AS.singleton (conf, w, loc, e, a))); + side_vars ctx memo let query ctx (type a) (q: a Queries.t): a Queries.result = match q with @@ -78,14 +71,14 @@ struct | `Left g' -> (* accesses *) (* ignore (Pretty.printf "WarnGlobal %a\n" CilType.Varinfo.pretty g); *) let accs = G.access (ctx.global g) in - let (lv, ty) = g' in - let mem_loc_str = GobPretty.sprint Access.d_memo (ty, lv) in - Timing.wrap ~args:[("memory location", `String mem_loc_str)] "race" (Access.warn_global safe vulnerable unsafe g') accs + let memo = g' in + let mem_loc_str = GobPretty.sprint Access.Memo.pretty memo in + Timing.wrap ~args:[("memory location", `String mem_loc_str)] "race" (Access.warn_global safe vulnerable unsafe memo) accs | `Right _ -> (* vars *) () end | IterSysVars (Global g, vf) -> - V0Set.iter (fun v -> + MemoSet.iter (fun v -> vf (Obj.repr (V.access v)) ) (G.vars (ctx.global (V.vars g))) | _ -> Queries.Result.top q diff --git a/src/domains/access.ml b/src/domains/access.ml index 6b6a8a601d..485165e498 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -68,6 +68,28 @@ let d_memo () (t, lv) = | Some (v,o) -> dprintf "%a%a@@%a" Basetype.Variables.pretty v Offset.Unit.pretty o CilType.Location.pretty v.vdecl | None -> dprintf "%a" d_acct t +module Memo = +struct + include Printable.StdLeaf + type t = [`Var of CilType.Varinfo.t | `Type of CilType.Typ.t] * Offset.Unit.t [@@deriving eq, ord, hash] + + let name () = "memo" + + let pretty () (vt, o) = + (* Imitate old printing for now *) + match vt with + | `Var v -> Pretty.dprintf "%a%a@@%a" CilType.Varinfo.pretty v Offset.Unit.pretty o CilType.Location.pretty v.vdecl + | `Type (TComp (c, _)) -> Pretty.dprintf "(struct %s)%a" c.cname Offset.Unit.pretty o + | `Type t -> Pretty.dprintf "(%a)%a" CilType.Typ.pretty t Offset.Unit.pretty o + + include Printable.SimplePretty ( + struct + type nonrec t = t + let pretty = pretty + end + ) +end + let rec get_type (fb: typ) : exp -> acc_typ = function | AddrOf (h,o) | StartOf (h,o) -> let rec f htyp = @@ -127,9 +149,14 @@ let get_val_type e (voffs: (varinfo * offset) option) : acc_typ = | exception (Cilfacade.TypeOfError _) -> get_type voidType e let add_one side (ty:acc_typ) (lv:Mval.Unit.t option): unit = - if is_ignorable lv then () else begin - side ty lv - end + if not (is_ignorable lv) then ( + let memo: Memo.t = match lv, ty with + | Some (v, o), _ -> (`Var v, o) + | None, `Struct (c, o) -> (`Type (TComp (c, [])), o) + | None, `Type t -> (`Type t, `NoOffset) + in + side memo + ) exception Type_offset_error @@ -416,7 +443,7 @@ let race_conf accs = let is_all_safe = ref true (* Commenting your code is for the WEAK! *) -let incr_summary safe vulnerable unsafe (lv, ty) grouped_accs = +let incr_summary safe vulnerable unsafe _ grouped_accs = (* ignore(printf "Checking safety of %a:\n" d_memo (ty,lv)); *) let safety = grouped_accs @@ -431,7 +458,7 @@ let incr_summary safe vulnerable unsafe (lv, ty) grouped_accs = | Some n when n >= 100 -> is_all_safe := false; incr unsafe | Some n -> is_all_safe := false; incr vulnerable -let print_accesses (lv, ty) grouped_accs = +let print_accesses memo grouped_accs = let allglobs = get_bool "allglobs" in let race_threshold = get_int "warn.race-threshold" in let msgs race_accs = @@ -455,15 +482,15 @@ let print_accesses (lv, ty) grouped_accs = else Info in - M.msg_group severity ~category:Race "Memory location %a (race with conf. %d)" d_memo (ty,lv) conf (msgs accs); + M.msg_group severity ~category:Race "Memory location %a (race with conf. %d)" Memo.pretty memo conf (msgs accs); safe_accs ) (AS.empty ()) |> (fun safe_accs -> if allglobs && not (AS.is_empty safe_accs) then - M.msg_group Success ~category:Race "Memory location %a (safe)" d_memo (ty,lv) (msgs safe_accs) + M.msg_group Success ~category:Race "Memory location %a (safe)" Memo.pretty memo (msgs safe_accs) ) -let warn_global safe vulnerable unsafe g accs = +let warn_global safe vulnerable unsafe memo accs = let grouped_accs = group_may_race accs in (* do expensive component finding only once *) - incr_summary safe vulnerable unsafe g grouped_accs; - print_accesses g grouped_accs + incr_summary safe vulnerable unsafe memo grouped_accs; + print_accesses memo grouped_accs From 4e16e1f04aaf5259bc66cb47c3de56b633ff93c0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 11:33:10 +0300 Subject: [PATCH 419/518] Move Access.Memo up to add_one --- src/domains/access.ml | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 485165e498..813de37425 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -88,6 +88,16 @@ struct let pretty = pretty end ) + + let of_lv_ty (lv: Mval.Unit.t option) (ty: acc_typ): t = + match lv, ty with + | Some (v, o), _ -> (`Var v, o) + | None, `Struct (c, o) -> (`Type (TComp (c, [])), o) + | None, `Type t -> (`Type t, `NoOffset) + + let to_mval: t -> Mval.Unit.t option = function + | (`Var v, o) -> Some (v, o) + | (`Type _, _) -> None end let rec get_type (fb: typ) : exp -> acc_typ = function @@ -148,15 +158,10 @@ let get_val_type e (voffs: (varinfo * offset) option) : acc_typ = end | exception (Cilfacade.TypeOfError _) -> get_type voidType e -let add_one side (ty:acc_typ) (lv:Mval.Unit.t option): unit = - if not (is_ignorable lv) then ( - let memo: Memo.t = match lv, ty with - | Some (v, o), _ -> (`Var v, o) - | None, `Struct (c, o) -> (`Type (TComp (c, [])), o) - | None, `Type t -> (`Type t, `NoOffset) - in +let add_one side memo: unit = + let mv = Memo.to_mval memo in + if not (is_ignorable mv) then side memo - ) exception Type_offset_error @@ -195,22 +200,26 @@ let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = match ty with | `Struct (s,os2) -> let add_lv os = match lv with - | Some (v, os1) -> Some (v, Offset.Unit.add_offset os1 os) + | Some (v, os1) -> + assert (Offset.Unit.equal os1 os2); + Some (v, Offset.Unit.add_offset os1 os) | None -> None in begin match type_from_type_offset ty with | t -> let oss = dist_fields t in (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) - List.iter (fun os -> add_one side (`Struct (s, Offset.Unit.add_offset os2 os)) (add_lv os)) oss + List.iter (fun os -> + add_one side (Memo.of_lv_ty (add_lv os) (`Struct (s, Offset.Unit.add_offset os2 os)) ) + ) oss | exception Type_offset_error -> - add_one side ty lv + add_one side (Memo.of_lv_ty lv ty) end | _ when lv = None && !unsound -> (* don't recognize accesses to locations such as (long ) and (int ). *) () | _ -> - add_one side ty lv + add_one side (Memo.of_lv_ty lv ty) let add_propagate side ty = (* ignore (printf "%a:\n" d_exp e); *) From 070f7cafe81e6956d5d4981ea110fd54abca2a89 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Mon, 5 Jun 2023 14:45:15 +0200 Subject: [PATCH 420/518] Add test case where escaped local has unsound value. --- tests/regression/74-escape/01-local-esacpe.c | 42 ++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 tests/regression/74-escape/01-local-esacpe.c diff --git a/tests/regression/74-escape/01-local-esacpe.c b/tests/regression/74-escape/01-local-esacpe.c new file mode 100644 index 0000000000..40a6f788be --- /dev/null +++ b/tests/regression/74-escape/01-local-esacpe.c @@ -0,0 +1,42 @@ +#include +#include +#include +#include + +int g = 0; +int *p = &g; + +int let_escape(){ + int x = 23; + g = 23; + + __goblint_check(x == 23); + p = &x; + sleep(5); + __goblint_check(x == 23); //UNKNOWN! +} + +void *thread1(void *pp){ + let_escape(); //RACE + return NULL; +} + +void write_through_pointer(){ + sleep(2); + *p = 1; //RACE +} + +void *thread2(void *p){ + write_through_pointer(); + return NULL; +} + +int main(){ + pthread_t t1; + pthread_t t2; + pthread_create(&t1, NULL, thread1, NULL); + pthread_create(&t2, NULL, thread2, NULL); + pthread_join(t1, NULL); + pthread_join(t2, NULL); +} + From 843e0dc5b940f7899963e4fe477f7ff31c9a9f13 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Mon, 5 Jun 2023 14:58:43 +0200 Subject: [PATCH 421/518] Remove race annotation, as this is secondary for this test case. --- tests/regression/74-escape/01-local-esacpe.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/regression/74-escape/01-local-esacpe.c b/tests/regression/74-escape/01-local-esacpe.c index 40a6f788be..96e7a75efb 100644 --- a/tests/regression/74-escape/01-local-esacpe.c +++ b/tests/regression/74-escape/01-local-esacpe.c @@ -17,13 +17,13 @@ int let_escape(){ } void *thread1(void *pp){ - let_escape(); //RACE + let_escape(); return NULL; } void write_through_pointer(){ sleep(2); - *p = 1; //RACE + *p = 1; } void *thread2(void *p){ From 87a10f9ce83876bbbc9f3bd24d9f15a7424dcc63 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Tue, 6 Jun 2023 09:47:49 +0200 Subject: [PATCH 422/518] Move failing test with local escaping into escape test folder, simplify it. --- .../06-local-escp.c} | 21 +++++++------------ 1 file changed, 7 insertions(+), 14 deletions(-) rename tests/regression/{74-escape/01-local-esacpe.c => 45-escape/06-local-escp.c} (76%) diff --git a/tests/regression/74-escape/01-local-esacpe.c b/tests/regression/45-escape/06-local-escp.c similarity index 76% rename from tests/regression/74-escape/01-local-esacpe.c rename to tests/regression/45-escape/06-local-escp.c index 96e7a75efb..7ae6b4d1d1 100644 --- a/tests/regression/74-escape/01-local-esacpe.c +++ b/tests/regression/45-escape/06-local-escp.c @@ -1,3 +1,4 @@ +// SKIP #include #include #include @@ -6,28 +7,20 @@ int g = 0; int *p = &g; -int let_escape(){ - int x = 23; - g = 23; +void *thread1(void *pp){ + int x = 23; __goblint_check(x == 23); p = &x; - sleep(5); + sleep(2); __goblint_check(x == 23); //UNKNOWN! -} - -void *thread1(void *pp){ - let_escape(); return NULL; } -void write_through_pointer(){ - sleep(2); +void *thread2(void *ignored){ + sleep(1); + int *i = p; *p = 1; -} - -void *thread2(void *p){ - write_through_pointer(); return NULL; } From f2c2145cbd21855870eeb2a45ebe03ec2a1b20bd Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Tue, 6 Jun 2023 10:55:14 +0200 Subject: [PATCH 423/518] ThreadEscape: Extract function emitting events. --- src/analyses/threadEscape.ml | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 43d3ac4de5..a903a238f7 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -42,10 +42,15 @@ struct if M.tracing then M.tracel "escape" "mpt %a: %a\n" d_exp e Queries.LS.pretty a; D.empty () + let emit_escaped ctx escaped = + if not (D.is_empty escaped) then (* avoid emitting unnecessary event *) + ctx.emit (Events.Escape escaped) + (* queries *) let query ctx (type a) (q: a Queries.t): a Queries.result = match q with - | Queries.MayEscape v -> D.mem v ctx.local + | Queries.MayEscape v -> + D.mem v ctx.local | _ -> Queries.Result.top q (* transfer functions *) @@ -57,8 +62,8 @@ struct let escaped = reachable ask rval in let escaped = D.filter (fun v -> not v.vglob) escaped in if M.tracing then M.tracel "escape" "assign vs: %a | %a\n" D.pretty vs D.pretty escaped; - if not (D.is_empty escaped) && ThreadFlag.has_ever_been_multi ask then (* avoid emitting unnecessary event *) - ctx.emit (Events.Escape escaped); + if ThreadFlag.has_ever_been_multi ask then (* avoid emitting unnecessary event *) + emit_escaped ctx escaped; D.iter (fun v -> ctx.sideg v escaped; ) vs; @@ -73,8 +78,7 @@ struct | _, "pthread_setspecific" , [key; pt_value] -> let escaped = reachable (Analyses.ask_of_ctx ctx) pt_value in let escaped = D.filter (fun v -> not v.vglob) escaped in - if not (D.is_empty escaped) then (* avoid emitting unnecessary event *) - ctx.emit (Events.Escape escaped); + emit_escaped ctx escaped; let extra = D.fold (fun v acc -> D.join acc (ctx.global v)) escaped (D.empty ()) in (* TODO: must transitively join escapes of every ctx.global v as well? *) D.join ctx.local (D.join escaped extra) | _ -> ctx.local @@ -87,8 +91,7 @@ struct | [ptc_arg] -> let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in let escaped = D.filter (fun v -> not v.vglob) escaped in - if not (D.is_empty escaped) then (* avoid emitting unnecessary event *) - ctx.emit (Events.Escape escaped); + emit_escaped ctx escaped; let extra = D.fold (fun v acc -> D.join acc (ctx.global v)) escaped (D.empty ()) in (* TODO: must transitively join escapes of every ctx.global v as well? *) [D.join ctx.local (D.join escaped extra)] | _ -> [ctx.local] @@ -101,8 +104,7 @@ struct let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in let escaped = D.filter (fun v -> not v.vglob) escaped in if M.tracing then M.tracel "escape" "%a: %a\n" d_exp ptc_arg D.pretty escaped; - if not (D.is_empty escaped) then (* avoid emitting unnecessary event *) - ctx.emit (Events.Escape escaped); + emit_escaped ctx escaped; escaped | _ -> D.bot () @@ -110,8 +112,7 @@ struct match e with | Events.EnterMultiThreaded -> let escaped = ctx.local in - if not (D.is_empty escaped) then (* avoid emitting unnecessary event *) - ctx.emit (Events.Escape escaped); + emit_escaped ctx escaped; ctx.local | _ -> ctx.local end From df407b1ac8e1f86532f933b6bd09a8bdcf03fb25 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Tue, 6 Jun 2023 12:42:45 +0200 Subject: [PATCH 424/518] Add simple failiing test case due to unsound escape analysis. --- .../07-local-in-global-after-create.c | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 tests/regression/45-escape/07-local-in-global-after-create.c diff --git a/tests/regression/45-escape/07-local-in-global-after-create.c b/tests/regression/45-escape/07-local-in-global-after-create.c new file mode 100644 index 0000000000..fbb955e1fc --- /dev/null +++ b/tests/regression/45-escape/07-local-in-global-after-create.c @@ -0,0 +1,22 @@ +// SKIP +#include +#include + +int* gptr; + +void *foo(void* p){ + *gptr = 17; + return NULL; +} + +int main(){ + int x = 0; + __goblint_check(x==0); + pthread_t thread; + pthread_create(&thread, NULL, foo, NULL); + gptr = &x; + sleep(3); + __goblint_check(x == 0); // UNKNOWN! + pthread_join(thread, NULL); + return 0; +} From 9143b2a3d00a9bcabd081394bfbfaca8c0f2b94a Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Tue, 6 Jun 2023 18:58:35 +0200 Subject: [PATCH 425/518] ThreadEscape: collect which threads escaped variables in flow-insensitive invariant. --- src/analyses/threadEscape.ml | 71 ++++++++++++++++++++++++------------ 1 file changed, 48 insertions(+), 23 deletions(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index a903a238f7..0b6ccb0076 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -16,11 +16,13 @@ module Spec = struct include Analyses.IdentitySpec + module ThreadIdSet = SetDomain.Make (ThreadIdDomain.ThreadLifted) + let name () = "escape" module D = EscapeDomain.EscapedVars module C = EscapeDomain.EscapedVars module V = VarinfoV - module G = EscapeDomain.EscapedVars + module G = ThreadIdSet let reachable (ask: Queries.ask) e: D.t = match ask.f (Queries.ReachableFrom e) with @@ -42,15 +44,47 @@ struct if M.tracing then M.tracel "escape" "mpt %a: %a\n" d_exp e Queries.LS.pretty a; D.empty () - let emit_escaped ctx escaped = - if not (D.is_empty escaped) then (* avoid emitting unnecessary event *) - ctx.emit (Events.Escape escaped) + let escape ctx escaped = + let threadid = ctx.ask Queries.CurrentThreadId in + let threadid = G.singleton threadid in + + (* avoid emitting unnecessary event *) + if not (D.is_empty escaped) then begin + ctx.emit (Events.Escape escaped); + M.tracel "escape" "escaping: %a\n" D.pretty escaped; + D.iter (fun v -> + ctx.sideg v threadid) escaped + end (* queries *) let query ctx (type a) (q: a Queries.t): a Queries.result = match q with | Queries.MayEscape v -> - D.mem v ctx.local + let threads = ctx.global v in + if ThreadIdSet.is_empty threads then + false + else if not (ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx)) then + false + else begin + let possibly_started current = function + | `Lifted tid -> + let not_started = MHP.definitely_not_started (current, ctx.ask Queries.CreatedThreads) tid in + let possibly_started = not not_started in + M.tracel "escape" "possibly_started: %a %a -> %b\n" ThreadIdDomain.Thread.pretty tid ThreadIdDomain.Thread.pretty current possibly_started; + possibly_started + | `Top + | `Bot -> false + in + match ctx.ask Queries.CurrentThreadId with + | `Lifted current -> + let possibly_started = ThreadIdSet.exists (possibly_started current) threads in + possibly_started || D.mem v ctx.local + | `Top -> + true + | `Bot -> + M.warn ~category:MessageCategory.Analyzer "CurrentThreadId is bottom."; + false + end | _ -> Queries.Result.top q (* transfer functions *) @@ -63,24 +97,19 @@ struct let escaped = D.filter (fun v -> not v.vglob) escaped in if M.tracing then M.tracel "escape" "assign vs: %a | %a\n" D.pretty vs D.pretty escaped; if ThreadFlag.has_ever_been_multi ask then (* avoid emitting unnecessary event *) - emit_escaped ctx escaped; - D.iter (fun v -> - ctx.sideg v escaped; - ) vs; + escape ctx escaped; D.join ctx.local escaped - ) - else + ) else begin + M.tracel "escape" "nothing in rval: %a was escaped\n" D.pretty vs; ctx.local + end let special ctx (lval: lval option) (f:varinfo) (args:exp list) : D.t = let desc = LibraryFunctions.find f in match desc.special args, f.vname, args with | _, "pthread_setspecific" , [key; pt_value] -> - let escaped = reachable (Analyses.ask_of_ctx ctx) pt_value in - let escaped = D.filter (fun v -> not v.vglob) escaped in - emit_escaped ctx escaped; - let extra = D.fold (fun v acc -> D.join acc (ctx.global v)) escaped (D.empty ()) in (* TODO: must transitively join escapes of every ctx.global v as well? *) - D.join ctx.local (D.join escaped extra) + (* TODO: handle *) + ctx.local | _ -> ctx.local let startstate v = D.bot () @@ -89,11 +118,7 @@ struct let threadenter ctx lval f args = match args with | [ptc_arg] -> - let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in - let escaped = D.filter (fun v -> not v.vglob) escaped in - emit_escaped ctx escaped; - let extra = D.fold (fun v acc -> D.join acc (ctx.global v)) escaped (D.empty ()) in (* TODO: must transitively join escapes of every ctx.global v as well? *) - [D.join ctx.local (D.join escaped extra)] + [ctx.local] | _ -> [ctx.local] let threadspawn ctx lval f args fctx = @@ -104,7 +129,7 @@ struct let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in let escaped = D.filter (fun v -> not v.vglob) escaped in if M.tracing then M.tracel "escape" "%a: %a\n" d_exp ptc_arg D.pretty escaped; - emit_escaped ctx escaped; + escape ctx escaped; escaped | _ -> D.bot () @@ -112,7 +137,7 @@ struct match e with | Events.EnterMultiThreaded -> let escaped = ctx.local in - emit_escaped ctx escaped; + escape ctx escaped; ctx.local | _ -> ctx.local end From cbfe7b6ddbf37c8ee21a5a50cde56646f9a23b78 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 7 Jun 2023 10:24:48 +0200 Subject: [PATCH 426/518] ThreadEscape: also answer whether variable escaped in singlethreaded mode, support pthread_setspecific again. The base analysis relies on variables being considered escaped even in single-threaded mode, when determining which local variables to pass to a callee: Locals possibly reachable via globals need to be considered escaped. --- src/analyses/threadEscape.ml | 59 ++++++++++++++++++++++-------------- 1 file changed, 36 insertions(+), 23 deletions(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 0b6ccb0076..538e7247d0 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -44,17 +44,24 @@ struct if M.tracing then M.tracel "escape" "mpt %a: %a\n" d_exp e Queries.LS.pretty a; D.empty () - let escape ctx escaped = - let threadid = ctx.ask Queries.CurrentThreadId in - let threadid = G.singleton threadid in + let thread_id ctx = + ctx.ask Queries.CurrentThreadId + (** Emit an escape event: + Only necessary when code has ever been multithreaded, + or when about to go multithreaded. *) + let emit_escape_event ctx escaped = (* avoid emitting unnecessary event *) - if not (D.is_empty escaped) then begin - ctx.emit (Events.Escape escaped); - M.tracel "escape" "escaping: %a\n" D.pretty escaped; - D.iter (fun v -> - ctx.sideg v threadid) escaped - end + if not (D.is_empty escaped) then + ctx.emit (Events.Escape escaped) + + (** Side effect escapes: In contrast to the emitting the event, side-effecting is + necessary in single threaded mode, since we rely on escape status in Base + for passing locals reachable via globals *) + let side_effect_escape ctx escaped threadid = + let threadid = G.singleton threadid in + D.iter (fun v -> + ctx.sideg v threadid) escaped (* queries *) let query ctx (type a) (q: a Queries.t): a Queries.result = @@ -63,14 +70,11 @@ struct let threads = ctx.global v in if ThreadIdSet.is_empty threads then false - else if not (ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx)) then - false else begin let possibly_started current = function | `Lifted tid -> let not_started = MHP.definitely_not_started (current, ctx.ask Queries.CreatedThreads) tid in let possibly_started = not not_started in - M.tracel "escape" "possibly_started: %a %a -> %b\n" ThreadIdDomain.Thread.pretty tid ThreadIdDomain.Thread.pretty current possibly_started; possibly_started | `Top | `Bot -> false @@ -87,20 +91,25 @@ struct end | _ -> Queries.Result.top q + let escape_rval ctx (rval:exp) = + let ask = Analyses.ask_of_ctx ctx in + let escaped = reachable ask rval in + let escaped = D.filter (fun v -> not v.vglob) escaped in + + let thread_id = thread_id ctx in + side_effect_escape ctx escaped thread_id; + if ThreadFlag.has_ever_been_multi ask then (* avoid emitting unnecessary event *) + emit_escape_event ctx escaped; + escaped + (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = let ask = Analyses.ask_of_ctx ctx in let vs = mpt ask (AddrOf lval) in - if M.tracing then M.tracel "escape" "assign vs: %a\n" D.pretty vs; if D.exists (fun v -> v.vglob || has_escaped ask v) vs then ( - let escaped = reachable ask rval in - let escaped = D.filter (fun v -> not v.vglob) escaped in - if M.tracing then M.tracel "escape" "assign vs: %a | %a\n" D.pretty vs D.pretty escaped; - if ThreadFlag.has_ever_been_multi ask then (* avoid emitting unnecessary event *) - escape ctx escaped; + let escaped = escape_rval ctx rval in D.join ctx.local escaped ) else begin - M.tracel "escape" "nothing in rval: %a was escaped\n" D.pretty vs; ctx.local end @@ -108,8 +117,8 @@ struct let desc = LibraryFunctions.find f in match desc.special args, f.vname, args with | _, "pthread_setspecific" , [key; pt_value] -> - (* TODO: handle *) - ctx.local + let escaped = escape_rval ctx pt_value in + D.join ctx.local escaped | _ -> ctx.local let startstate v = D.bot () @@ -129,7 +138,9 @@ struct let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in let escaped = D.filter (fun v -> not v.vglob) escaped in if M.tracing then M.tracel "escape" "%a: %a\n" d_exp ptc_arg D.pretty escaped; - escape ctx escaped; + let thread_id = thread_id ctx in + emit_escape_event ctx escaped; + side_effect_escape ctx escaped thread_id; escaped | _ -> D.bot () @@ -137,7 +148,9 @@ struct match e with | Events.EnterMultiThreaded -> let escaped = ctx.local in - escape ctx escaped; + let thread_id = thread_id ctx in + emit_escape_event ctx escaped; + side_effect_escape ctx escaped thread_id; ctx.local | _ -> ctx.local end From 7533309ce1d56bf85c372ab6004f9141d2d1b75b Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 7 Jun 2023 10:29:44 +0200 Subject: [PATCH 427/518] Add test case, extend test case with interval checks. --- tests/regression/45-escape/06-local-escp.c | 3 ++ .../regression/45-escape/08-local-escp-main.c | 31 +++++++++++++++++++ 2 files changed, 34 insertions(+) create mode 100644 tests/regression/45-escape/08-local-escp-main.c diff --git a/tests/regression/45-escape/06-local-escp.c b/tests/regression/45-escape/06-local-escp.c index 7ae6b4d1d1..d89d569e45 100644 --- a/tests/regression/45-escape/06-local-escp.c +++ b/tests/regression/45-escape/06-local-escp.c @@ -14,6 +14,9 @@ void *thread1(void *pp){ p = &x; sleep(2); __goblint_check(x == 23); //UNKNOWN! + __goblint_check(x <= 23); + __goblint_check(x >= 1); + return NULL; } diff --git a/tests/regression/45-escape/08-local-escp-main.c b/tests/regression/45-escape/08-local-escp-main.c new file mode 100644 index 0000000000..19b4bc7940 --- /dev/null +++ b/tests/regression/45-escape/08-local-escp-main.c @@ -0,0 +1,31 @@ +//PARAM: --enable ana.int.interval +#include +#include +#include +#include + +int g = 0; +int *p = &g; + + +void *thread1(void *pp){ + int x = 23; + __goblint_check(x == 23); + p = &x; + sleep(2); + __goblint_check(x == 23); //UNKNOWN! + __goblint_check(x <= 23); + __goblint_check(x >= 1); + + int y = x; + return NULL; +} + +int main(){ + pthread_t t1; + pthread_t t2; + pthread_create(&t1, NULL, thread1, NULL); + sleep(1); + *p = 1; +} + From fb90c453d01a6f6060fe62036671ed6782ba362c Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 7 Jun 2023 10:32:17 +0200 Subject: [PATCH 428/518] Indent threadEscape.ml --- src/analyses/threadEscape.ml | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 538e7247d0..8a935cf639 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -61,7 +61,7 @@ struct let side_effect_escape ctx escaped threadid = let threadid = G.singleton threadid in D.iter (fun v -> - ctx.sideg v threadid) escaped + ctx.sideg v threadid) escaped (* queries *) let query ctx (type a) (q: a Queries.t): a Queries.result = @@ -88,7 +88,7 @@ struct | `Bot -> M.warn ~category:MessageCategory.Analyzer "CurrentThreadId is bottom."; false - end + end | _ -> Queries.Result.top q let escape_rval ctx (rval:exp) = @@ -132,17 +132,17 @@ struct let threadspawn ctx lval f args fctx = D.join ctx.local @@ - match args with - | [ptc_arg] -> - (* not reusing fctx.local to avoid unnecessarily early join of extra *) - let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in - let escaped = D.filter (fun v -> not v.vglob) escaped in - if M.tracing then M.tracel "escape" "%a: %a\n" d_exp ptc_arg D.pretty escaped; - let thread_id = thread_id ctx in - emit_escape_event ctx escaped; - side_effect_escape ctx escaped thread_id; - escaped - | _ -> D.bot () + match args with + | [ptc_arg] -> + (* not reusing fctx.local to avoid unnecessarily early join of extra *) + let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in + let escaped = D.filter (fun v -> not v.vglob) escaped in + if M.tracing then M.tracel "escape" "%a: %a\n" d_exp ptc_arg D.pretty escaped; + let thread_id = thread_id ctx in + emit_escape_event ctx escaped; + side_effect_escape ctx escaped thread_id; + escaped + | _ -> D.bot () let event ctx e octx = match e with From 64d69c32942ae7b9b58fa189868695718b1891c2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 12:09:14 +0300 Subject: [PATCH 429/518] Simplify Access.add_struct --- src/cdomains/offset.ml | 3 ++- src/domains/access.ml | 32 +++++++++----------------------- 2 files changed, 11 insertions(+), 24 deletions(-) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 26c601607f..4b32599ac6 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -146,7 +146,8 @@ struct let s = GobPretty.sprintf "Addr.type_offset: field %s not found in type %a" f.fname d_plaintype t in raise (Type_of_error (t, s)) in type_of ~base:fi.ftype o - | TComp _, `Index (_,o) -> type_of ~base:t o (* this happens (hmmer, perlbench). safe? *) + (* TODO: Why? Imprecise on zstd-thread-pool regression tests. *) + (* | TComp _, `Index (_,o) -> type_of ~base:t o (* this happens (hmmer, perlbench). safe? *) *) | t,o -> let s = GobPretty.sprintf "Addr.type_offset: could not follow offset in type. type: %a, offset: %a" d_plaintype t pretty o in raise (Type_of_error (t, s)) diff --git a/src/domains/access.ml b/src/domains/access.ml index 813de37425..9036a5f70f 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -98,6 +98,8 @@ struct let to_mval: t -> Mval.Unit.t option = function | (`Var v, o) -> Some (v, o) | (`Type _, _) -> None + + let add_offset ((vt, o): t) o2: t = (vt, Offset.Unit.add_offset o o2) end let rec get_type (fb: typ) : exp -> acc_typ = function @@ -168,19 +170,8 @@ exception Type_offset_error let type_from_type_offset : acc_typ -> typ = function | `Type t -> t | `Struct (s,o) -> - let deref t = - match unrollType t with - | TPtr (t,_) -> t (*?*) - | TArray (t,_,_) -> t - | _ -> raise Type_offset_error (* indexing non-pointer type *) - in - let rec type_from_offs (t,o) = - match o with - | `NoOffset -> t - | `Index ((), os) -> type_from_offs (deref t, os) - | `Field (f,os) -> type_from_offs (f.ftype, os) - in - unrollType (type_from_offs (TComp (s, []), o)) + try Offset.Unit.type_of ~base:(TComp (s, [])) o + with Offset.Type_of_error _ -> raise Type_offset_error let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = let rec dist_fields ty : offs list = @@ -197,29 +188,24 @@ let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = List.map (fun x -> `Index ((), x)) (dist_fields t) | _ -> [`NoOffset] in + let memo = Memo.of_lv_ty lv ty in match ty with - | `Struct (s,os2) -> - let add_lv os = match lv with - | Some (v, os1) -> - assert (Offset.Unit.equal os1 os2); - Some (v, Offset.Unit.add_offset os1 os) - | None -> None - in + | `Struct _ -> begin match type_from_type_offset ty with | t -> let oss = dist_fields t in (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) List.iter (fun os -> - add_one side (Memo.of_lv_ty (add_lv os) (`Struct (s, Offset.Unit.add_offset os2 os)) ) + add_one side (Memo.add_offset memo os) ) oss | exception Type_offset_error -> - add_one side (Memo.of_lv_ty lv ty) + add_one side memo end | _ when lv = None && !unsound -> (* don't recognize accesses to locations such as (long ) and (int ). *) () | _ -> - add_one side (Memo.of_lv_ty lv ty) + add_one side memo let add_propagate side ty = (* ignore (printf "%a:\n" d_exp e); *) From 558ae513d7b9b15a078f33bfe2e6425c0119be26 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 7 Jun 2023 11:24:58 +0200 Subject: [PATCH 430/518] ThreadEscape: add escaped to local state in threadenter. --- src/analyses/threadEscape.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 8a935cf639..f7335dde54 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -127,7 +127,10 @@ struct let threadenter ctx lval f args = match args with | [ptc_arg] -> - [ctx.local] + let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in + let escaped = D.filter (fun v -> not v.vglob) escaped in + emit_escape_event ctx escaped; + [D.join ctx.local escaped] | _ -> [ctx.local] let threadspawn ctx lval f args fctx = From 60d0a561aa6a68ee110bc4fcaa456cda361c58e6 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 7 Jun 2023 11:38:06 +0200 Subject: [PATCH 431/518] Unskip working test (References #860) --- .../46-apron2/24-pipeline-no-threadflag.c | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/tests/regression/46-apron2/24-pipeline-no-threadflag.c b/tests/regression/46-apron2/24-pipeline-no-threadflag.c index 96346800fe..0d0c43ba53 100644 --- a/tests/regression/46-apron2/24-pipeline-no-threadflag.c +++ b/tests/regression/46-apron2/24-pipeline-no-threadflag.c @@ -1,16 +1,20 @@ -// SKIP PARAM: --set ana.activated[+] apron --set ana.activated[-] threadflag +//PARAM: --set ana.activated[+] apron --set ana.activated[-] threadflag --set ana.activated[-] thread --set ana.activated[-] threadid // Minimized from sv-benchmarks/c/systemc/pipeline.cil-1.c #include +#include int main_clk_pos_edge; int main_in1_req_up; int main() { - // main_clk_pos_edge = 2; // TODO: uncomment to unskip apron test - if (main_in1_req_up == 1) // TODO: both branches are dead - assert(0); // TODO: uncomment to unskip apron test, FAIL (unreachable) + int litmus; + main_clk_pos_edge = 2; + if (main_in1_req_up == 1) + litmus = 0; // unreachable else - assert(1); // reachable + litmus = 1; + + __goblint_check(litmus == 1); return (0); } From 5d11f6f47ab5a68ab606ecdad49e449191a9c4f3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 13:42:42 +0300 Subject: [PATCH 432/518] Add Access.Memo.type_of --- src/domains/access.ml | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 9036a5f70f..945afb1156 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -68,6 +68,8 @@ let d_memo () (t, lv) = | Some (v,o) -> dprintf "%a%a@@%a" Basetype.Variables.pretty v Offset.Unit.pretty o CilType.Location.pretty v.vdecl | None -> dprintf "%a" d_acct t +exception Type_offset_error + module Memo = struct include Printable.StdLeaf @@ -100,6 +102,14 @@ struct | (`Type _, _) -> None let add_offset ((vt, o): t) o2: t = (vt, Offset.Unit.add_offset o o2) + + let type_of ((vt, o): t): typ = + let base = match vt with + | `Var v -> v.vtype + | `Type t -> t + in + try Offset.Unit.type_of ~base o + with Offset.Type_of_error _ -> raise Type_offset_error end let rec get_type (fb: typ) : exp -> acc_typ = function @@ -165,7 +175,6 @@ let add_one side memo: unit = if not (is_ignorable mv) then side memo -exception Type_offset_error let type_from_type_offset : acc_typ -> typ = function | `Type t -> t @@ -189,18 +198,15 @@ let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = | _ -> [`NoOffset] in let memo = Memo.of_lv_ty lv ty in - match ty with - | `Struct _ -> - begin match type_from_type_offset ty with - | t -> - let oss = dist_fields t in - (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) - List.iter (fun os -> - add_one side (Memo.add_offset memo os) - ) oss - | exception Type_offset_error -> - add_one side memo - end + match Memo.type_of memo with + | TComp _ as t -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) + let oss = dist_fields t in + (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) + List.iter (fun os -> + add_one side (Memo.add_offset memo os) + ) oss + | exception Type_offset_error -> (* TODO: previously was only in `Struct case, others fell back to unsound case too *) + add_one side memo | _ when lv = None && !unsound -> (* don't recognize accesses to locations such as (long ) and (int ). *) () From 5fd977f2f7169b2c9cac2ee8fd220ab2ef9da420 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 16:36:33 +0300 Subject: [PATCH 433/518] Fix Access.add_struct struct case matching --- src/domains/access.ml | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 945afb1156..fcd263bcce 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -103,12 +103,13 @@ struct let add_offset ((vt, o): t) o2: t = (vt, Offset.Unit.add_offset o o2) - let type_of ((vt, o): t): typ = - let base = match vt with - | `Var v -> v.vtype - | `Type t -> t - in - try Offset.Unit.type_of ~base o + let type_of_base ((vt, _): t): typ = + match vt with + | `Var v -> v.vtype + | `Type t -> t + + let type_of ((vt, o) as memo: t): typ = + try Offset.Unit.type_of ~base:(type_of_base memo) o with Offset.Type_of_error _ -> raise Type_offset_error end @@ -198,15 +199,18 @@ let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = | _ -> [`NoOffset] in let memo = Memo.of_lv_ty lv ty in - match Memo.type_of memo with - | TComp _ as t -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) - let oss = dist_fields t in - (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) - List.iter (fun os -> - add_one side (Memo.add_offset memo os) - ) oss - | exception Type_offset_error -> (* TODO: previously was only in `Struct case, others fell back to unsound case too *) - add_one side memo + match Memo.type_of_base memo with (* based on outermost type *) + | TComp _ -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) + begin match Memo.type_of memo with (* based on innermost type *) + | t -> + let oss = dist_fields t in + (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) + List.iter (fun os -> + add_one side (Memo.add_offset memo os) + ) oss + | exception Type_offset_error -> + add_one side memo + end | _ when lv = None && !unsound -> (* don't recognize accesses to locations such as (long ) and (int ). *) () From 23ed02dcd07cf119c14e32853a5b49e529a3256a Mon Sep 17 00:00:00 2001 From: karoliineh Date: Wed, 7 Jun 2023 17:10:10 +0300 Subject: [PATCH 434/518] Add test case for typedef --- tests/regression/06-symbeq/51-typedef_rc.c | 30 ++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 tests/regression/06-symbeq/51-typedef_rc.c diff --git a/tests/regression/06-symbeq/51-typedef_rc.c b/tests/regression/06-symbeq/51-typedef_rc.c new file mode 100644 index 0000000000..c5aacfe4f6 --- /dev/null +++ b/tests/regression/06-symbeq/51-typedef_rc.c @@ -0,0 +1,30 @@ +// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// Simplified example from the silver searcher +#include + +typedef struct { + char *color_match; +} cli_options; + +struct print_context { + char **context_prev_lines; +}; + +extern struct print_context *get_print_context(); + +cli_options opts; + +void *t_fun(void *arg) { + opts.color_match = "\033[30;43m"; // RACE! + return NULL; +} + +int main(void) { + struct print_context *s; + pthread_t id; + + s = get_print_context(); + pthread_create(&id,NULL,t_fun,NULL); + char *x = s->context_prev_lines[2]; // RACE! + return 0; +} From 74a036f85326122e273be50313017b75cc65171d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 17:12:22 +0300 Subject: [PATCH 435/518] Disable races from free in chrony-name2ipaddress 5d11f6f47ab5a68ab606ecdad49e449191a9c4f3 is a soundness fix. --- tests/regression/06-symbeq/38-chrony-name2ipaddress.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/regression/06-symbeq/38-chrony-name2ipaddress.c b/tests/regression/06-symbeq/38-chrony-name2ipaddress.c index db9abf7123..7ab012e225 100644 --- a/tests/regression/06-symbeq/38-chrony-name2ipaddress.c +++ b/tests/regression/06-symbeq/38-chrony-name2ipaddress.c @@ -1,4 +1,5 @@ -// PARAM: --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --set ana.activated[+] "'mallocFresh'" --set ana.malloc.wrappers '["Malloc"]' --disable sem.unknown_function.spawn --disable sem.unknown_function.invalidate.globals --set pre.cppflags[+] -D_FORTIFY_SOURCE=2 --set pre.cppflags[+] -O3 +// PARAM: --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --set ana.activated[+] "'mallocFresh'" --set ana.malloc.wrappers '["Malloc"]' --disable sem.unknown_function.spawn --disable sem.unknown_function.invalidate.globals --set pre.cppflags[+] -D_FORTIFY_SOURCE=2 --set pre.cppflags[+] -O3 --disable ana.race.free +// Disabled races from free because type-based memory locations don't know the getaddrinfo-free pattern is safe. #include #include // #include From 36c91c5a673dc97088e6c3ec77d07c276bcb17bd Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 17:18:56 +0300 Subject: [PATCH 436/518] Move Access.Memo up to add_struct --- src/analyses/raceAnalysis.ml | 2 +- src/domains/access.ml | 18 +++++++++--------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index 54bc53068d..e9be09764c 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -100,7 +100,7 @@ struct in let add_access_struct conf ci = let a = part_access None in - Access.add_struct (side_access octx (conf, kind, loc, e, a)) (`Struct (ci,`NoOffset)) None + Access.add_struct (side_access octx (conf, kind, loc, e, a)) (`Type (TComp (ci, [])), `NoOffset) in let has_escaped g = octx.ask (Queries.MayEscape g) in (* The following function adds accesses to the lval-set ls diff --git a/src/domains/access.ml b/src/domains/access.ml index fcd263bcce..d5e3e08f84 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -183,7 +183,7 @@ let type_from_type_offset : acc_typ -> typ = function try Offset.Unit.type_of ~base:(TComp (s, [])) o with Offset.Type_of_error _ -> raise Type_offset_error -let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = +let add_struct side memo: unit = let rec dist_fields ty : offs list = match unrollType ty with | TComp (ci,_) -> @@ -198,9 +198,8 @@ let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = List.map (fun x -> `Index ((), x)) (dist_fields t) | _ -> [`NoOffset] in - let memo = Memo.of_lv_ty lv ty in - match Memo.type_of_base memo with (* based on outermost type *) - | TComp _ -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) + match Memo.type_of_base memo, memo with (* based on outermost type *) + | TComp _, _ -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) begin match Memo.type_of memo with (* based on innermost type *) | t -> let oss = dist_fields t in @@ -211,7 +210,7 @@ let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = | exception Type_offset_error -> add_one side memo end - | _ when lv = None && !unsound -> + | _, (`Type _, _) when !unsound -> (* don't recognize accesses to locations such as (long ) and (int ). *) () | _ -> @@ -223,13 +222,13 @@ let add_propagate side ty = let vars = TH.find_all typeVar (TComp (c,[])) in (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) (* 1 test(s) failed: ["04/49 type-invariants"] *) - let add_vars v = add_struct side (`Struct (c, f)) (Some (v, f)) in + let add_vars v = add_struct side (`Var v, f) in List.iter add_vars vars; (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) - add_struct side (`Struct (c, f)) None; + add_struct side (`Type (TComp (c, [])), f); in let just_vars t v = - add_struct side (`Type t) (Some (v, `NoOffset)); + add_struct side (`Var v, `NoOffset); in match ty with | `Struct (c, (`Field (fi, _) as os)) when not (Offset.Unit.contains_index os) -> @@ -256,7 +255,8 @@ let add side e voffs = | Some (v, o) -> Some (v, Offset.Unit.of_cil o) | None -> None in - add_struct side ty voffs'; + let memo = Memo.of_lv_ty voffs' ty in + add_struct side memo; (* TODO: maybe this should not depend on whether voffs = None? *) if voffs = None && not (!unsound && isArithmeticType (type_from_type_offset ty)) then add_propagate side ty From 035b7e3583a59c58f1de0d92ebd326832ee7bcf9 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Wed, 7 Jun 2023 17:30:12 +0300 Subject: [PATCH 437/518] Revert "Refactor: remove typeSig function calls" This reverts commit 8270028b1deaab29f48a5892c87d653d1b54ac5f. --- src/domains/access.ml | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index fcd263bcce..8d2dd82219 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -25,24 +25,22 @@ let is_ignorable = function try isFunctionType v.vtype || is_ignorable_type v.vtype with Not_found -> false -module TH = Hashtbl.Make (CilType.Typ) - -let typeVar = TH.create 101 -let typeIncl = TH.create 101 +let typeVar = Hashtbl.create 101 +let typeIncl = Hashtbl.create 101 let unsound = ref false let init (f:file) = unsound := get_bool "ana.mutex.disjoint_types"; let visited_vars = Hashtbl.create 100 in let visit_field fi = - TH.add typeIncl fi.ftype fi + Hashtbl.add typeIncl (typeSig fi.ftype) fi in let visit_glob = function | GCompTag (c,_) -> List.iter visit_field c.cfields | GVarDecl (v,_) | GVar (v,_,_) -> if not (Hashtbl.mem visited_vars v.vid) then begin - TH.add typeVar v.vtype v; + Hashtbl.add typeVar (typeSig v.vtype) v; (* ignore (printf "init adding %s : %a" v.vname d_typsig ((typeSig v.vtype))); *) Hashtbl.replace visited_vars v.vid true end @@ -51,8 +49,8 @@ let init (f:file) = List.iter visit_glob f.globals let reset () = - TH.clear typeVar; - TH.clear typeIncl + Hashtbl.clear typeVar; + Hashtbl.clear typeIncl type offs = Offset.Unit.t [@@deriving eq, ord, hash] @@ -220,7 +218,7 @@ let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = let add_propagate side ty = (* ignore (printf "%a:\n" d_exp e); *) let struct_inv (f:offs) (c:compinfo) = - let vars = TH.find_all typeVar (TComp (c,[])) in + let vars = Hashtbl.find_all typeVar (typeSig (TComp (c,[]))) in (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) (* 1 test(s) failed: ["04/49 type-invariants"] *) let add_vars v = add_struct side (`Struct (c, f)) (Some (v, f)) in @@ -240,10 +238,10 @@ let add_propagate side ty = | _ -> (* ignore (printf " * type is NOT a struct\n"); *) let t = type_from_type_offset ty in - let incl = TH.find_all typeIncl t in + let incl = Hashtbl.find_all typeIncl (typeSig t) in (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi.fcomp) incl; - let vars = TH.find_all typeVar t in + let vars = Hashtbl.find_all typeVar (typeSig t) in (* TODO: not tested *) List.iter (just_vars t) vars From 8ac30e923bd0a3a1498f4c3c1058538cf96e4949 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Wed, 7 Jun 2023 17:35:59 +0300 Subject: [PATCH 438/518] Replace general Hashtbl with a specialized table with CilType.Typsig keys --- src/domains/access.ml | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 8d2dd82219..7131622fe8 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -25,22 +25,24 @@ let is_ignorable = function try isFunctionType v.vtype || is_ignorable_type v.vtype with Not_found -> false -let typeVar = Hashtbl.create 101 -let typeIncl = Hashtbl.create 101 +module TSH = Hashtbl.Make (CilType.Typsig) + +let typeVar = TSH.create 101 +let typeIncl = TSH.create 101 let unsound = ref false let init (f:file) = unsound := get_bool "ana.mutex.disjoint_types"; let visited_vars = Hashtbl.create 100 in let visit_field fi = - Hashtbl.add typeIncl (typeSig fi.ftype) fi + TSH.add typeIncl (typeSig fi.ftype) fi in let visit_glob = function | GCompTag (c,_) -> List.iter visit_field c.cfields | GVarDecl (v,_) | GVar (v,_,_) -> if not (Hashtbl.mem visited_vars v.vid) then begin - Hashtbl.add typeVar (typeSig v.vtype) v; + TSH.add typeVar (typeSig v.vtype) v; (* ignore (printf "init adding %s : %a" v.vname d_typsig ((typeSig v.vtype))); *) Hashtbl.replace visited_vars v.vid true end @@ -49,8 +51,8 @@ let init (f:file) = List.iter visit_glob f.globals let reset () = - Hashtbl.clear typeVar; - Hashtbl.clear typeIncl + TSH.clear typeVar; + TSH.clear typeIncl type offs = Offset.Unit.t [@@deriving eq, ord, hash] @@ -218,7 +220,7 @@ let add_struct side (ty:acc_typ) (lv: Mval.Unit.t option): unit = let add_propagate side ty = (* ignore (printf "%a:\n" d_exp e); *) let struct_inv (f:offs) (c:compinfo) = - let vars = Hashtbl.find_all typeVar (typeSig (TComp (c,[]))) in + let vars = TSH.find_all typeVar (typeSig (TComp (c,[]))) in (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) (* 1 test(s) failed: ["04/49 type-invariants"] *) let add_vars v = add_struct side (`Struct (c, f)) (Some (v, f)) in @@ -238,10 +240,10 @@ let add_propagate side ty = | _ -> (* ignore (printf " * type is NOT a struct\n"); *) let t = type_from_type_offset ty in - let incl = Hashtbl.find_all typeIncl (typeSig t) in + let incl = TSH.find_all typeIncl (typeSig t) in (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi.fcomp) incl; - let vars = Hashtbl.find_all typeVar (typeSig t) in + let vars = TSH.find_all typeVar (typeSig t) in (* TODO: not tested *) List.iter (just_vars t) vars From 717778aa8f011ea4586998a872913158fa5b374f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 17:58:12 +0300 Subject: [PATCH 439/518] Move Access.Memo up to add_propagate --- src/domains/access.ml | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index d5e3e08f84..88a81ed5a6 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -216,7 +216,7 @@ let add_struct side memo: unit = | _ -> add_one side memo -let add_propagate side ty = +let add_propagate side (memo: Memo.t) = (* ignore (printf "%a:\n" d_exp e); *) let struct_inv (f:offs) (c:compinfo) = let vars = TH.find_all typeVar (TComp (c,[])) in @@ -230,21 +230,22 @@ let add_propagate side ty = let just_vars t v = add_struct side (`Var v, `NoOffset); in - match ty with - | `Struct (c, (`Field (fi, _) as os)) when not (Offset.Unit.contains_index os) -> + match memo with + | (`Type (TComp (c, _)), (`Field (fi, _) as os)) when not (Offset.Unit.contains_index os) -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) assert (CilType.Compinfo.equal c fi.fcomp); (* ignore (printf " * type is a struct\n"); *) (* 1 test(s) failed: ["04/49 type-invariants"] *) struct_inv os c - | _ -> + | (`Type _, _) -> (* ignore (printf " * type is NOT a struct\n"); *) - let t = type_from_type_offset ty in + let t = Memo.type_of memo in let incl = TH.find_all typeIncl t in (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi.fcomp) incl; let vars = TH.find_all typeVar t in (* TODO: not tested *) List.iter (just_vars t) vars + | (`Var _, _) -> assert false let add side e voffs = let ty = get_val_type e voffs in @@ -258,8 +259,8 @@ let add side e voffs = let memo = Memo.of_lv_ty voffs' ty in add_struct side memo; (* TODO: maybe this should not depend on whether voffs = None? *) - if voffs = None && not (!unsound && isArithmeticType (type_from_type_offset ty)) then - add_propagate side ty + if voffs = None && not (!unsound && isArithmeticType (Memo.type_of memo)) then + add_propagate side memo let rec distribute_access_lval f lv = (* Use unoptimized AddrOf so RegionDomain.Reg.eval_exp knows about dereference *) From cadb7ea5444140346c96660c8eca42df622ba110 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 18:31:08 +0300 Subject: [PATCH 440/518] Fix unit offset index show to be ? again --- src/cdomains/offset.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/offset.ml b/src/cdomains/offset.ml index 26c601607f..2b51fa9417 100644 --- a/src/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -11,7 +11,7 @@ struct module Unit: Printable with type t = unit = struct - include Lattice.Unit + include Lattice.UnitConf (struct let name = "?" end) let name () = "unit index" let equal_to _ _ = `Top let to_int _ = None From 2ca99f337171bca104129df86ef9fefa634af377 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Jun 2023 18:36:00 +0300 Subject: [PATCH 441/518] Remove now-unused Access.type_from_type_offset --- src/domains/access.ml | 7 ------- 1 file changed, 7 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index d6e2e99996..36eed25190 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -177,13 +177,6 @@ let add_one side memo: unit = if not (is_ignorable mv) then side memo - -let type_from_type_offset : acc_typ -> typ = function - | `Type t -> t - | `Struct (s,o) -> - try Offset.Unit.type_of ~base:(TComp (s, [])) o - with Offset.Type_of_error _ -> raise Type_offset_error - let add_struct side memo: unit = let rec dist_fields ty : offs list = match unrollType ty with From de1d60590a31094d67084ece34613c943fde8981 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 12:43:23 +0300 Subject: [PATCH 442/518] Add code coverage library bisect_ppx for OCaml --- dune-project | 1 + goblint.opam | 1 + goblint.opam.locked | 1 + src/dune | 1 + 4 files changed, 4 insertions(+) diff --git a/dune-project b/dune-project index 2fbfb271fc..e0b859c3a8 100644 --- a/dune-project +++ b/dune-project @@ -52,6 +52,7 @@ (conf-ruby :with-test) (benchmark :with-test) ; TODO: make this optional somehow, (optional) on bench executable doesn't work conf-gcc ; ensures opam-repository CI installs real gcc from homebrew on MacOS + (bisect_ppx (>= "2.5.0")) ) (depopts apron diff --git a/goblint.opam b/goblint.opam index 678ad53d13..67aaa644be 100644 --- a/goblint.opam +++ b/goblint.opam @@ -49,6 +49,7 @@ depends: [ "conf-ruby" {with-test} "benchmark" {with-test} "conf-gcc" + "bisect_ppx" {>= "2.5.0"} ] depopts: ["apron" "z3"] conflicts: [ diff --git a/goblint.opam.locked b/goblint.opam.locked index acb49a7b14..97779b7f71 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -32,6 +32,7 @@ depends: [ "benchmark" {= "1.6" & with-test} "bigarray-compat" {= "1.1.0"} "bigstringaf" {= "0.9.0"} + "bisect_ppx" {dev & >= "2.5.0"} "bos" {= "0.2.1"} "camlidl" {= "1.11"} "camlp-streams" {= "5.0.1"} diff --git a/src/dune b/src/dune index 45bb8db7ec..85944375ea 100644 --- a/src/dune +++ b/src/dune @@ -61,6 +61,7 @@ (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson ppx_blob)) (preprocessor_deps (file util/options.schema.json)) + (instrumentation (backend bisect_ppx)) ) ; Workaround for alternative dependencies with unqualified subdirs. From 52b4a0911f7145e1c374c16eb08a30fe00ec95dd Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 12:43:42 +0300 Subject: [PATCH 443/518] Add _coverage to .gitignore --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index eae7776b67..ad82541f53 100644 --- a/.gitignore +++ b/.gitignore @@ -94,3 +94,6 @@ transformed.c # docs site/ + +# coverage +_coverage/* \ No newline at end of file From 07852cf2d40e190b14ea67376d52f73d4a3f273a Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 12:44:33 +0300 Subject: [PATCH 444/518] Annotate overloaded || operator usages with [@coverage off] --- src/cdomains/intDomain.ml | 2 +- src/witness/yamlWitness.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/intDomain.ml b/src/cdomains/intDomain.ml index 3b1eecc27d..4af83cf6fb 100644 --- a/src/cdomains/intDomain.ml +++ b/src/cdomains/intDomain.ml @@ -2737,7 +2737,7 @@ module Enums : S with type int_t = BigInt.t = struct if BISet.cardinal ps > 1 || get_bool "witness.invariant.exact" then List.fold_left (fun a x -> let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) + Invariant.(a || i) [@coverage off] ) (Invariant.bot ()) (BISet.elements ps) else Invariant.top () diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index a0b6023365..9be3186463 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -359,7 +359,7 @@ struct | None | Some [] -> acc | Some (x::xs) -> - begin match List.fold_left (fun acc inv -> Invariant.(acc || inv)) x xs with + begin match List.fold_left (fun acc inv -> Invariant.(acc || inv) [@coverage off]) x xs with | `Lifted inv -> let invs = WitnessUtil.InvariantExp.process_exp inv in let c_inv = InvariantCil.exp_replace_original_name c_inv in (* cannot be split *) From 02cec7bee2912a5f3c4a1ee4aa17353d2e580bc5 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 14:20:38 +0300 Subject: [PATCH 445/518] Add *.coverage files to gitignore --- .gitignore | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index ad82541f53..f51bc7c5d9 100644 --- a/.gitignore +++ b/.gitignore @@ -96,4 +96,5 @@ transformed.c site/ # coverage -_coverage/* \ No newline at end of file +_coverage/* +*.coverage \ No newline at end of file From 939779cba4db914a2c7d350299bb7ddd1cf50ea8 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 14:31:36 +0300 Subject: [PATCH 446/518] Add commands to send coverage from GitHub Actions to Coveralls --- .github/workflows/locked.yml | 12 +++++++++++- make.sh | 5 +++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/.github/workflows/locked.yml b/.github/workflows/locked.yml index 751ade6880..52535b0770 100644 --- a/.github/workflows/locked.yml +++ b/.github/workflows/locked.yml @@ -44,8 +44,12 @@ jobs: - name: Install dependencies run: opam install . --deps-only --locked --with-test + - name: Install coverage dependencies + if: ${{ matrix.os == 'ubuntu-latest' }} + run: opam install bisect_ppx + - name: Build - run: ./make.sh nat + run: ./make.sh coverage - name: Test regression run: ./make.sh headers testci @@ -79,6 +83,12 @@ jobs: - name: Test incremental regression with cfg comparison run: ruby scripts/update_suite.rb -c + - run: opam exec -- bisect-ppx-report send-to Coveralls --coverage-path=. + if: ${{ matrix.os == 'ubuntu-latest' }} + env: + COVERALLS_REPO_TOKEN: ${{ secrets.COVERALLS_REPO_TOKEN }} + PULL_REQUEST_NUMBER: ${{ github.event.number }} + - uses: actions/upload-artifact@v3 if: always() with: diff --git a/make.sh b/make.sh index 241cc35480..788289c5ed 100755 --- a/make.sh +++ b/make.sh @@ -23,6 +23,11 @@ rule() { dune build $TARGET.exe && rm -f goblint && cp _build/default/$TARGET.exe goblint + ;; coverage) + eval $(opam config env) + dune build --instrument-with bisect_ppx $TARGET.exe && + rm -f goblint && + cp _build/default/$TARGET.exe goblint ;; release) eval $(opam config env) dune build --profile=release $TARGET.exe && From 570b7dc8e9cd5f11298fb679464f4d6b1a9e9c9b Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 14:50:35 +0300 Subject: [PATCH 447/518] Remove bisect_ppx from project dependencies --- dune-project | 1 - goblint.opam | 1 - goblint.opam.locked | 1 - 3 files changed, 3 deletions(-) diff --git a/dune-project b/dune-project index e0b859c3a8..2fbfb271fc 100644 --- a/dune-project +++ b/dune-project @@ -52,7 +52,6 @@ (conf-ruby :with-test) (benchmark :with-test) ; TODO: make this optional somehow, (optional) on bench executable doesn't work conf-gcc ; ensures opam-repository CI installs real gcc from homebrew on MacOS - (bisect_ppx (>= "2.5.0")) ) (depopts apron diff --git a/goblint.opam b/goblint.opam index 67aaa644be..678ad53d13 100644 --- a/goblint.opam +++ b/goblint.opam @@ -49,7 +49,6 @@ depends: [ "conf-ruby" {with-test} "benchmark" {with-test} "conf-gcc" - "bisect_ppx" {>= "2.5.0"} ] depopts: ["apron" "z3"] conflicts: [ diff --git a/goblint.opam.locked b/goblint.opam.locked index 97779b7f71..acb49a7b14 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -32,7 +32,6 @@ depends: [ "benchmark" {= "1.6" & with-test} "bigarray-compat" {= "1.1.0"} "bigstringaf" {= "0.9.0"} - "bisect_ppx" {dev & >= "2.5.0"} "bos" {= "0.2.1"} "camlidl" {= "1.11"} "camlp-streams" {= "5.0.1"} From 7be032c22a253de7c99adf40533b0357e2968f41 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 14:50:41 +0300 Subject: [PATCH 448/518] Revert "Add commands to send coverage from GitHub Actions to Coveralls" This reverts commit 939779cba4db914a2c7d350299bb7ddd1cf50ea8. --- .github/workflows/locked.yml | 12 +----------- make.sh | 5 ----- 2 files changed, 1 insertion(+), 16 deletions(-) diff --git a/.github/workflows/locked.yml b/.github/workflows/locked.yml index 52535b0770..751ade6880 100644 --- a/.github/workflows/locked.yml +++ b/.github/workflows/locked.yml @@ -44,12 +44,8 @@ jobs: - name: Install dependencies run: opam install . --deps-only --locked --with-test - - name: Install coverage dependencies - if: ${{ matrix.os == 'ubuntu-latest' }} - run: opam install bisect_ppx - - name: Build - run: ./make.sh coverage + run: ./make.sh nat - name: Test regression run: ./make.sh headers testci @@ -83,12 +79,6 @@ jobs: - name: Test incremental regression with cfg comparison run: ruby scripts/update_suite.rb -c - - run: opam exec -- bisect-ppx-report send-to Coveralls --coverage-path=. - if: ${{ matrix.os == 'ubuntu-latest' }} - env: - COVERALLS_REPO_TOKEN: ${{ secrets.COVERALLS_REPO_TOKEN }} - PULL_REQUEST_NUMBER: ${{ github.event.number }} - - uses: actions/upload-artifact@v3 if: always() with: diff --git a/make.sh b/make.sh index 788289c5ed..241cc35480 100755 --- a/make.sh +++ b/make.sh @@ -23,11 +23,6 @@ rule() { dune build $TARGET.exe && rm -f goblint && cp _build/default/$TARGET.exe goblint - ;; coverage) - eval $(opam config env) - dune build --instrument-with bisect_ppx $TARGET.exe && - rm -f goblint && - cp _build/default/$TARGET.exe goblint ;; release) eval $(opam config env) dune build --profile=release $TARGET.exe && From aa2a189399a37009a6acbdc648d776af5cd60fab Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 14:51:20 +0300 Subject: [PATCH 449/518] Add separate github action for coverage --- .github/workflows/coverage.yml | 92 ++++++++++++++++++++++++++++++++++ 1 file changed, 92 insertions(+) create mode 100644 .github/workflows/coverage.yml diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml new file mode 100644 index 0000000000..dac109aafc --- /dev/null +++ b/.github/workflows/coverage.yml @@ -0,0 +1,92 @@ +name: coverage + +on: + pull_request: + + workflow_dispatch: + + schedule: + # nightly + - cron: '31 1 * * *' # 01:31 UTC, 02:31/03:31 Munich, 03:31/04:31 Tartu + # GitHub Actions load is high at minute 0, so avoid that + +jobs: + coverage: + strategy: + fail-fast: false + matrix: + os: + - ubuntu-latest + ocaml-compiler: + - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file + # don't add any other because they won't be used + + runs-on: ${{ matrix.os }} + + env: + OCAMLRUNPARAM: b + + steps: + - name: Checkout code + uses: actions/checkout@v3 + + - name: Set up OCaml ${{ matrix.ocaml-compiler }} + env: + # otherwise setup-ocaml pins non-locked dependencies + # https://github.com/ocaml/setup-ocaml/issues/166 + OPAMLOCKED: locked + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + + - name: Install dependencies + run: opam install . --deps-only --locked --with-test + + - name: Install coverage dependencies + run: opam install bisect_ppx + + - name: Build + run: ./make.sh coverage + + - name: Test regression + run: ./make.sh headers testci + + - name: Test apron regression # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) + run: | + ruby scripts/update_suite.rb group apron -s + ruby scripts/update_suite.rb group apron2 -s + + - name: Test apron octagon regression # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) + run: ruby scripts/update_suite.rb group octagon -s + + - name: Test apron affeq regression # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) + run: ruby scripts/update_suite.rb group affeq -s + + - name: Test apron regression (Mukherjee et. al SAS '17 paper') # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) + run: ruby scripts/update_suite.rb group apron-mukherjee -s + + - name: Test regression cram + run: opam exec -- dune runtest tests/regression + + - name: Test incremental cram + run: opam exec -- dune runtest tests/incremental + + - name: Test unit + run: opam exec -- dune runtest unittest + + - name: Test incremental regression + run: ruby scripts/update_suite.rb -i + + - name: Test incremental regression with cfg comparison + run: ruby scripts/update_suite.rb -c + + - run: opam exec -- bisect-ppx-report send-to Coveralls --coverage-path=. + env: + COVERALLS_REPO_TOKEN: ${{ secrets.COVERALLS_REPO_TOKEN }} + PULL_REQUEST_NUMBER: ${{ github.event.number }} + + - uses: actions/upload-artifact@v3 + if: always() + with: + name: suite_result + path: tests/suite_result/ \ No newline at end of file From 8b7492c3182ed7f9890eab5639c1e9c74aaf7430 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 14:53:11 +0300 Subject: [PATCH 450/518] Temporarily add push to coverage workflow --- .github/workflows/coverage.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index dac109aafc..d34f936c87 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -1,6 +1,7 @@ name: coverage on: + push: pull_request: workflow_dispatch: From 358e7e8fe34e499104243067ac8e8c81a7a12a4b Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 14:53:35 +0300 Subject: [PATCH 451/518] Revert "Temporarily add push to coverage workflow" This reverts commit 8b7492c3182ed7f9890eab5639c1e9c74aaf7430. --- .github/workflows/coverage.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index d34f936c87..dac109aafc 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -1,7 +1,6 @@ name: coverage on: - push: pull_request: workflow_dispatch: From 9728852a3b3519bcc3eac7812f4a89716a24e808 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 8 Jun 2023 15:04:23 +0300 Subject: [PATCH 452/518] Make `Var case more direct in Access --- src/domains/access.ml | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 36eed25190..47f4cf657b 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -92,11 +92,10 @@ struct end ) - let of_lv_ty (lv: Mval.Unit.t option) (ty: acc_typ): t = - match lv, ty with - | Some (v, o), _ -> (`Var v, o) - | None, `Struct (c, o) -> (`Type (TComp (c, [])), o) - | None, `Type t -> (`Type t, `NoOffset) + let of_ty (ty: acc_typ): t = + match ty with + | `Struct (c, o) -> (`Type (TComp (c, [])), o) + | `Type t -> (`Type t, `NoOffset) let to_mval: t -> Mval.Unit.t option = function | (`Var v, o) -> Some (v, o) @@ -163,13 +162,9 @@ let get_type fb e = -let get_val_type e (voffs: (varinfo * offset) option) : acc_typ = +let get_val_type e: acc_typ = match Cilfacade.typeOf e with - | t -> - begin match voffs with - | Some (v, o) -> get_type t (AddrOf (Var v, o)) - | None -> get_type t e - end + | t -> get_type t e | exception (Cilfacade.TypeOfError _) -> get_type voidType e let add_one side memo: unit = @@ -242,15 +237,14 @@ let add_propagate side (memo: Memo.t) = | (`Var _, _) -> assert false let add side e voffs = - let ty = get_val_type e voffs in (* let loc = !Tracing.current_loc in *) (* ignore (printf "add %a %b -- %a\n" d_exp e w d_loc loc); *) - let voffs' = - match voffs with - | Some (v, o) -> Some (v, Offset.Unit.of_cil o) - | None -> None + let memo = match voffs with + | Some (v, o) -> (`Var v, Offset.Unit.of_cil o) + | None -> + let ty = get_val_type e in + Memo.of_ty ty in - let memo = Memo.of_lv_ty voffs' ty in add_struct side memo; (* TODO: maybe this should not depend on whether voffs = None? *) if voffs = None && not (!unsound && isArithmeticType (Memo.type_of memo)) then From 2a349f45dcb26bbae4dc539c0fe24bf1ff6b9c85 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 15:40:34 +0300 Subject: [PATCH 453/518] Add coverage to make.sh --- make.sh | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/make.sh b/make.sh index 241cc35480..788289c5ed 100755 --- a/make.sh +++ b/make.sh @@ -23,6 +23,11 @@ rule() { dune build $TARGET.exe && rm -f goblint && cp _build/default/$TARGET.exe goblint + ;; coverage) + eval $(opam config env) + dune build --instrument-with bisect_ppx $TARGET.exe && + rm -f goblint && + cp _build/default/$TARGET.exe goblint ;; release) eval $(opam config env) dune build --profile=release $TARGET.exe && From b15d06ec3789d2a8d006a4a56ed6e95956c3b5a7 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 15:43:44 +0300 Subject: [PATCH 454/518] Temporarily add push to coverage workflow --- .github/workflows/coverage.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index dac109aafc..d34f936c87 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -1,6 +1,7 @@ name: coverage on: + push: pull_request: workflow_dispatch: From 43942c4c4dd6973329a69247924357e1fd1007b0 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 16:01:51 +0300 Subject: [PATCH 455/518] Add coverage badge to ReadMe --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index bcfd4e401d..3174c2dcec 100644 --- a/README.md +++ b/README.md @@ -6,6 +6,7 @@ [![GitHub release status](https://img.shields.io/github/v/release/goblint/analyzer)](https://github.com/goblint/analyzer/releases) [![opam package status](https://badgen.net/opam/v/goblint)](https://opam.ocaml.org/packages/goblint) [![Zenodo DOI](https://zenodo.org/badge/2066905.svg)](https://zenodo.org/badge/latestdoi/2066905) +[![Coverage Status](https://coveralls.io/repos/github/goblint/analyzer/badge.svg?branch=master)](https://coveralls.io/github/goblint/analyzer?branch=master) Documentation can be browsed on [Read the Docs](https://goblint.readthedocs.io/en/latest/) or [GitHub](./docs/). From 55ed3dbe29b90f80167ad2c9455bbb35ac478455 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 16:14:36 +0300 Subject: [PATCH 456/518] Document coverage --- docs/developer-guide/testing.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/docs/developer-guide/testing.md b/docs/developer-guide/testing.md index 3ab442424b..bcb68f7986 100644 --- a/docs/developer-guide/testing.md +++ b/docs/developer-guide/testing.md @@ -119,3 +119,17 @@ To test a domain, you need to do the following: 1. Implement `arbitrary` (reasonably). 2. Add the domain to `Maindomaintest`. + +## Coverage + +The [Bisect_ppx](https://github.com/aantron/bisect_ppx) tool is used to produce code coverage reports for Goblint. +The code coverage reports are available on [Coveralls](https://coveralls.io/github/goblint/analyzer). + +To run `bisect_ppx` locally: + +1. Install `bisect_ppx` with `opam install bisect_ppx`. +2. [Instrument dune](https://dune.readthedocs.io/en/stable/instrumentation.html#enabling-disabling-instrumentation) with `bisect_ppx`. +3. Run tests (this will now generate `.coverage` files). +4. Generate coverage report with `bisect-ppx-report html --coverage-path=tests`. +5. After that the generated `.coverage` files can be removed with `find . -type f -name '*.coverage' -delete`. +6. The HTML report can be found in the `_coverage` folder. \ No newline at end of file From 97a7ad44a92b8703745bbac7c01bf9b5dead0761 Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 8 Jun 2023 16:15:43 +0300 Subject: [PATCH 457/518] Revert "Temporarily add push to coverage workflow" This reverts commit b15d06ec3789d2a8d006a4a56ed6e95956c3b5a7. --- .github/workflows/coverage.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index d34f936c87..dac109aafc 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -1,7 +1,6 @@ name: coverage on: - push: pull_request: workflow_dispatch: From f38c4d6881d7d49c0b041d570698ec42bb35b2b0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 8 Jun 2023 16:42:41 +0300 Subject: [PATCH 458/518] Make Access fallback type lazy --- src/domains/access.ml | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 47f4cf657b..2acb311da3 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -113,20 +113,20 @@ struct with Offset.Type_of_error _ -> raise Type_offset_error end -let rec get_type (fb: typ) : exp -> acc_typ = function +let rec get_type (fb: typ Lazy.t) : exp -> acc_typ = function | AddrOf (h,o) | StartOf (h,o) -> let rec f htyp = match htyp with | TComp (ci,_) -> `Struct (ci, Offset.Unit.of_cil o) | TNamed (ti,_) -> f ti.ttype - | _ -> `Type fb + | _ -> `Type (Lazy.force fb) in begin match o with | Field (f, on) -> `Struct (f.fcomp, Offset.Unit.of_cil o) | NoOffset | Index _ -> begin match h with | Var v -> f (v.vtype) - | Mem e -> f fb + | Mem e -> f (Lazy.force fb) end end | SizeOf _ | SizeOfE _ | SizeOfStr _ | AlignOf _ | AlignOfE _ | AddrOfLabel _ -> @@ -149,7 +149,7 @@ let rec get_type (fb: typ) : exp -> acc_typ = function | Lval _ | Real _ | Imag _ -> - `Type fb (* TODO: is this right? *) + `Type (Lazy.force fb) (* TODO: is this right? *) let get_type fb e = (* printf "e = %a\n" d_plainexp e; *) @@ -163,9 +163,12 @@ let get_type fb e = let get_val_type e: acc_typ = - match Cilfacade.typeOf e with - | t -> get_type t e - | exception (Cilfacade.TypeOfError _) -> get_type voidType e + let fb = lazy ( + try Cilfacade.typeOf e + with Cilfacade.TypeOfError _ -> voidType + ) + in + get_type fb e let add_one side memo: unit = let mv = Memo.to_mval memo in From 2aa2837ab28fa4e87f9d25df748e86d671c263ff Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 8 Jun 2023 16:48:19 +0300 Subject: [PATCH 459/518] Add TODOs to Access.get_type --- src/domains/access.ml | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 2acb311da3..13f35037de 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -113,24 +113,25 @@ struct with Offset.Type_of_error _ -> raise Type_offset_error end +(* TODO: What is the logic for get_type? *) let rec get_type (fb: typ Lazy.t) : exp -> acc_typ = function | AddrOf (h,o) | StartOf (h,o) -> let rec f htyp = match htyp with | TComp (ci,_) -> `Struct (ci, Offset.Unit.of_cil o) | TNamed (ti,_) -> f ti.ttype - | _ -> `Type (Lazy.force fb) + | _ -> `Type (Lazy.force fb) (* TODO: Why fb not htyp? *) in begin match o with | Field (f, on) -> `Struct (f.fcomp, Offset.Unit.of_cil o) | NoOffset | Index _ -> begin match h with | Var v -> f (v.vtype) - | Mem e -> f (Lazy.force fb) + | Mem e -> f (Lazy.force fb) (* TODO: type of Mem doesn't have to be the fallback type if offsets present? *) end end | SizeOf _ | SizeOfE _ | SizeOfStr _ | AlignOf _ | AlignOfE _ | AddrOfLabel _ -> - `Type (uintType) + `Type (uintType) (* TODO: Correct types from typeOf? *) | UnOp (_,_,t) -> `Type t | BinOp (_,_,_,t) -> `Type t | CastE (t,e) -> @@ -156,8 +157,8 @@ let get_type fb e = let r = get_type fb e in (* printf "result = %a\n" d_acct r; *) match r with - | `Type (TPtr (t,a)) -> `Type t - | x -> x + | `Type (TPtr (t,a)) -> `Type t (* Why this special case? Almost always taken if not `Struct. *) + | x -> x (* Mostly for `Struct, but also rare cases with non-pointer `Type. Should they happen at all? *) @@ -165,7 +166,7 @@ let get_type fb e = let get_val_type e: acc_typ = let fb = lazy ( try Cilfacade.typeOf e - with Cilfacade.TypeOfError _ -> voidType + with Cilfacade.TypeOfError _ -> voidType (* Why is this a suitable default? *) ) in get_type fb e From 491d01c553cf073c5f56499026cb431c62ee8f25 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 8 Jun 2023 17:18:59 +0300 Subject: [PATCH 460/518] Add Access ignorable type TODOs --- src/domains/access.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/domains/access.ml b/src/domains/access.ml index 13f35037de..bdc6169931 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -35,6 +35,8 @@ let init (f:file) = unsound := get_bool "ana.mutex.disjoint_types"; let visited_vars = Hashtbl.create 100 in let visit_field fi = + (* TODO: is_ignorable_type? *) + (* TODO: Direct ignoring doesn't really work since it doesn't account for pthread inner structs/unions being only reachable via ignorable types. *) TSH.add typeIncl (typeSig fi.ftype) fi in let visit_glob = function @@ -42,6 +44,7 @@ let init (f:file) = List.iter visit_field c.cfields | GVarDecl (v,_) | GVar (v,_,_) -> if not (Hashtbl.mem visited_vars v.vid) then begin + (* TODO: is_ignorable? *) TSH.add typeVar (typeSig v.vtype) v; (* ignore (printf "init adding %s : %a" v.vname d_typsig ((typeSig v.vtype))); *) Hashtbl.replace visited_vars v.vid true @@ -178,6 +181,7 @@ let add_one side memo: unit = let add_struct side memo: unit = let rec dist_fields ty : offs list = + (* TODO: is_ignorable_type outside of TComp if ty itself is ignorable? *) match unrollType ty with | TComp (ci,_) -> let one_field fld = From 8a4406bb1dda16b39c821b5c85881661a20a6594 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 8 Jun 2023 17:43:46 +0300 Subject: [PATCH 461/518] Polish coverage --- .github/workflows/coverage.yml | 2 +- .gitignore | 5 ++++- README.md | 9 +++++---- docs/developer-guide/testing.md | 12 ++++++------ 4 files changed, 16 insertions(+), 12 deletions(-) diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index dac109aafc..7472cbc820 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -89,4 +89,4 @@ jobs: if: always() with: name: suite_result - path: tests/suite_result/ \ No newline at end of file + path: tests/suite_result/ diff --git a/.gitignore b/.gitignore index f51bc7c5d9..75bd23d36b 100644 --- a/.gitignore +++ b/.gitignore @@ -96,5 +96,8 @@ transformed.c site/ # coverage + +# bisect_ppx +*.coverage +# bisect-ppx-report _coverage/* -*.coverage \ No newline at end of file diff --git a/README.md b/README.md index 3174c2dcec..b03b7bbe36 100644 --- a/README.md +++ b/README.md @@ -1,12 +1,13 @@ # Goblint -[![locked workflow status](https://github.com/goblint/analyzer/actions/workflows/locked.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/locked.yml) -[![unlocked workflow status](https://github.com/goblint/analyzer/actions/workflows/unlocked.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/unlocked.yml) -[![docker workflow status](https://github.com/goblint/analyzer/actions/workflows/docker.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/docker.yml) -[![Documentation Status](https://readthedocs.org/projects/goblint/badge/?version=latest)](https://goblint.readthedocs.io/en/latest/?badge=latest) [![GitHub release status](https://img.shields.io/github/v/release/goblint/analyzer)](https://github.com/goblint/analyzer/releases) [![opam package status](https://badgen.net/opam/v/goblint)](https://opam.ocaml.org/packages/goblint) [![Zenodo DOI](https://zenodo.org/badge/2066905.svg)](https://zenodo.org/badge/latestdoi/2066905) + +[![locked workflow status](https://github.com/goblint/analyzer/actions/workflows/locked.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/locked.yml) +[![unlocked workflow status](https://github.com/goblint/analyzer/actions/workflows/unlocked.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/unlocked.yml) [![Coverage Status](https://coveralls.io/repos/github/goblint/analyzer/badge.svg?branch=master)](https://coveralls.io/github/goblint/analyzer?branch=master) +[![docker workflow status](https://github.com/goblint/analyzer/actions/workflows/docker.yml/badge.svg)](https://github.com/goblint/analyzer/actions/workflows/docker.yml) +[![Documentation Status](https://readthedocs.org/projects/goblint/badge/?version=latest)](https://goblint.readthedocs.io/en/latest/?badge=latest) Documentation can be browsed on [Read the Docs](https://goblint.readthedocs.io/en/latest/) or [GitHub](./docs/). diff --git a/docs/developer-guide/testing.md b/docs/developer-guide/testing.md index bcb68f7986..e8dad33299 100644 --- a/docs/developer-guide/testing.md +++ b/docs/developer-guide/testing.md @@ -122,14 +122,14 @@ To test a domain, you need to do the following: ## Coverage -The [Bisect_ppx](https://github.com/aantron/bisect_ppx) tool is used to produce code coverage reports for Goblint. +The [bisect_ppx](https://github.com/aantron/bisect_ppx) tool is used to produce code coverage reports for Goblint. The code coverage reports are available on [Coveralls](https://coveralls.io/github/goblint/analyzer). To run `bisect_ppx` locally: -1. Install `bisect_ppx` with `opam install bisect_ppx`. -2. [Instrument dune](https://dune.readthedocs.io/en/stable/instrumentation.html#enabling-disabling-instrumentation) with `bisect_ppx`. -3. Run tests (this will now generate `.coverage` files). -4. Generate coverage report with `bisect-ppx-report html --coverage-path=tests`. +1. Install bisect_ppx with `opam install bisect_ppx`. +2. Run `make coverage` to build Goblint with bisect_ppx instrumentation. +3. Run tests (this will now generate `.coverage` files in various directories). +4. Generate coverage report with `bisect-ppx-report html --coverage-path=.`. 5. After that the generated `.coverage` files can be removed with `find . -type f -name '*.coverage' -delete`. -6. The HTML report can be found in the `_coverage` folder. \ No newline at end of file +6. The HTML report can be found in the `_coverage` folder. From 0fd1c3fb9666d1d14b4dbea9f09535fda765e726 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 8 Jun 2023 18:24:38 +0300 Subject: [PATCH 462/518] Add Access tracing --- src/analyses/accessAnalysis.ml | 8 +-- src/domains/access.ml | 93 +++++++++++++++++++--------------- 2 files changed, 58 insertions(+), 43 deletions(-) diff --git a/src/analyses/accessAnalysis.ml b/src/analyses/accessAnalysis.ml index 0ecf797eb7..5245e4adfe 100644 --- a/src/analyses/accessAnalysis.ml +++ b/src/analyses/accessAnalysis.ml @@ -42,13 +42,15 @@ struct + [deref=true], [reach=false] - Access [exp] by dereferencing once (may-point-to), used for lval writes and shallow special accesses. + [deref=true], [reach=true] - Access [exp] by dereferencing transitively (reachable), used for deep special accesses. *) let access_one_top ?(force=false) ?(deref=false) ctx (kind: AccessKind.t) reach exp = - if M.tracing then M.traceli "access" "access_one_top %a %b %a:\n" AccessKind.pretty kind reach d_exp exp; + if M.tracing then M.traceli "access" "access_one_top %a (kind = %a, reach = %B, deref = %B)\n" CilType.Exp.pretty exp AccessKind.pretty kind reach deref; if force || !collect_local || !emit_single_threaded || ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx) then ( if deref then do_access ctx kind reach exp; - Access.distribute_access_exp (do_access ctx Read false) exp + if M.tracing then M.tracei "access" "distribute_access_exp\n"; + Access.distribute_access_exp (do_access ctx Read false) exp; + if M.tracing then M.traceu "access" "distribute_access_exp\n"; ); - if M.tracing then M.traceu "access" "access_one_top %a %b %a\n" AccessKind.pretty kind reach d_exp exp + if M.tracing then M.traceu "access" "access_one_top\n" (** We just lift start state, global and dependency functions: *) let startstate v = () diff --git a/src/domains/access.ml b/src/domains/access.ml index bdc6169931..0ba6025aae 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -176,10 +176,13 @@ let get_val_type e: acc_typ = let add_one side memo: unit = let mv = Memo.to_mval memo in - if not (is_ignorable mv) then + let ignorable = is_ignorable mv in + if M.tracing then M.trace "access" "add_one %a (ignorable = %B)\n" Memo.pretty memo ignorable; + if not ignorable then side memo let add_struct side memo: unit = + if M.tracing then M.tracei "access" "add_struct %a\n" Memo.pretty memo; let rec dist_fields ty : offs list = (* TODO: is_ignorable_type outside of TComp if ty itself is ignorable? *) match unrollType ty with @@ -195,29 +198,34 @@ let add_struct side memo: unit = List.map (fun x -> `Index ((), x)) (dist_fields t) | _ -> [`NoOffset] in - match Memo.type_of_base memo, memo with (* based on outermost type *) - | TComp _, _ -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) - begin match Memo.type_of memo with (* based on innermost type *) - | t -> - let oss = dist_fields t in - (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) - List.iter (fun os -> - add_one side (Memo.add_offset memo os) - ) oss - | exception Type_offset_error -> - add_one side memo - end - | _, (`Type _, _) when !unsound -> - (* don't recognize accesses to locations such as (long ) and (int ). *) - () - | _ -> - add_one side memo + begin match Memo.type_of_base memo, memo with (* based on outermost type *) + | TComp _, _ -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) + if M.tracing then M.trace "access" "struct case\n"; + begin match Memo.type_of memo with (* based on innermost type *) + | t -> + let oss = dist_fields t in + (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) + List.iter (fun os -> + add_one side (Memo.add_offset memo os) + ) oss + | exception Type_offset_error -> + if M.tracing then M.trace "access" "Type_offset_error\n"; + add_one side memo + end + | _, (`Type _, _) when !unsound -> + (* don't recognize accesses to locations such as (long ) and (int ). *) + if M.tracing then M.trace "access" "unsound case\n"; + () + | _ -> + if M.tracing then M.trace "access" "general case\n"; + add_one side memo + end; + if M.tracing then M.traceu "access" "add_struct\n" let add_propagate side (memo: Memo.t) = - (* ignore (printf "%a:\n" d_exp e); *) + if M.tracing then M.tracei "access" "add_propagate %a\n" Memo.pretty memo; let struct_inv (f:offs) (c:compinfo) = let vars = TSH.find_all typeVar (typeSig (TComp (c,[]))) in - (* List.iter (fun v -> ignore (printf " * %s : %a" v.vname d_typsig ts)) vars; *) (* 1 test(s) failed: ["04/49 type-invariants"] *) let add_vars v = add_struct side (`Var v, f) in List.iter add_vars vars; @@ -227,36 +235,41 @@ let add_propagate side (memo: Memo.t) = let just_vars t v = add_struct side (`Var v, `NoOffset); in - match memo with - | (`Type (TComp (c, _)), (`Field (fi, _) as os)) when not (Offset.Unit.contains_index os) -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) - assert (CilType.Compinfo.equal c fi.fcomp); - (* ignore (printf " * type is a struct\n"); *) - (* 1 test(s) failed: ["04/49 type-invariants"] *) - struct_inv os c - | (`Type _, _) -> - (* ignore (printf " * type is NOT a struct\n"); *) - let t = Memo.type_of memo in - let incl = TSH.find_all typeIncl (typeSig t) in - (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) - List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi.fcomp) incl; - let vars = TSH.find_all typeVar (typeSig t) in - (* TODO: not tested *) - List.iter (just_vars t) vars - | (`Var _, _) -> assert false + begin match memo with + | (`Type (TComp (c, _)), (`Field (fi, _) as os)) when not (Offset.Unit.contains_index os) -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) + if M.tracing then M.trace "access" "struct case\n"; + assert (CilType.Compinfo.equal c fi.fcomp); + (* 1 test(s) failed: ["04/49 type-invariants"] *) + struct_inv os c + | (`Type _, _) -> + if M.tracing then M.trace "access" "general case\n"; + let t = Memo.type_of memo in + let incl = TSH.find_all typeIncl (typeSig t) in + (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) + List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi.fcomp) incl; + let vars = TSH.find_all typeVar (typeSig t) in + (* TODO: not tested *) + List.iter (just_vars t) vars + | (`Var _, _) -> assert false + end; + if M.tracing then M.traceu "access" "add_propagate\n" let add side e voffs = - (* let loc = !Tracing.current_loc in *) - (* ignore (printf "add %a %b -- %a\n" d_exp e w d_loc loc); *) let memo = match voffs with - | Some (v, o) -> (`Var v, Offset.Unit.of_cil o) + | Some (v, o) -> + if M.tracing then M.traceli "access" "add %a%a\n" CilType.Varinfo.pretty v CilType.Offset.pretty o; + (`Var v, Offset.Unit.of_cil o) | None -> + if M.tracing then M.traceli "access" "add %a\n" CilType.Exp.pretty e; let ty = get_val_type e in Memo.of_ty ty in + if M.tracing then M.trace "access" "memo = %a\n" Memo.pretty memo; add_struct side memo; (* TODO: maybe this should not depend on whether voffs = None? *) if voffs = None && not (!unsound && isArithmeticType (Memo.type_of memo)) then - add_propagate side memo + add_propagate side memo; + if M.tracing then M.traceu "access" "add\n" let rec distribute_access_lval f lv = (* Use unoptimized AddrOf so RegionDomain.Reg.eval_exp knows about dereference *) From 1855e9b3e0c71bfaed33a9bc98a50dfe6c77c9d1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 11:38:20 +0300 Subject: [PATCH 463/518] Skip test in apron2 group https://github.com/goblint/analyzer/commit/60d0a561aa6a68ee110bc4fcaa456cda361c58e6#commitcomment-117072143. --- tests/regression/46-apron2/24-pipeline-no-threadflag.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/46-apron2/24-pipeline-no-threadflag.c b/tests/regression/46-apron2/24-pipeline-no-threadflag.c index 0d0c43ba53..8e066a0f34 100644 --- a/tests/regression/46-apron2/24-pipeline-no-threadflag.c +++ b/tests/regression/46-apron2/24-pipeline-no-threadflag.c @@ -1,4 +1,4 @@ -//PARAM: --set ana.activated[+] apron --set ana.activated[-] threadflag --set ana.activated[-] thread --set ana.activated[-] threadid +// SKIP PARAM: --set ana.activated[+] apron --set ana.activated[-] threadflag --set ana.activated[-] thread --set ana.activated[-] threadid // Minimized from sv-benchmarks/c/systemc/pipeline.cil-1.c #include #include From 8222b85ac76750cd53d8918c4f66e939118fa148 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 11:40:35 +0300 Subject: [PATCH 464/518] Comment [@coverage off] annotations --- src/cdomains/intDomain.ml | 2 +- src/witness/yamlWitness.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/intDomain.ml b/src/cdomains/intDomain.ml index 4af83cf6fb..589239810f 100644 --- a/src/cdomains/intDomain.ml +++ b/src/cdomains/intDomain.ml @@ -2737,7 +2737,7 @@ module Enums : S with type int_t = BigInt.t = struct if BISet.cardinal ps > 1 || get_bool "witness.invariant.exact" then 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] + Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) (Invariant.bot ()) (BISet.elements ps) else Invariant.top () diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 9be3186463..c7106a57b5 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -359,7 +359,7 @@ struct | None | Some [] -> acc | Some (x::xs) -> - begin match List.fold_left (fun acc inv -> Invariant.(acc || inv) [@coverage off]) x xs with + begin match List.fold_left (fun acc inv -> Invariant.(acc || inv) [@coverage off]) x xs with (* bisect_ppx cannot handle redefined (||) *) | `Lifted inv -> let invs = WitnessUtil.InvariantExp.process_exp inv in let c_inv = InvariantCil.exp_replace_original_name c_inv in (* cannot be split *) From 9180fe88fc27772847f29f7286939ec8f4907fcc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 11:57:04 +0300 Subject: [PATCH 465/518] Fix update_suite.rb group autocompletion --- scripts/bash-completion.sh | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/scripts/bash-completion.sh b/scripts/bash-completion.sh index 5751cd0cc4..cb518d4478 100644 --- a/scripts/bash-completion.sh +++ b/scripts/bash-completion.sh @@ -40,7 +40,9 @@ _update_suite () case $COMP_CWORD in 1) COMPREPLY=($(ls -1 tests/regression/*/*.c | sed -n -r 's|.*/([0-9][0-9])-(.*)\.c|\2|p' | grep "^${COMP_WORDS[1]}")) - COMPREPLY+=("group") + if [[ "group" =~ ^${COMP_WORDS[1]} ]]; then + COMPREPLY+=("group") + fi ;; 2) if [[ ${COMP_WORDS[1]} == "group" ]] ; then From bbf4df03f5a13691d9129d357c573f43546e88f7 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 12:01:07 +0300 Subject: [PATCH 466/518] Remove unused code from Access --- src/domains/access.ml | 42 ++++++------------------------------------ 1 file changed, 6 insertions(+), 36 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 0ba6025aae..45c2d27c42 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -58,18 +58,7 @@ let reset () = TSH.clear typeIncl -type offs = Offset.Unit.t [@@deriving eq, ord, hash] - -type acc_typ = [ `Type of CilType.Typ.t | `Struct of CilType.Compinfo.t * offs ] [@@deriving eq, ord, hash] - -let d_acct () = function - | `Type t -> dprintf "(%a)" d_type t - | `Struct (s,o) -> dprintf "(struct %s)%a" s.cname Offset.Unit.pretty o - -let d_memo () (t, lv) = - match lv with - | Some (v,o) -> dprintf "%a%a@@%a" Basetype.Variables.pretty v Offset.Unit.pretty o CilType.Location.pretty v.vdecl - | None -> dprintf "%a" d_acct t +type acc_typ = [ `Type of CilType.Typ.t | `Struct of CilType.Compinfo.t * Offset.Unit.t ] [@@deriving eq, ord, hash] exception Type_offset_error @@ -145,7 +134,7 @@ let rec get_type (fb: typ Lazy.t) : exp -> acc_typ = function | Question (_,b,c,t) -> begin match get_type fb b, get_type fb c with | `Struct (s1,o1), `Struct (s2,o2) - when CilType.Compinfo.equal s1 s2 && equal_offs o1 o2 -> + when CilType.Compinfo.equal s1 s2 && Offset.Unit.equal o1 o2 -> `Struct (s1, o1) | _ -> `Type t end @@ -163,9 +152,6 @@ let get_type fb e = | `Type (TPtr (t,a)) -> `Type t (* Why this special case? Almost always taken if not `Struct. *) | x -> x (* Mostly for `Struct, but also rare cases with non-pointer `Type. Should they happen at all? *) - - - let get_val_type e: acc_typ = let fb = lazy ( try Cilfacade.typeOf e @@ -174,6 +160,7 @@ let get_val_type e: acc_typ = in get_type fb e + let add_one side memo: unit = let mv = Memo.to_mval memo in let ignorable = is_ignorable mv in @@ -183,7 +170,7 @@ let add_one side memo: unit = let add_struct side memo: unit = if M.tracing then M.tracei "access" "add_struct %a\n" Memo.pretty memo; - let rec dist_fields ty : offs list = + let rec dist_fields ty : Offset.Unit.t list = (* TODO: is_ignorable_type outside of TComp if ty itself is ignorable? *) match unrollType ty with | TComp (ci,_) -> @@ -224,7 +211,7 @@ let add_struct side memo: unit = let add_propagate side (memo: Memo.t) = if M.tracing then M.tracei "access" "add_propagate %a\n" Memo.pretty memo; - let struct_inv (f:offs) (c:compinfo) = + let struct_inv (f:Offset.Unit.t) (c:compinfo) = let vars = TSH.find_all typeVar (typeSig (TComp (c,[]))) in (* 1 test(s) failed: ["04/49 type-invariants"] *) let add_vars v = add_struct side (`Var v, f) in @@ -372,6 +359,7 @@ struct let relift (conf, kind, node, e, a) = (conf, kind, node, e, MCPAccess.A.relift a) end + module AS = struct include SetDomain.Make (A) @@ -379,24 +367,6 @@ struct let max_conf accs = accs |> elements |> List.map A.conf |> (List.max ~cmp:Int.compare) end -module T = -struct - include Printable.StdLeaf - type t = acc_typ [@@deriving eq, ord, hash] - - let name () = "acc_typ" - - let pretty = d_acct - include Printable.SimplePretty ( - struct - type nonrec t = t - let pretty = pretty - end - ) -end -module O = Offset.Unit -module LV = Printable.Prod (CilType.Varinfo) (O) -module LVOpt = Printable.Option (LV) (struct let name = "NONE" end) (* Check if two accesses may race and if yes with which confidence *) From 7c8928ff5dd4204cb1d3016c54a24c216ba4b5dd Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 12:17:13 +0300 Subject: [PATCH 467/518] Add second Access typedef test --- tests/regression/06-symbeq/52-typedef2_rc.c | 26 +++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 tests/regression/06-symbeq/52-typedef2_rc.c diff --git a/tests/regression/06-symbeq/52-typedef2_rc.c b/tests/regression/06-symbeq/52-typedef2_rc.c new file mode 100644 index 0000000000..d9b8ffd8af --- /dev/null +++ b/tests/regression/06-symbeq/52-typedef2_rc.c @@ -0,0 +1,26 @@ +// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// MANUAL must have race on (int), not safe on (int) and (int2) +#include + +typedef int int2; + +extern int *get_s(); + +void *t_fun(void *arg) { + int2 *s = get_s(); + *s = 5; // RACE! + return NULL; +} + +int main () { + int *d; + pthread_t id; + pthread_mutex_t *m; + + d = get_s(); + + pthread_create(&id,NULL,t_fun,NULL); + *d = 8; // RACE! + + return 0; +} From ab4db5c92893297956bfcf9d57e90cc41f990e4d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 15:10:41 +0300 Subject: [PATCH 468/518] Add failing type nested fields race test --- .../04-mutex/77-type-nested-fields.c | 31 +++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 tests/regression/04-mutex/77-type-nested-fields.c diff --git a/tests/regression/04-mutex/77-type-nested-fields.c b/tests/regression/04-mutex/77-type-nested-fields.c new file mode 100644 index 0000000000..9d66be2b22 --- /dev/null +++ b/tests/regression/04-mutex/77-type-nested-fields.c @@ -0,0 +1,31 @@ +//PARAM: --disable ana.mutex.disjoint_types +#include +#include + +struct S { + int field; +}; + +struct T { + struct S s; +}; + +// struct S s; +// struct T t; + +extern struct S* getS(); +extern struct T* getT(); + +// getS could return the same struct as is contained in getT + +void *t_fun(void *arg) { + getS()->field = 1; // RACE! + return NULL; +} + +int main(void) { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + getT()->s.field = 2; // RACE! + return 0; +} From 104615bac4d62ae02f2994ce9beebec2b6fbfe63 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 15:50:46 +0300 Subject: [PATCH 469/518] Add failing type array fields no race test --- src/domains/access.ml | 2 +- tests/regression/04-mutex/78-type-array.c | 23 +++++++++++++++++++++++ 2 files changed, 24 insertions(+), 1 deletion(-) create mode 100644 tests/regression/04-mutex/78-type-array.c diff --git a/src/domains/access.ml b/src/domains/access.ml index 45c2d27c42..bc87463842 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -217,7 +217,7 @@ let add_propagate side (memo: Memo.t) = let add_vars v = add_struct side (`Var v, f) in List.iter add_vars vars; (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) - add_struct side (`Type (TComp (c, [])), f); + add_struct side (`Type (TComp (c, [])), f); (* same as unconditional add_struct call from add when in struct case *) in let just_vars t v = add_struct side (`Var v, `NoOffset); diff --git a/tests/regression/04-mutex/78-type-array.c b/tests/regression/04-mutex/78-type-array.c new file mode 100644 index 0000000000..58c207109c --- /dev/null +++ b/tests/regression/04-mutex/78-type-array.c @@ -0,0 +1,23 @@ +//PARAM: --disable ana.mutex.disjoint_types +#include +#include + +struct S { + int field; + int arr[2]; +}; + +extern struct S* getS(); + +void *t_fun(void *arg) { + // should not distribute access to (struct S).field + getS()->arr[1] = 1; // NORACE + return NULL; +} + +int main(void) { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + getS()->field = 2; // NORACE + return 0; +} From 9fced76e586c63b99a6891f5aa8fe532d942c752 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 17:07:41 +0300 Subject: [PATCH 470/518] Add failing deeper type nested fields race tests --- .../04-mutex/77-type-nested-fields.c | 2 + .../04-mutex/79-type-nested-fields-deep1.c | 38 +++++++++++++++++++ .../04-mutex/80-type-nested-fields-deep2.c | 38 +++++++++++++++++++ 3 files changed, 78 insertions(+) create mode 100644 tests/regression/04-mutex/79-type-nested-fields-deep1.c create mode 100644 tests/regression/04-mutex/80-type-nested-fields-deep2.c diff --git a/tests/regression/04-mutex/77-type-nested-fields.c b/tests/regression/04-mutex/77-type-nested-fields.c index 9d66be2b22..cfb23c4f83 100644 --- a/tests/regression/04-mutex/77-type-nested-fields.c +++ b/tests/regression/04-mutex/77-type-nested-fields.c @@ -19,6 +19,8 @@ extern struct T* getT(); // getS could return the same struct as is contained in getT void *t_fun(void *arg) { + // should write to (struct T).s.field in addition to (struct S).field + // but easier to implement the other way around? getS()->field = 1; // RACE! return NULL; } diff --git a/tests/regression/04-mutex/79-type-nested-fields-deep1.c b/tests/regression/04-mutex/79-type-nested-fields-deep1.c new file mode 100644 index 0000000000..62f4d61bbf --- /dev/null +++ b/tests/regression/04-mutex/79-type-nested-fields-deep1.c @@ -0,0 +1,38 @@ +//PARAM: --disable ana.mutex.disjoint_types +#include +#include + +struct S { + int field; +}; + +struct T { + struct S s; +}; + +struct U { + struct T t; +}; + +// struct S s; +// struct T t; + +extern struct S* getS(); +extern struct T* getT(); +extern struct U* getU(); + +// getS could return the same struct as is contained in getT + +void *t_fun(void *arg) { + // should write to (struct U).t.s.field in addition to (struct S).field + // but easier to implement the other way around? + getS()->field = 1; // RACE! + return NULL; +} + +int main(void) { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + getU()->t.s.field = 2; // RACE! + return 0; +} diff --git a/tests/regression/04-mutex/80-type-nested-fields-deep2.c b/tests/regression/04-mutex/80-type-nested-fields-deep2.c new file mode 100644 index 0000000000..8101c0cec0 --- /dev/null +++ b/tests/regression/04-mutex/80-type-nested-fields-deep2.c @@ -0,0 +1,38 @@ +//PARAM: --disable ana.mutex.disjoint_types +#include +#include + +struct S { + int field; +}; + +struct T { + struct S s; +}; + +struct U { + struct T t; +}; + +// struct S s; +// struct T t; + +extern struct S* getS(); +extern struct T* getT(); +extern struct U* getU(); + +// getS could return the same struct as is contained in getT + +void *t_fun(void *arg) { + // should write to (struct U).t.s.field in addition to (struct T).s.field + // but easier to implement the other way around? + getT()->s.field = 1; // RACE! + return NULL; +} + +int main(void) { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + getU()->t.s.field = 2; // RACE! + return 0; +} From 4b53fc8afa50aca4c700516d48977dbddf132094 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 17:57:18 +0300 Subject: [PATCH 471/518] Reimplement Access.add_propagate to be more sound and more precise --- src/domains/access.ml | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index bc87463842..ab9ae3f746 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -241,6 +241,21 @@ let add_propagate side (memo: Memo.t) = end; if M.tracing then M.traceu "access" "add_propagate\n" +let rec add_propagate2 side (memo: Memo.t) = + let o = snd memo in + add_struct side memo; + + let base_type = Memo.type_of_base memo in + let base_type_vars = TSH.find_all typeVar (typeSig base_type) in + List.iter (fun v -> + add_struct side (`Var v, o) + ) base_type_vars; + + let base_type_fields = TSH.find_all typeIncl (typeSig base_type) in + List.iter (fun f -> + add_propagate2 side (`Type (TComp (f.fcomp, [])), `Field (f, o)) + ) base_type_fields + let add side e voffs = let memo = match voffs with | Some (v, o) -> @@ -255,7 +270,7 @@ let add side e voffs = add_struct side memo; (* TODO: maybe this should not depend on whether voffs = None? *) if voffs = None && not (!unsound && isArithmeticType (Memo.type_of memo)) then - add_propagate side memo; + add_propagate2 side memo; if M.tracing then M.traceu "access" "add\n" let rec distribute_access_lval f lv = From ba7e4d6201de9cc2cdfee855268685ea204fde23 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 18:22:45 +0300 Subject: [PATCH 472/518] Fix 06-symbeq/50-type_array_via_ptr_rc --- src/domains/access.ml | 20 ++++++++++++++++--- .../06-symbeq/50-type_array_via_ptr_rc.c | 6 +++++- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index ab9ae3f746..9e45809084 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -34,10 +34,21 @@ let unsound = ref false let init (f:file) = unsound := get_bool "ana.mutex.disjoint_types"; let visited_vars = Hashtbl.create 100 in + let add tsh t v = + let rec add' ts = + TSH.add tsh ts v; + (* Account for aliasing to any level of array. + See 06-symbeq/50-type_array_via_ptr_rc.c. *) + match ts with + | TSArray (ts', _, _) -> add' ts' + | _ -> () + in + add' (typeSig t) + in let visit_field fi = (* TODO: is_ignorable_type? *) (* TODO: Direct ignoring doesn't really work since it doesn't account for pthread inner structs/unions being only reachable via ignorable types. *) - TSH.add typeIncl (typeSig fi.ftype) fi + add typeIncl fi.ftype fi in let visit_glob = function | GCompTag (c,_) -> @@ -45,7 +56,7 @@ let init (f:file) = | GVarDecl (v,_) | GVar (v,_,_) -> if not (Hashtbl.mem visited_vars v.vid) then begin (* TODO: is_ignorable? *) - TSH.add typeVar (typeSig v.vtype) v; + add typeVar v.vtype v; (* ignore (printf "init adding %s : %a" v.vname d_typsig ((typeSig v.vtype))); *) Hashtbl.replace visited_vars v.vid true end @@ -242,6 +253,7 @@ let add_propagate side (memo: Memo.t) = if M.tracing then M.traceu "access" "add_propagate\n" let rec add_propagate2 side (memo: Memo.t) = + if M.tracing then M.tracei "access" "add_propagate2 %a\n" Memo.pretty memo; let o = snd memo in add_struct side memo; @@ -254,7 +266,9 @@ let rec add_propagate2 side (memo: Memo.t) = let base_type_fields = TSH.find_all typeIncl (typeSig base_type) in List.iter (fun f -> add_propagate2 side (`Type (TComp (f.fcomp, [])), `Field (f, o)) - ) base_type_fields + ) base_type_fields; + + if M.tracing then M.traceu "access" "add_propagate2\n" let add side e voffs = let memo = match voffs with diff --git a/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c b/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c index 2315f59a32..4f33fe0202 100644 --- a/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c +++ b/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c @@ -3,6 +3,7 @@ struct s { int datum[2]; + int datums[2][2][2]; pthread_mutex_t mutex; }; @@ -11,11 +12,12 @@ extern struct s *get_s(); void *t_fun(void *arg) { struct s *s = get_s(); s->datum[1] = 5; // RACE! + s->datums[1][1][1] = 5; // RACE! return NULL; } int main () { - int *d; + int *d, *e; struct s *s; pthread_t id; pthread_mutex_t *m; @@ -23,9 +25,11 @@ int main () { s = get_s(); m = &s->mutex; d = &s->datum[1]; + e = &s->datums[1][1][1]; pthread_create(&id,NULL,t_fun,NULL); *d = 8; // RACE! + *e = 8; // RACE! return 0; } From 1472eda340f293680a49f6d37cf892ac22368ded Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 18:25:26 +0300 Subject: [PATCH 473/518] Remove old Access.add_propagate --- src/domains/access.ml | 40 ++++------------------------------------ 1 file changed, 4 insertions(+), 36 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 9e45809084..d4e29da60e 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -220,40 +220,8 @@ let add_struct side memo: unit = end; if M.tracing then M.traceu "access" "add_struct\n" -let add_propagate side (memo: Memo.t) = +let rec add_propagate side (memo: Memo.t) = if M.tracing then M.tracei "access" "add_propagate %a\n" Memo.pretty memo; - let struct_inv (f:Offset.Unit.t) (c:compinfo) = - let vars = TSH.find_all typeVar (typeSig (TComp (c,[]))) in - (* 1 test(s) failed: ["04/49 type-invariants"] *) - let add_vars v = add_struct side (`Var v, f) in - List.iter add_vars vars; - (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) - add_struct side (`Type (TComp (c, [])), f); (* same as unconditional add_struct call from add when in struct case *) - in - let just_vars t v = - add_struct side (`Var v, `NoOffset); - in - begin match memo with - | (`Type (TComp (c, _)), (`Field (fi, _) as os)) when not (Offset.Unit.contains_index os) -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) - if M.tracing then M.trace "access" "struct case\n"; - assert (CilType.Compinfo.equal c fi.fcomp); - (* 1 test(s) failed: ["04/49 type-invariants"] *) - struct_inv os c - | (`Type _, _) -> - if M.tracing then M.trace "access" "general case\n"; - let t = Memo.type_of memo in - let incl = TSH.find_all typeIncl (typeSig t) in - (* 2 test(s) failed: ["06/16 type_rc", "06/21 mult_accs_rc"] *) - List.iter (fun fi -> struct_inv (`Field (fi,`NoOffset)) fi.fcomp) incl; - let vars = TSH.find_all typeVar (typeSig t) in - (* TODO: not tested *) - List.iter (just_vars t) vars - | (`Var _, _) -> assert false - end; - if M.tracing then M.traceu "access" "add_propagate\n" - -let rec add_propagate2 side (memo: Memo.t) = - if M.tracing then M.tracei "access" "add_propagate2 %a\n" Memo.pretty memo; let o = snd memo in add_struct side memo; @@ -265,10 +233,10 @@ let rec add_propagate2 side (memo: Memo.t) = let base_type_fields = TSH.find_all typeIncl (typeSig base_type) in List.iter (fun f -> - add_propagate2 side (`Type (TComp (f.fcomp, [])), `Field (f, o)) + add_propagate side (`Type (TComp (f.fcomp, [])), `Field (f, o)) ) base_type_fields; - if M.tracing then M.traceu "access" "add_propagate2\n" + if M.tracing then M.traceu "access" "add_propagate\n" let add side e voffs = let memo = match voffs with @@ -284,7 +252,7 @@ let add side e voffs = add_struct side memo; (* TODO: maybe this should not depend on whether voffs = None? *) if voffs = None && not (!unsound && isArithmeticType (Memo.type_of memo)) then - add_propagate2 side memo; + add_propagate side memo; if M.tracing then M.traceu "access" "add\n" let rec distribute_access_lval f lv = From d431178b5e71ff5f01e0136ffdc3e19c09c8bd21 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 18:39:29 +0300 Subject: [PATCH 474/518] Clean up new Access.add_propagate --- src/domains/access.ml | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index d4e29da60e..a6ffe78003 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -220,21 +220,21 @@ let add_struct side memo: unit = end; if M.tracing then M.traceu "access" "add_struct\n" -let rec add_propagate side (memo: Memo.t) = +let rec add_propagate side (t: typ) (o: Offset.Unit.t) = + let memo = (`Type t, o) in if M.tracing then M.tracei "access" "add_propagate %a\n" Memo.pretty memo; - let o = snd memo in add_struct side memo; - let base_type = Memo.type_of_base memo in - let base_type_vars = TSH.find_all typeVar (typeSig base_type) in + let ts = typeSig t in + let vars = TSH.find_all typeVar ts in List.iter (fun v -> add_struct side (`Var v, o) - ) base_type_vars; + ) vars; - let base_type_fields = TSH.find_all typeIncl (typeSig base_type) in + let fields = TSH.find_all typeIncl ts in List.iter (fun f -> - add_propagate side (`Type (TComp (f.fcomp, [])), `Field (f, o)) - ) base_type_fields; + add_propagate side (TComp (f.fcomp, [])) (`Field (f, o)) + ) fields; if M.tracing then M.traceu "access" "add_propagate\n" @@ -251,8 +251,11 @@ let add side e voffs = if M.tracing then M.trace "access" "memo = %a\n" Memo.pretty memo; add_struct side memo; (* TODO: maybe this should not depend on whether voffs = None? *) - if voffs = None && not (!unsound && isArithmeticType (Memo.type_of memo)) then - add_propagate side memo; + begin match memo with + | (`Type t, o) when not (!unsound && isArithmeticType t) -> + add_propagate side t o + | _ -> () + end; if M.tracing then M.traceu "access" "add\n" let rec distribute_access_lval f lv = From 3b7466a849fa88e76d83229af7905634b1ea7890 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 9 Jun 2023 18:51:00 +0300 Subject: [PATCH 475/518] Refactor Access.add cases --- src/domains/access.ml | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index a6ffe78003..bd3dce8d2c 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -239,22 +239,22 @@ let rec add_propagate side (t: typ) (o: Offset.Unit.t) = if M.tracing then M.traceu "access" "add_propagate\n" let add side e voffs = - let memo = match voffs with + begin match voffs with | Some (v, o) -> - if M.tracing then M.traceli "access" "add %a%a\n" CilType.Varinfo.pretty v CilType.Offset.pretty o; - (`Var v, Offset.Unit.of_cil o) + if M.tracing then M.traceli "access" "add var %a%a\n" CilType.Varinfo.pretty v CilType.Offset.pretty o; + let memo = (`Var v, Offset.Unit.of_cil o) in + add_struct side memo | None -> - if M.tracing then M.traceli "access" "add %a\n" CilType.Exp.pretty e; + if M.tracing then M.traceli "access" "add type %a\n" CilType.Exp.pretty e; let ty = get_val_type e in - Memo.of_ty ty - in - if M.tracing then M.trace "access" "memo = %a\n" Memo.pretty memo; - add_struct side memo; - (* TODO: maybe this should not depend on whether voffs = None? *) - begin match memo with - | (`Type t, o) when not (!unsound && isArithmeticType t) -> - add_propagate side t o - | _ -> () + let (t, o) = match ty with + | `Struct (c, o) -> (TComp (c, []), o) + | `Type t -> (t, `NoOffset) + in + add_struct side (`Type t, o); (* TODO: this is also part of add_propagate, duplicated when called *) + (* TODO: maybe this should not depend on whether voffs = None? *) + if not (!unsound && isArithmeticType t) then + add_propagate side t o end; if M.tracing then M.traceu "access" "add\n" From b81f4117f35a33e90dd8bcb379dc3da5f3c4f8f1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 12 Jun 2023 10:29:23 +0300 Subject: [PATCH 476/518] Remove warn argument from LocksetAnalysis.MayArg --- src/analyses/deadlock.ml | 2 +- src/analyses/locksetAnalysis.ml | 2 +- src/analyses/mayLocks.ml | 4 ++-- src/analyses/mutexAnalysis.ml | 6 ++++-- 4 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/analyses/deadlock.ml b/src/analyses/deadlock.ml index 38468f9edd..c23d6f4294 100644 --- a/src/analyses/deadlock.ml +++ b/src/analyses/deadlock.ml @@ -37,7 +37,7 @@ struct ) ctx.local; D.add after ctx.local - let remove ctx ?(warn=true) l = + let remove ctx l = let inLockAddrs (e, _, _) = Lock.equal l e in D.filter (neg inLockAddrs) ctx.local end diff --git a/src/analyses/locksetAnalysis.ml b/src/analyses/locksetAnalysis.ml index 9f636471ae..2e9e08f03d 100644 --- a/src/analyses/locksetAnalysis.ml +++ b/src/analyses/locksetAnalysis.ml @@ -30,7 +30,7 @@ sig module V: SpecSysVar val add: (D.t, G.t, D.t, V.t) ctx -> LockDomain.Lockset.Lock.t -> D.t - val remove: (D.t, G.t, D.t, V.t) ctx -> ?warn:bool -> ValueDomain.Addr.t -> D.t + val remove: (D.t, G.t, D.t, V.t) ctx -> ValueDomain.Addr.t -> D.t end module MakeMay (Arg: MayArg) = diff --git a/src/analyses/mayLocks.ml b/src/analyses/mayLocks.ml index 4f9eb94f3e..853005de87 100644 --- a/src/analyses/mayLocks.ml +++ b/src/analyses/mayLocks.ml @@ -29,8 +29,8 @@ struct else D.add l ctx.local - let remove ctx ?(warn=true) l = - if warn && not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; + let remove ctx l = + if not (D.mem l ctx.local) then M.warn "Releasing a mutex that is definitely not held"; match D.Addr.to_mval l with | Some (v,o) -> (let mtype = ctx.ask (Queries.MutexType (v, Offset.Unit.of_offs o)) in diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index a209c12cd9..3bfb8711a9 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -150,7 +150,7 @@ struct (s', Multiplicity.increment (fst l) m) | _ -> (s', m) - let remove ctx ?(warn=true) l = + let remove' ctx ~warn l = let s, m = ctx.local in let rm s = Lockset.remove (l, true) (Lockset.remove (l, false) s) in if warn && (not (Lockset.mem (l,true) s || Lockset.mem (l,false) s)) then M.warn "unlocking mutex which may not be held"; @@ -163,6 +163,8 @@ struct (s, m') | _ -> (rm s, m) + let remove = remove' ~warn:true + let remove_all ctx = (* Mutexes.iter (fun m -> ctx.emit (MustUnlock m) @@ -212,7 +214,7 @@ struct non_overlapping held_locks protecting | Queries.MayBePublicWithout _ when Lockset.is_bot ls -> false | Queries.MayBePublicWithout {global=v; write; without_mutex; protection} -> - let held_locks = Lockset.export_locks @@ fst @@ Arg.remove ctx ~warn:false without_mutex in + let held_locks = Lockset.export_locks @@ fst @@ Arg.remove' ctx ~warn:false without_mutex in let protecting = protecting ~write protection v in (* TODO: unsound in 29/24, why did we do this before? *) (* if Mutexes.mem verifier_atomic (Lockset.export_locks (Lockset.remove (without_mutex, true) ctx.local)) then From 233e8bfa692556f4b5cf83601dfa17c9acbdd361 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 12 Jun 2023 10:24:25 +0300 Subject: [PATCH 477/518] Add more ignorable Access types --- src/domains/access.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index bd3dce8d2c..84a728623b 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -13,6 +13,8 @@ module M = Messages let is_ignorable_type (t: typ): bool = match t with | TNamed ({ tname = "atomic_t" | "pthread_mutex_t" | "pthread_rwlock_t" | "pthread_spinlock_t" | "spinlock_t" | "pthread_cond_t"; _ }, _) -> true + | TComp ({ cname = "__pthread_mutex_s" | "__pthread_rwlock_arch_t" | "__jmp_buf_tag" | "_pthread_cleanup_buffer" | "__pthread_cleanup_frame" | "__cancel_jmp_buf_tag"; _}, _) -> true + | TComp ({ cname; _}, _) when String.starts_with_stdlib ~prefix:"__anonunion_pthread_mutexattr_t" cname || String.starts_with_stdlib ~prefix:"__anonunion_pthread_condattr_t" cname || String.starts_with_stdlib ~prefix:"__anonstruct___once_flag" cname || String.starts_with_stdlib ~prefix:"__anonunion_pthread_barrierattr_t" cname || String.starts_with_stdlib ~prefix:"__anonstruct___pthread_unwind_buf_t" cname || String.starts_with_stdlib ~prefix:"__anonstruct___cancel_jmp_buf" cname -> true | TComp ({ cname = "lock_class_key"; _ }, _) -> true | TInt (IInt, attr) when hasAttribute "mutex" attr -> true | t when hasAttribute "atomic" (typeAttrs t) -> true (* C11 _Atomic *) @@ -43,7 +45,8 @@ let init (f:file) = | TSArray (ts', _, _) -> add' ts' | _ -> () in - add' (typeSig t) + if not (is_ignorable_type t) then + add' (typeSig t) in let visit_field fi = (* TODO: is_ignorable_type? *) @@ -52,7 +55,8 @@ let init (f:file) = in let visit_glob = function | GCompTag (c,_) -> - List.iter visit_field c.cfields + if not (is_ignorable_type (TComp (c, []))) then + List.iter visit_field c.cfields | GVarDecl (v,_) | GVar (v,_,_) -> if not (Hashtbl.mem visited_vars v.vid) then begin (* TODO: is_ignorable? *) From 61ceddbd81683ff2c7162e3b1004a0ef76b165d1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 12 Jun 2023 11:49:31 +0300 Subject: [PATCH 478/518] Disable nonstatic on Goblint stubs --- src/util/cilfacade.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml index 09231b4f45..fa5cf09c19 100644 --- a/src/util/cilfacade.ml +++ b/src/util/cilfacade.ml @@ -167,7 +167,7 @@ let getFuns fileAST : startfuns = Printf.printf "Start function: %s\n" mn; set_string "mainfun[+]" mn; add_main def acc | GFun({svar={vname=mn; vattr=attr; _}; _} as def, _) when get_bool "kernel" && is_exit attr -> Printf.printf "Cleanup function: %s\n" mn; set_string "exitfun[+]" mn; add_exit def acc - | GFun ({svar={vstorage=NoStorage; _}; _} as def, _) when (get_bool "nonstatic") -> add_other def acc + | GFun ({svar={vstorage=NoStorage; vattr; _}; _} as def, _) when get_bool "nonstatic" && not (Cil.hasAttribute "goblint_stub" vattr) -> add_other def acc | GFun ({svar={vattr; _}; _} as def, _) when get_bool "allfuns" && not (Cil.hasAttribute "goblint_stub" vattr) -> add_other def acc | _ -> acc in From b18c2afb029f0e195ec9ec44267fa3c73d495b7a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 12 Jun 2023 11:49:42 +0300 Subject: [PATCH 479/518] Add TODO about unsound type in Access --- src/domains/access.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 84a728623b..941ab0740e 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -257,7 +257,7 @@ let add side e voffs = in add_struct side (`Type t, o); (* TODO: this is also part of add_propagate, duplicated when called *) (* TODO: maybe this should not depend on whether voffs = None? *) - if not (!unsound && isArithmeticType t) then + if not (!unsound && isArithmeticType t) then (* TODO: used to check (t, o) not just t *) add_propagate side t o end; if M.tracing then M.traceu "access" "add\n" From e079c00e5f81047faef9becc829be1a7fc973d25 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 12 Jun 2023 12:23:46 +0300 Subject: [PATCH 480/518] Document Access distribution logic --- src/analyses/raceAnalysis.ml | 2 +- src/domains/access.ml | 50 ++++++++++++++++++++++-------------- 2 files changed, 32 insertions(+), 20 deletions(-) diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index e9be09764c..d83ecd5432 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -100,7 +100,7 @@ struct in let add_access_struct conf ci = let a = part_access None in - Access.add_struct (side_access octx (conf, kind, loc, e, a)) (`Type (TComp (ci, [])), `NoOffset) + Access.add_distribute_inner (side_access octx (conf, kind, loc, e, a)) (`Type (TComp (ci, [])), `NoOffset) in let has_escaped g = octx.ask (Queries.MayEscape g) in (* The following function adds accesses to the lval-set ls diff --git a/src/domains/access.ml b/src/domains/access.ml index 941ab0740e..de69ba30c3 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -72,11 +72,12 @@ let reset () = TSH.clear typeVar; TSH.clear typeIncl - type acc_typ = [ `Type of CilType.Typ.t | `Struct of CilType.Compinfo.t * Offset.Unit.t ] [@@deriving eq, ord, hash] +(** Old access type inferred from an expression. *) exception Type_offset_error +(** Memory location of an access. *) module Memo = struct include Printable.StdLeaf @@ -176,6 +177,7 @@ let get_val_type e: acc_typ = get_type fb e +(** Add access to {!Memo} after distributing. *) let add_one side memo: unit = let mv = Memo.to_mval memo in let ignorable = is_ignorable mv in @@ -183,9 +185,10 @@ let add_one side memo: unit = if not ignorable then side memo -let add_struct side memo: unit = - if M.tracing then M.tracei "access" "add_struct %a\n" Memo.pretty memo; - let rec dist_fields ty : Offset.Unit.t list = +(** Distribute access to contained fields. *) +let add_distribute_inner side memo: unit = + if M.tracing then M.tracei "access" "add_distribute_inner %a\n" Memo.pretty memo; + let rec dist_fields ty : Offset.Unit.t list = (* Find all nested offsets in type. *) (* TODO: is_ignorable_type outside of TComp if ty itself is ignorable? *) match unrollType ty with | TComp (ci,_) -> @@ -208,7 +211,7 @@ let add_struct side memo: unit = let oss = dist_fields t in (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) List.iter (fun os -> - add_one side (Memo.add_offset memo os) + add_one side (Memo.add_offset memo os) (* distribute to all nested offsets *) ) oss | exception Type_offset_error -> if M.tracing then M.trace "access" "Type_offset_error\n"; @@ -222,46 +225,55 @@ let add_struct side memo: unit = if M.tracing then M.trace "access" "general case\n"; add_one side memo end; - if M.tracing then M.traceu "access" "add_struct\n" + if M.tracing then M.traceu "access" "add_distribute_inner\n" -let rec add_propagate side (t: typ) (o: Offset.Unit.t) = +(** Distribute type-based access to variables and containing fields. *) +let rec add_distribute_outer side (t: typ) (o: Offset.Unit.t) = let memo = (`Type t, o) in - if M.tracing then M.tracei "access" "add_propagate %a\n" Memo.pretty memo; - add_struct side memo; + if M.tracing then M.tracei "access" "add_distribute_outer %a\n" Memo.pretty memo; + add_distribute_inner side memo; (* distribute to inner offsets of type *) + (* distribute to inner offsets of variables of the type *) let ts = typeSig t in let vars = TSH.find_all typeVar ts in List.iter (fun v -> - add_struct side (`Var v, o) + add_distribute_inner side (`Var v, o) (* same offset, but on variable *) ) vars; + (* recursively distribute to fields containing the type *) let fields = TSH.find_all typeIncl ts in List.iter (fun f -> - add_propagate side (TComp (f.fcomp, [])) (`Field (f, o)) + (* prepend field and distribute to outer struct *) + add_distribute_outer side (TComp (f.fcomp, [])) (`Field (f, o)) ) fields; - if M.tracing then M.traceu "access" "add_propagate\n" + if M.tracing then M.traceu "access" "add_distribute_outer\n" +(** Add access to known variable with offsets or unknown variable from expression. *) let add side e voffs = begin match voffs with - | Some (v, o) -> + | Some (v, o) -> (* known variable *) if M.tracing then M.traceli "access" "add var %a%a\n" CilType.Varinfo.pretty v CilType.Offset.pretty o; let memo = (`Var v, Offset.Unit.of_cil o) in - add_struct side memo - | None -> + add_distribute_inner side memo (* distribute to inner offsets *) + | None -> (* unknown variable *) if M.tracing then M.traceli "access" "add type %a\n" CilType.Exp.pretty e; - let ty = get_val_type e in - let (t, o) = match ty with + let ty = get_val_type e in (* extract old acc_typ from expression *) + let (t, o) = match ty with (* convert acc_typ to type-based Memo (components) *) | `Struct (c, o) -> (TComp (c, []), o) | `Type t -> (t, `NoOffset) in - add_struct side (`Type t, o); (* TODO: this is also part of add_propagate, duplicated when called *) + (* distribute to inner offsets directly *) + add_distribute_inner side (`Type t, o); (* TODO: this is also part of add_propagate, duplicated when called *) (* TODO: maybe this should not depend on whether voffs = None? *) if not (!unsound && isArithmeticType t) then (* TODO: used to check (t, o) not just t *) - add_propagate side t o + add_distribute_outer side t o (* distribute to variables and outer offsets *) end; if M.tracing then M.traceu "access" "add\n" + +(** Distribute to {!AddrOf} of all read lvals in subexpressions. *) + let rec distribute_access_lval f lv = (* Use unoptimized AddrOf so RegionDomain.Reg.eval_exp knows about dereference *) (* f (mkAddrOf lv); *) From 31452b827330dda0526abd7db5352add6d1cf0de Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 12 Jun 2023 13:45:21 +0200 Subject: [PATCH 481/518] update submodule gobview --- gobview | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gobview b/gobview index 2cc57dbd61..c3dcfaba97 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 2cc57dbd6115c71c18ec3ecca60c68fa4e983dbd +Subproject commit c3dcfaba97a1df72f027e5dad317e2c201ce5e4b From 26e0777f9b321fd1fe69f45725d8c6b1552fe3ab Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 12 Jun 2023 15:11:52 +0200 Subject: [PATCH 482/518] Update tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c Co-authored-by: Simmo Saan --- tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c b/tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c index 463a080ba0..2457ed3f62 100644 --- a/tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c +++ b/tests/regression/71-doublelocking/16-rec-dyn-no-path-sense.c @@ -41,7 +41,7 @@ int main(int argc, char const *argv[]) pthread_mutex_lock(&mut); - g = 9; + g = 9; // RACE! pthread_mutex_unlock(&mut); pthread_join(t1, NULL); From d38f98fae6161b5fde42fc5b73505b38ae029baf Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Mon, 12 Jun 2023 20:18:41 +0200 Subject: [PATCH 483/518] ignore indentation on blank lines suggested by ocp-indent --- scripts/hooks/pre-commit | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/hooks/pre-commit b/scripts/hooks/pre-commit index 2d5efefa98..cb7cdb191f 100755 --- a/scripts/hooks/pre-commit +++ b/scripts/hooks/pre-commit @@ -71,7 +71,7 @@ for f in $(git diff --cached --name-only | grep -E ".*\.mli?$"); do lines="$a-$b" fi echo "ocp-indent file: $f, lines: $lines" - [[ $lines -eq "0" ]] || diff $f <(ocp-indent --lines=$lines $f) || fail="true" + [[ $lines -eq "0" ]] || diff $f <(ocp-indent --lines=$lines $f | sed 's/^[[:space:]]\+$//') || fail="true" done done if [ "$fail" == "true" ]; then From f3ffd5e45c034574020f56519ccdb021da2a1479 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Tue, 13 Jun 2023 10:16:06 +0200 Subject: [PATCH 484/518] fix indentation in baseInvariant --- src/analyses/baseInvariant.ml | 365 +++++++++++++++++----------------- 1 file changed, 183 insertions(+), 182 deletions(-) diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index 74d31f40d6..67563c0f1e 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -550,191 +550,192 @@ struct let eval_bool e st = match eval e st with Int i -> ID.to_bool i | _ -> None in let rec inv_exp c_typed exp (st:D.t): D.t = (* trying to improve variables in an expression so it is bottom means dead code *) - if VD.is_bot_value c_typed then contra st else - match exp, c_typed with - | UnOp (LNot, e, _), Int c -> - let ikind = Cilfacade.get_ikind_exp e in - let c' = - match ID.to_bool (unop_ID LNot c) with - | Some true -> - (* i.e. e should evaluate to [1,1] *) - (* LNot x is 0 for any x != 0 *) - ID.of_excl_list ikind [BI.zero] - | Some false -> ID.of_bool ikind false - | _ -> ID.top_of ikind - in - inv_exp (Int c') e st - | UnOp (Neg, e, _), Float c -> inv_exp (Float (unop_FD Neg c)) e st - | UnOp ((BNot|Neg) as op, e, _), Int c -> inv_exp (Int (unop_ID op c)) e st + if VD.is_bot_value c_typed then contra st + else + match exp, c_typed with + | UnOp (LNot, e, _), Int c -> + let ikind = Cilfacade.get_ikind_exp e in + let c' = + match ID.to_bool (unop_ID LNot c) with + | Some true -> + (* i.e. e should evaluate to [1,1] *) + (* LNot x is 0 for any x != 0 *) + ID.of_excl_list ikind [BI.zero] + | Some false -> ID.of_bool ikind false + | _ -> ID.top_of ikind + in + inv_exp (Int c') e st + | UnOp (Neg, e, _), Float c -> inv_exp (Float (unop_FD Neg c)) e st + | UnOp ((BNot|Neg) as op, e, _), Int c -> inv_exp (Int (unop_ID op c)) e st (* no equivalent for Float, as VD.is_safe_cast fails for all float types anyways *) - | BinOp((Eq | Ne) as op, CastE (t1, e1), CastE (t2, e2), t), Int c when typeSig (Cilfacade.typeOf e1) = typeSig (Cilfacade.typeOf e2) && VD.is_safe_cast t1 (Cilfacade.typeOf e1) && VD.is_safe_cast t2 (Cilfacade.typeOf e2) -> - inv_exp (Int c) (BinOp (op, e1, e2, t)) st - | BinOp (LOr, arg1, arg2, typ) as exp, Int c -> - (* copied & modified from eval_rv_base... *) - let (let*) = Option.bind in - (* split nested LOr Eqs to equality pairs, if possible *) - let rec split = function - (* copied from above to support pointer equalities with implicit casts inserted *) - | BinOp (Eq, CastE (t1, e1), CastE (t2, e2), typ) when typeSig (Cilfacade.typeOf e1) = typeSig (Cilfacade.typeOf e2) && VD.is_safe_cast t1 (Cilfacade.typeOf e1) && VD.is_safe_cast t2 (Cilfacade.typeOf e2) -> (* slightly different from eval_rv_base... *) - Some [(e1, e2)] - | BinOp (Eq, arg1, arg2, _) -> - Some [(arg1, arg2)] - | BinOp (LOr, arg1, arg2, _) -> - let* s1 = split arg1 in - let* s2 = split arg2 in - Some (s1 @ s2) - | _ -> - None - in - (* find common exp from all equality pairs and list of other sides, if possible *) - let find_common = function - | [] -> assert false - | (e1, e2) :: eqs -> - let eqs_for_all_mem e = List.for_all (fun (e1, e2) -> CilType.Exp.(equal e1 e || equal e2 e)) eqs in - let eqs_map_remove e = List.map (fun (e1, e2) -> if CilType.Exp.equal e1 e then e2 else e1) eqs in - if eqs_for_all_mem e1 then - Some (e1, e2 :: eqs_map_remove e1) - else if eqs_for_all_mem e2 then - Some (e2, e1 :: eqs_map_remove e2) - else + | BinOp((Eq | Ne) as op, CastE (t1, e1), CastE (t2, e2), t), Int c when typeSig (Cilfacade.typeOf e1) = typeSig (Cilfacade.typeOf e2) && VD.is_safe_cast t1 (Cilfacade.typeOf e1) && VD.is_safe_cast t2 (Cilfacade.typeOf e2) -> + inv_exp (Int c) (BinOp (op, e1, e2, t)) st + | BinOp (LOr, arg1, arg2, typ) as exp, Int c -> + (* copied & modified from eval_rv_base... *) + let (let*) = Option.bind in + (* split nested LOr Eqs to equality pairs, if possible *) + let rec split = function + (* copied from above to support pointer equalities with implicit casts inserted *) + | BinOp (Eq, CastE (t1, e1), CastE (t2, e2), typ) when typeSig (Cilfacade.typeOf e1) = typeSig (Cilfacade.typeOf e2) && VD.is_safe_cast t1 (Cilfacade.typeOf e1) && VD.is_safe_cast t2 (Cilfacade.typeOf e2) -> (* slightly different from eval_rv_base... *) + Some [(e1, e2)] + | BinOp (Eq, arg1, arg2, _) -> + Some [(arg1, arg2)] + | BinOp (LOr, arg1, arg2, _) -> + let* s1 = split arg1 in + let* s2 = split arg2 in + Some (s1 @ s2) + | _ -> None - in - let eqs_st = - let* eqs = split exp in - let* (e, es) = find_common eqs in - let v = eval e st in (* value of common exp *) - let vs = List.map (fun e -> eval e st) es in (* values of other sides *) - match v with - | Address _ -> - (* get definite addrs from vs *) - let rec to_definite_ad = function - | [] -> AD.empty () - | VD.Address a :: vs when AD.is_definite a -> - AD.union a (to_definite_ad vs) - | _ :: vs -> - AD.top () - in - let definite_ad = to_definite_ad vs in - let c' = VD.Address definite_ad in - Some (inv_exp c' e st) - | Int i -> - let ik = ID.ikind i in - let module BISet = IntDomain.BISet in - (* get definite ints from vs *) - let rec to_int_id = function - | [] -> ID.bot_of ik - | VD.Int i :: vs -> - begin match ID.to_int i with - | Some i' -> ID.join i (to_int_id vs) - | None -> ID.top_of ik - end - | _ :: vs -> - ID.top_of ik - in - let int_id = to_int_id vs in - let c' = VD.Int int_id in - Some (inv_exp c' e st) - | _ -> - None - in - begin match eqs_st with - | Some st -> st - | None when ID.to_bool c = Some true -> - begin match inv_exp (Int c) arg1 st with - | st1 -> - begin match inv_exp (Int c) arg2 st with - | st2 -> D.join st1 st2 - | exception Analyses.Deadcode -> st1 - end - | exception Analyses.Deadcode -> inv_exp (Int c) arg2 st (* Deadcode falls through *) - end - | None -> - st (* TODO: not bothering to fall back, no other case can refine LOr anyway *) - end - | (BinOp (op, e1, e2, _) as e, Float _) - | (BinOp (op, e1, e2, _) as e, Int _) -> - let invert_binary_op c pretty c_int c_float = - if M.tracing then M.tracel "inv" "binop %a with %a %a %a == %a\n" d_exp e VD.pretty (eval e1 st) d_binop op VD.pretty (eval e2 st) pretty c; - (match eval e1 st, eval e2 st with - | Int a, Int b -> - let ikind = Cilfacade.get_ikind_exp e1 in (* both operands have the same type (except for Shiftlt, Shiftrt)! *) - let ikres = Cilfacade.get_ikind_exp e in (* might be different from argument types, e.g. for LT, GT, EQ, ... *) - let a', b' = inv_bin_int (a, b) ikind (c_int ikres) op in - if M.tracing then M.tracel "inv" "binop: %a, c: %a, a': %a, b': %a\n" d_exp e ID.pretty (c_int ikind) ID.pretty a' ID.pretty b'; - let st' = inv_exp (Int a') e1 st in - let st'' = inv_exp (Int b') e2 st' in - st'' - | Float a, Float b -> - let fkind = Cilfacade.get_fkind_exp e1 in (* both operands have the same type *) - let a', b' = inv_bin_float (a, b) (c_float fkind) op in - if M.tracing then M.tracel "inv" "binop: %a, c: %a, a': %a, b': %a\n" d_exp e FD.pretty (c_float fkind) FD.pretty a' FD.pretty b'; - let st' = inv_exp (Float a') e1 st in - let st'' = inv_exp (Float b') e2 st' in - st'' - (* Mixed Float and Int cases should never happen, as there are no binary operators with one float and one int parameter ?!*) - | Int _, Float _ | Float _, Int _ -> failwith "ill-typed program"; + in + (* find common exp from all equality pairs and list of other sides, if possible *) + let find_common = function + | [] -> assert false + | (e1, e2) :: eqs -> + let eqs_for_all_mem e = List.for_all (fun (e1, e2) -> CilType.Exp.(equal e1 e || equal e2 e)) eqs in + let eqs_map_remove e = List.map (fun (e1, e2) -> if CilType.Exp.equal e1 e then e2 else e1) eqs in + if eqs_for_all_mem e1 then + Some (e1, e2 :: eqs_map_remove e1) + else if eqs_for_all_mem e2 then + Some (e2, e1 :: eqs_map_remove e2) + else + None + in + let eqs_st = + let* eqs = split exp in + let* (e, es) = find_common eqs in + let v = eval e st in (* value of common exp *) + let vs = List.map (fun e -> eval e st) es in (* values of other sides *) + match v with + | Address _ -> + (* get definite addrs from vs *) + let rec to_definite_ad = function + | [] -> AD.empty () + | VD.Address a :: vs when AD.is_definite a -> + AD.union a (to_definite_ad vs) + | _ :: vs -> + AD.top () + in + let definite_ad = to_definite_ad vs in + let c' = VD.Address definite_ad in + Some (inv_exp c' e st) + | Int i -> + let ik = ID.ikind i in + let module BISet = IntDomain.BISet in + (* get definite ints from vs *) + let rec to_int_id = function + | [] -> ID.bot_of ik + | VD.Int i :: vs -> + begin match ID.to_int i with + | Some i' -> ID.join i (to_int_id vs) + | None -> ID.top_of ik + end + | _ :: vs -> + ID.top_of ik + in + let int_id = to_int_id vs in + let c' = VD.Int int_id in + Some (inv_exp c' e st) + | _ -> + None + in + begin match eqs_st with + | Some st -> st + | None when ID.to_bool c = Some true -> + begin match inv_exp (Int c) arg1 st with + | st1 -> + begin match inv_exp (Int c) arg2 st with + | st2 -> D.join st1 st2 + | exception Analyses.Deadcode -> st1 + end + | exception Analyses.Deadcode -> inv_exp (Int c) arg2 st (* Deadcode falls through *) + end + | None -> + st (* TODO: not bothering to fall back, no other case can refine LOr anyway *) + end + | (BinOp (op, e1, e2, _) as e, Float _) + | (BinOp (op, e1, e2, _) as e, Int _) -> + let invert_binary_op c pretty c_int c_float = + if M.tracing then M.tracel "inv" "binop %a with %a %a %a == %a\n" d_exp e VD.pretty (eval e1 st) d_binop op VD.pretty (eval e2 st) pretty c; + (match eval e1 st, eval e2 st with + | Int a, Int b -> + let ikind = Cilfacade.get_ikind_exp e1 in (* both operands have the same type (except for Shiftlt, Shiftrt)! *) + let ikres = Cilfacade.get_ikind_exp e in (* might be different from argument types, e.g. for LT, GT, EQ, ... *) + let a', b' = inv_bin_int (a, b) ikind (c_int ikres) op in + if M.tracing then M.tracel "inv" "binop: %a, c: %a, a': %a, b': %a\n" d_exp e ID.pretty (c_int ikind) ID.pretty a' ID.pretty b'; + let st' = inv_exp (Int a') e1 st in + let st'' = inv_exp (Int b') e2 st' in + st'' + | Float a, Float b -> + let fkind = Cilfacade.get_fkind_exp e1 in (* both operands have the same type *) + let a', b' = inv_bin_float (a, b) (c_float fkind) op in + if M.tracing then M.tracel "inv" "binop: %a, c: %a, a': %a, b': %a\n" d_exp e FD.pretty (c_float fkind) FD.pretty a' FD.pretty b'; + let st' = inv_exp (Float a') e1 st in + let st'' = inv_exp (Float b') e2 st' in + st'' + (* Mixed Float and Int cases should never happen, as there are no binary operators with one float and one int parameter ?!*) + | Int _, Float _ | Float _, Int _ -> failwith "ill-typed program"; (* | Address a, Address b -> ... *) - | a1, a2 -> fallback (GobPretty.sprintf "binop: got abstract values that are not Int: %a and %a" VD.pretty a1 VD.pretty a2) st) - (* use closures to avoid unused casts *) - in (match c_typed with - | Int c -> invert_binary_op c ID.pretty (fun ik -> ID.cast_to ik c) (fun fk -> FD.of_int fk c) - | Float c -> invert_binary_op c FD.pretty (fun ik -> FD.to_int ik c) (fun fk -> FD.cast_to fk c) - | _ -> failwith "unreachable") - | Lval x, (Int _ | Float _ | Address _) -> (* meet x with c *) - let update_lval c x c' pretty = refine_lv ctx a gs st c x c' pretty exp in - let t = Cil.unrollType (Cilfacade.typeOfLval x) in (* unroll type to deal with TNamed *) - begin match c_typed with - | Int c -> - let c' = match t with - | TPtr _ -> VD.Address (AD.of_int c) - | TInt (ik, _) - | TEnum ({ekind = ik; _}, _) -> Int (ID.cast_to ik c) - | TFloat (fk, _) -> Float (FD.of_int fk c) - | _ -> Int c - in - update_lval c x c' ID.pretty - | Float c -> - let c' = match t with - (* | TPtr _ -> ..., pointer conversion from/to float is not supported *) - | TInt (ik, _) -> VD.Int (FD.to_int ik c) - (* this is theoretically possible and should be handled correctly, however i can't imagine an actual piece of c code producing this?! *) - | TEnum ({ekind = ik; _}, _) -> Int (FD.to_int ik c) - | TFloat (fk, _) -> Float (FD.cast_to fk c) - | _ -> Float c - in - update_lval c x c' FD.pretty - | Address c -> - let c' = c_typed in (* TODO: need any of the type-matching nonsense? *) - update_lval c x c' AD.pretty - | _ -> assert false - end - | Const _ , _ -> st (* nothing to do *) - | CastE ((TFloat (_, _)), e), Float c -> - (match unrollType (Cilfacade.typeOf e), FD.get_fkind c with - | TFloat (FLongDouble as fk, _), FFloat - | TFloat (FDouble as fk, _), FFloat - | TFloat (FLongDouble as fk, _), FDouble - | TFloat (fk, _), FLongDouble - | TFloat (FDouble as fk, _), FDouble - | TFloat (FFloat as fk, _), FFloat -> inv_exp (Float (FD.cast_to fk c)) e st - | _ -> fallback ("CastE: incompatible types") st) - | CastE ((TInt (ik, _)) as t, e), Int c - | CastE ((TEnum ({ekind = ik; _ }, _)) as t, e), Int c -> (* Can only meet the t part of an Lval in e with c (unless we meet with all overflow possibilities)! Since there is no good way to do this, we only continue if e has no values outside of t. *) - (match eval e st with - | Int i -> - if ID.leq i (ID.cast_to ik i) then - match unrollType (Cilfacade.typeOf e) with - | TInt(ik_e, _) - | TEnum ({ekind = ik_e; _ }, _) -> - (* let c' = ID.cast_to ik_e c in *) - let c' = ID.cast_to ik_e (ID.meet c (ID.cast_to ik (ID.top_of ik_e))) in (* TODO: cast without overflow, is this right for normal invariant? *) - if M.tracing then M.tracel "inv" "cast: %a from %a to %a: i = %a; cast c = %a to %a = %a\n" d_exp e d_ikind ik_e d_ikind ik ID.pretty i ID.pretty c d_ikind ik_e ID.pretty c'; - inv_exp (Int c') e st - | x -> fallback (GobPretty.sprintf "CastE: e did evaluate to Int, but the type did not match %a" CilType.Typ.pretty t) st - else - fallback (GobPretty.sprintf "CastE: %a evaluates to %a which is bigger than the type it is cast to which is %a" d_plainexp e ID.pretty i CilType.Typ.pretty t) st - | v -> fallback (GobPretty.sprintf "CastE: e did not evaluate to Int, but %a" VD.pretty v) st) - | e, _ -> fallback (GobPretty.sprintf "%a not implemented" d_plainexp e) st + | a1, a2 -> fallback (GobPretty.sprintf "binop: got abstract values that are not Int: %a and %a" VD.pretty a1 VD.pretty a2) st) + (* use closures to avoid unused casts *) + in (match c_typed with + | Int c -> invert_binary_op c ID.pretty (fun ik -> ID.cast_to ik c) (fun fk -> FD.of_int fk c) + | Float c -> invert_binary_op c FD.pretty (fun ik -> FD.to_int ik c) (fun fk -> FD.cast_to fk c) + | _ -> failwith "unreachable") + | Lval x, (Int _ | Float _ | Address _) -> (* meet x with c *) + let update_lval c x c' pretty = refine_lv ctx a gs st c x c' pretty exp in + let t = Cil.unrollType (Cilfacade.typeOfLval x) in (* unroll type to deal with TNamed *) + begin match c_typed with + | Int c -> + let c' = match t with + | TPtr _ -> VD.Address (AD.of_int c) + | TInt (ik, _) + | TEnum ({ekind = ik; _}, _) -> Int (ID.cast_to ik c) + | TFloat (fk, _) -> Float (FD.of_int fk c) + | _ -> Int c + in + update_lval c x c' ID.pretty + | Float c -> + let c' = match t with + (* | TPtr _ -> ..., pointer conversion from/to float is not supported *) + | TInt (ik, _) -> VD.Int (FD.to_int ik c) + (* this is theoretically possible and should be handled correctly, however i can't imagine an actual piece of c code producing this?! *) + | TEnum ({ekind = ik; _}, _) -> Int (FD.to_int ik c) + | TFloat (fk, _) -> Float (FD.cast_to fk c) + | _ -> Float c + in + update_lval c x c' FD.pretty + | Address c -> + let c' = c_typed in (* TODO: need any of the type-matching nonsense? *) + update_lval c x c' AD.pretty + | _ -> assert false + end + | Const _ , _ -> st (* nothing to do *) + | CastE ((TFloat (_, _)), e), Float c -> + (match unrollType (Cilfacade.typeOf e), FD.get_fkind c with + | TFloat (FLongDouble as fk, _), FFloat + | TFloat (FDouble as fk, _), FFloat + | TFloat (FLongDouble as fk, _), FDouble + | TFloat (fk, _), FLongDouble + | TFloat (FDouble as fk, _), FDouble + | TFloat (FFloat as fk, _), FFloat -> inv_exp (Float (FD.cast_to fk c)) e st + | _ -> fallback ("CastE: incompatible types") st) + | CastE ((TInt (ik, _)) as t, e), Int c + | CastE ((TEnum ({ekind = ik; _ }, _)) as t, e), Int c -> (* Can only meet the t part of an Lval in e with c (unless we meet with all overflow possibilities)! Since there is no good way to do this, we only continue if e has no values outside of t. *) + (match eval e st with + | Int i -> + if ID.leq i (ID.cast_to ik i) then + match unrollType (Cilfacade.typeOf e) with + | TInt(ik_e, _) + | TEnum ({ekind = ik_e; _ }, _) -> + (* let c' = ID.cast_to ik_e c in *) + let c' = ID.cast_to ik_e (ID.meet c (ID.cast_to ik (ID.top_of ik_e))) in (* TODO: cast without overflow, is this right for normal invariant? *) + if M.tracing then M.tracel "inv" "cast: %a from %a to %a: i = %a; cast c = %a to %a = %a\n" d_exp e d_ikind ik_e d_ikind ik ID.pretty i ID.pretty c d_ikind ik_e ID.pretty c'; + inv_exp (Int c') e st + | x -> fallback (GobPretty.sprintf "CastE: e did evaluate to Int, but the type did not match %a" CilType.Typ.pretty t) st + else + fallback (GobPretty.sprintf "CastE: %a evaluates to %a which is bigger than the type it is cast to which is %a" d_plainexp e ID.pretty i CilType.Typ.pretty t) st + | v -> fallback (GobPretty.sprintf "CastE: e did not evaluate to Int, but %a" VD.pretty v) st) + | e, _ -> fallback (GobPretty.sprintf "%a not implemented" d_plainexp e) st in if eval_bool exp st = Some (not tv) then contra st (* we already know that the branch is dead *) else From 38a4a4964d689ad8f8cb8450d2d085cd3c7b5575 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 13 Jun 2023 14:33:11 +0300 Subject: [PATCH 485/518] Add two disjoint_types tests --- .../06-symbeq/43-type_nr_disjoint_types.c | 31 +++++++++++++++++++ .../06-symbeq/44-type_rc_type_field.c | 31 +++++++++++++++++++ 2 files changed, 62 insertions(+) create mode 100644 tests/regression/06-symbeq/43-type_nr_disjoint_types.c create mode 100644 tests/regression/06-symbeq/44-type_rc_type_field.c diff --git a/tests/regression/06-symbeq/43-type_nr_disjoint_types.c b/tests/regression/06-symbeq/43-type_nr_disjoint_types.c new file mode 100644 index 0000000000..a809de4e99 --- /dev/null +++ b/tests/regression/06-symbeq/43-type_nr_disjoint_types.c @@ -0,0 +1,31 @@ +// PARAM: --enable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +#include + +struct s { + int datum; + pthread_mutex_t mutex; +}; + +extern struct s *get_s(); + +void *t_fun(void *arg) { + struct s *s = get_s(); + s->datum = 5; // NORACE (disjoint types) + return NULL; +} + +int main () { + int *d; + struct s *s; + pthread_t id; + pthread_mutex_t *m; + + s = get_s(); + m = &s->mutex; + d = &s->datum; + + pthread_create(&id,NULL,t_fun,NULL); + *d = 8; // NORACE (disjoint types) + + return 0; +} diff --git a/tests/regression/06-symbeq/44-type_rc_type_field.c b/tests/regression/06-symbeq/44-type_rc_type_field.c new file mode 100644 index 0000000000..078b842c22 --- /dev/null +++ b/tests/regression/06-symbeq/44-type_rc_type_field.c @@ -0,0 +1,31 @@ +// PARAM: --enable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +#include + +struct s { + int datum; + pthread_mutex_t mutex; +}; + +extern struct s *get_s(); + +void *t_fun(void *arg) { + struct s *s = get_s(); + s->datum = 5; // RACE! + return NULL; +} + +int main () { + int *d; + struct s *s; + pthread_t id; + pthread_mutex_t *m; + + s = get_s(); + m = &s->mutex; + d = &s->datum; + + pthread_create(&id,NULL,t_fun,NULL); + s->datum = 5; // RACE! + + return 0; +} From 47de6f4c8a048a8de086537b184cd3865f0730d1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 13 Jun 2023 14:33:54 +0300 Subject: [PATCH 486/518] Fix and simplify Access.add for arithmethic types --- src/domains/access.ml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index de69ba30c3..12efec73e7 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -263,11 +263,9 @@ let add side e voffs = | `Struct (c, o) -> (TComp (c, []), o) | `Type t -> (t, `NoOffset) in - (* distribute to inner offsets directly *) - add_distribute_inner side (`Type t, o); (* TODO: this is also part of add_propagate, duplicated when called *) - (* TODO: maybe this should not depend on whether voffs = None? *) - if not (!unsound && isArithmeticType t) then (* TODO: used to check (t, o) not just t *) - add_distribute_outer side t o (* distribute to variables and outer offsets *) + match o with + | `NoOffset when !unsound && isArithmeticType t -> () + | _ -> add_distribute_outer side t o (* distribute to variables and outer offsets *) end; if M.tracing then M.traceu "access" "add\n" From 4c6ae916daa44c071f0f507f313e00f20c98af5f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 13 Jun 2023 14:34:25 +0300 Subject: [PATCH 487/518] Fix and simplify Access.add_distribute_inner --- src/domains/access.ml | 28 ++++++++-------------------- 1 file changed, 8 insertions(+), 20 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 12efec73e7..9b1b6c2364 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -203,26 +203,14 @@ let add_distribute_inner side memo: unit = List.map (fun x -> `Index ((), x)) (dist_fields t) | _ -> [`NoOffset] in - begin match Memo.type_of_base memo, memo with (* based on outermost type *) - | TComp _, _ -> (* TODO: previously just `Struct, do some `Type TComp-s also fall in here now? *) - if M.tracing then M.trace "access" "struct case\n"; - begin match Memo.type_of memo with (* based on innermost type *) - | t -> - let oss = dist_fields t in - (* 32 test(s) failed: ["02/26 malloc_struct", "04/49 type-invariants", "04/65 free_indirect_rc", "05/07 glob_fld_rc", "05/08 glob_fld_2_rc", "05/11 fldsense_rc", "05/15 fldunknown_access", "06/10 equ_rc", "06/16 type_rc", "06/21 mult_accs_rc", "06/28 symb_lockset_unsound", "06/29 symb_lockfun_unsound", "09/01 list_rc", "09/03 list2_rc", "09/05 ptra_rc", "09/07 kernel_list_rc", "09/10 arraylist_rc", "09/12 arraycollapse_rc", "09/14 kernel_foreach_rc", "09/16 arrayloop_rc", "09/18 nested_rc", "09/20 arrayloop2_rc", "09/23 evilcollapse_rc", "09/26 alloc_region_rc", "09/28 list2alloc", "09/30 list2alloc-offsets", "09/31 equ_rc", "09/35 list2_rc-offsets-thread", "09/36 global_init_rc", "29/01 race-2_3b-container_of", "29/02 race-2_4b-container_of", "29/03 race-2_5b-container_of"] *) - List.iter (fun os -> - add_one side (Memo.add_offset memo os) (* distribute to all nested offsets *) - ) oss - | exception Type_offset_error -> - if M.tracing then M.trace "access" "Type_offset_error\n"; - add_one side memo - end - | _, (`Type _, _) when !unsound -> - (* don't recognize accesses to locations such as (long ) and (int ). *) - if M.tracing then M.trace "access" "unsound case\n"; - () - | _ -> - if M.tracing then M.trace "access" "general case\n"; + begin match Memo.type_of memo with + | t -> + let oss = dist_fields t in + List.iter (fun os -> + add_one side (Memo.add_offset memo os) (* distribute to all nested offsets *) + ) oss + | exception Type_offset_error -> (* `Var has alloc variable with void type *) + if M.tracing then M.trace "access" "Type_offset_error\n"; add_one side memo end; if M.tracing then M.traceu "access" "add_distribute_inner\n" From 24a559d63c0c62bc1d966d02dbb75d81a48b0b90 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 13 Jun 2023 14:40:10 +0300 Subject: [PATCH 488/518] Remove Access.Type_offset_error --- src/domains/access.ml | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 9b1b6c2364..153bfedf22 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -75,14 +75,12 @@ let reset () = type acc_typ = [ `Type of CilType.Typ.t | `Struct of CilType.Compinfo.t * Offset.Unit.t ] [@@deriving eq, ord, hash] (** Old access type inferred from an expression. *) -exception Type_offset_error - (** Memory location of an access. *) module Memo = struct include Printable.StdLeaf type t = [`Var of CilType.Varinfo.t | `Type of CilType.Typ.t] * Offset.Unit.t [@@deriving eq, ord, hash] - (* TODO: use typsig for `Type? *) + (* Can't use typsig for `Type because there's no function to follow offsets on typsig. *) let name () = "memo" @@ -116,9 +114,9 @@ struct | `Var v -> v.vtype | `Type t -> t + (** @raise Offset.Type_of_error *) let type_of ((vt, o) as memo: t): typ = - try Offset.Unit.type_of ~base:(type_of_base memo) o - with Offset.Type_of_error _ -> raise Type_offset_error + Offset.Unit.type_of ~base:(type_of_base memo) o end (* TODO: What is the logic for get_type? *) @@ -209,8 +207,8 @@ let add_distribute_inner side memo: unit = List.iter (fun os -> add_one side (Memo.add_offset memo os) (* distribute to all nested offsets *) ) oss - | exception Type_offset_error -> (* `Var has alloc variable with void type *) - if M.tracing then M.trace "access" "Type_offset_error\n"; + | exception Offset.Type_of_error _ -> (* `Var has alloc variable with void type *) + if M.tracing then M.trace "access" "Offset.Type_of_error\n"; add_one side memo end; if M.tracing then M.traceu "access" "add_distribute_inner\n" From a1c87c68ca04f8b28b56076de024b0bb1f67c4d5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 13 Jun 2023 14:49:11 +0300 Subject: [PATCH 489/518] Rename and flip option ana.mutex.disjoint_types -> ana.race.direct-arithmetic --- src/domains/access.ml | 6 +++--- src/util/options.schema.json | 20 ++++++------------- .../regression/04-mutex/49-type-invariants.c | 2 +- .../regression/04-mutex/49-type-invariants.t | 4 ++-- .../04-mutex/77-type-nested-fields.c | 2 +- tests/regression/04-mutex/78-type-array.c | 2 +- .../04-mutex/79-type-nested-fields-deep1.c | 2 +- .../04-mutex/80-type-nested-fields-deep2.c | 2 +- tests/regression/06-symbeq/01-symbeq_ints.c | 2 +- .../regression/06-symbeq/02-funloop_norace.c | 2 +- .../regression/06-symbeq/03-funloop_simple.c | 2 +- tests/regression/06-symbeq/04-funloop_hard1.c | 2 +- tests/regression/06-symbeq/05-funloop_hard2.c | 2 +- .../regression/06-symbeq/06-tricky_address1.c | 2 +- .../regression/06-symbeq/07-tricky_address2.c | 2 +- .../regression/06-symbeq/08-tricky_address3.c | 2 +- .../regression/06-symbeq/09-tricky_address4.c | 2 +- tests/regression/06-symbeq/10-equ_rc.c | 2 +- tests/regression/06-symbeq/11-equ_nr.c | 2 +- tests/regression/06-symbeq/13-equ_proc_nr.c | 2 +- tests/regression/06-symbeq/14-list_entry_rc.c | 2 +- tests/regression/06-symbeq/15-list_entry_nr.c | 2 +- tests/regression/06-symbeq/16-type_rc.c | 2 +- tests/regression/06-symbeq/16-type_rc.t | 4 ++-- tests/regression/06-symbeq/17-type_nr.c | 2 +- tests/regression/06-symbeq/18-symbeq_addrs.c | 2 +- tests/regression/06-symbeq/19-symbeq_funcs.c | 2 +- tests/regression/06-symbeq/20-mult_accs_nr.c | 4 ++-- tests/regression/06-symbeq/21-mult_accs_rc.c | 2 +- tests/regression/06-symbeq/21-mult_accs_rc.t | 4 ++-- tests/regression/06-symbeq/22-var_eq_types.c | 2 +- tests/regression/06-symbeq/37-funloop_index.c | 2 +- .../06-symbeq/39-funloop_index_bad.c | 2 +- .../06-symbeq/43-type_nr_disjoint_types.c | 2 +- .../06-symbeq/44-type_rc_type_field.c | 2 +- .../06-symbeq/50-type_array_via_ptr_rc.c | 2 +- tests/regression/06-symbeq/51-typedef_rc.c | 2 +- tests/regression/06-symbeq/52-typedef2_rc.c | 2 +- .../11-heap/14-list_entry_rc-unroll.c | 2 +- .../28-race_reach/70-funloop_racefree.c | 2 +- .../28-race_reach/71-funloop_racing.c | 2 +- .../28-race_reach/72-funloop_hard_racing.c | 2 +- .../28-race_reach/73-funloop_hard_racefree.c | 2 +- .../74-tricky_address1_racefree.c | 2 +- .../75-tricky_address2_racefree.c | 2 +- .../76-tricky_address3_racefree.c | 2 +- .../28-race_reach/77-tricky_address4_racing.c | 2 +- .../regression/28-race_reach/78-equ_racing.c | 2 +- .../28-race_reach/79-equ_racefree.c | 2 +- 49 files changed, 60 insertions(+), 68 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index 153bfedf22..ce35e90e64 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -31,10 +31,10 @@ module TSH = Hashtbl.Make (CilType.Typsig) let typeVar = TSH.create 101 let typeIncl = TSH.create 101 -let unsound = ref false +let collect_direct_arithmetic = ref false let init (f:file) = - unsound := get_bool "ana.mutex.disjoint_types"; + collect_direct_arithmetic := get_bool "ana.race.direct-arithmetic"; let visited_vars = Hashtbl.create 100 in let add tsh t v = let rec add' ts = @@ -250,7 +250,7 @@ let add side e voffs = | `Type t -> (t, `NoOffset) in match o with - | `NoOffset when !unsound && isArithmeticType t -> () + | `NoOffset when not !collect_direct_arithmetic && isArithmeticType t -> () | _ -> add_distribute_outer side t o (* distribute to variables and outer offsets *) end; if M.tracing then M.traceu "access" "add\n" diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 02fc929a8a..5c0e27c586 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -522,20 +522,6 @@ }, "additionalProperties": false }, - "mutex": { - "title": "ana.mutex", - "type": "object", - "properties": { - "disjoint_types": { - "title": "ana.mutex.disjoint_types", - "description": - "Do not propagate basic type writes to all struct fields", - "type": "boolean", - "default": true - } - }, - "additionalProperties": false - }, "autotune": { "title": "ana.autotune", "type": "object", @@ -1002,6 +988,12 @@ "description": "Consider memory free as racing write.", "type": "boolean", "default": true + }, + "direct-arithmetic": { + "title": "ana.race.direct-arithmetic", + "description": "Collect and distribute direct (i.e. not in a field) accesses to arithmetic types.", + "type": "boolean", + "default": false } }, "additionalProperties": false diff --git a/tests/regression/04-mutex/49-type-invariants.c b/tests/regression/04-mutex/49-type-invariants.c index 9dda6f16eb..4f69986478 100644 --- a/tests/regression/04-mutex/49-type-invariants.c +++ b/tests/regression/04-mutex/49-type-invariants.c @@ -1,4 +1,4 @@ -//PARAM: --disable ana.mutex.disjoint_types +//PARAM: --enable ana.race.direct-arithmetic #include #include diff --git a/tests/regression/04-mutex/49-type-invariants.t b/tests/regression/04-mutex/49-type-invariants.t index c4612f4e2a..c8eca36d3f 100644 --- a/tests/regression/04-mutex/49-type-invariants.t +++ b/tests/regression/04-mutex/49-type-invariants.t @@ -1,4 +1,4 @@ - $ goblint --disable ana.mutex.disjoint_types --enable allglobs 49-type-invariants.c + $ goblint --enable ana.race.direct-arithmetic --enable allglobs 49-type-invariants.c [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:22:3-22:21) [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:22:3-22:21) [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:22:3-22:21) @@ -22,7 +22,7 @@ unsafe: 1 total memory locations: 2 - $ goblint --enable ana.mutex.disjoint_types --enable allglobs 49-type-invariants.c + $ goblint --disable ana.race.direct-arithmetic --enable allglobs 49-type-invariants.c [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:22:3-22:21) [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:22:3-22:21) [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:22:3-22:21) diff --git a/tests/regression/04-mutex/77-type-nested-fields.c b/tests/regression/04-mutex/77-type-nested-fields.c index cfb23c4f83..6f173d6fec 100644 --- a/tests/regression/04-mutex/77-type-nested-fields.c +++ b/tests/regression/04-mutex/77-type-nested-fields.c @@ -1,4 +1,4 @@ -//PARAM: --disable ana.mutex.disjoint_types +//PARAM: --enable ana.race.direct-arithmetic #include #include diff --git a/tests/regression/04-mutex/78-type-array.c b/tests/regression/04-mutex/78-type-array.c index 58c207109c..cdffe244b9 100644 --- a/tests/regression/04-mutex/78-type-array.c +++ b/tests/regression/04-mutex/78-type-array.c @@ -1,4 +1,4 @@ -//PARAM: --disable ana.mutex.disjoint_types +//PARAM: --enable ana.race.direct-arithmetic #include #include diff --git a/tests/regression/04-mutex/79-type-nested-fields-deep1.c b/tests/regression/04-mutex/79-type-nested-fields-deep1.c index 62f4d61bbf..ee99c40973 100644 --- a/tests/regression/04-mutex/79-type-nested-fields-deep1.c +++ b/tests/regression/04-mutex/79-type-nested-fields-deep1.c @@ -1,4 +1,4 @@ -//PARAM: --disable ana.mutex.disjoint_types +//PARAM: --enable ana.race.direct-arithmetic #include #include diff --git a/tests/regression/04-mutex/80-type-nested-fields-deep2.c b/tests/regression/04-mutex/80-type-nested-fields-deep2.c index 8101c0cec0..646acd9147 100644 --- a/tests/regression/04-mutex/80-type-nested-fields-deep2.c +++ b/tests/regression/04-mutex/80-type-nested-fields-deep2.c @@ -1,4 +1,4 @@ -//PARAM: --disable ana.mutex.disjoint_types +//PARAM: --enable ana.race.direct-arithmetic #include #include diff --git a/tests/regression/06-symbeq/01-symbeq_ints.c b/tests/regression/06-symbeq/01-symbeq_ints.c index a56c5a983f..0d0b6278fd 100644 --- a/tests/regression/06-symbeq/01-symbeq_ints.c +++ b/tests/regression/06-symbeq/01-symbeq_ints.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" #include #include diff --git a/tests/regression/06-symbeq/02-funloop_norace.c b/tests/regression/06-symbeq/02-funloop_norace.c index bac9333349..e5bbc82a0c 100644 --- a/tests/regression/06-symbeq/02-funloop_norace.c +++ b/tests/regression/06-symbeq/02-funloop_norace.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include diff --git a/tests/regression/06-symbeq/03-funloop_simple.c b/tests/regression/06-symbeq/03-funloop_simple.c index 69c9006ef7..263cfa8124 100644 --- a/tests/regression/06-symbeq/03-funloop_simple.c +++ b/tests/regression/06-symbeq/03-funloop_simple.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include diff --git a/tests/regression/06-symbeq/04-funloop_hard1.c b/tests/regression/06-symbeq/04-funloop_hard1.c index b3fd1479eb..b62775aa33 100644 --- a/tests/regression/06-symbeq/04-funloop_hard1.c +++ b/tests/regression/06-symbeq/04-funloop_hard1.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include diff --git a/tests/regression/06-symbeq/05-funloop_hard2.c b/tests/regression/06-symbeq/05-funloop_hard2.c index 49e7f3f42d..29d38a7875 100644 --- a/tests/regression/06-symbeq/05-funloop_hard2.c +++ b/tests/regression/06-symbeq/05-funloop_hard2.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include diff --git a/tests/regression/06-symbeq/06-tricky_address1.c b/tests/regression/06-symbeq/06-tricky_address1.c index fe83b3cf4f..25c7705c8c 100644 --- a/tests/regression/06-symbeq/06-tricky_address1.c +++ b/tests/regression/06-symbeq/06-tricky_address1.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" extern int __VERIFIER_nondet_int(); extern void abort(void); void assume_abort_if_not(int cond) { diff --git a/tests/regression/06-symbeq/07-tricky_address2.c b/tests/regression/06-symbeq/07-tricky_address2.c index edf22cc354..8a25bbd3a3 100644 --- a/tests/regression/06-symbeq/07-tricky_address2.c +++ b/tests/regression/06-symbeq/07-tricky_address2.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" extern int __VERIFIER_nondet_int(); extern void abort(void); void assume_abort_if_not(int cond) { diff --git a/tests/regression/06-symbeq/08-tricky_address3.c b/tests/regression/06-symbeq/08-tricky_address3.c index 6372b6c27e..1a8160ea6f 100644 --- a/tests/regression/06-symbeq/08-tricky_address3.c +++ b/tests/regression/06-symbeq/08-tricky_address3.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" extern int __VERIFIER_nondet_int(); extern void abort(void); void assume_abort_if_not(int cond) { diff --git a/tests/regression/06-symbeq/09-tricky_address4.c b/tests/regression/06-symbeq/09-tricky_address4.c index 929832ca81..1d1e10861f 100644 --- a/tests/regression/06-symbeq/09-tricky_address4.c +++ b/tests/regression/06-symbeq/09-tricky_address4.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" extern int __VERIFIER_nondet_int(); extern void abort(void); void assume_abort_if_not(int cond) { diff --git a/tests/regression/06-symbeq/10-equ_rc.c b/tests/regression/06-symbeq/10-equ_rc.c index 9f7fbf47f9..51f09b59ed 100644 --- a/tests/regression/06-symbeq/10-equ_rc.c +++ b/tests/regression/06-symbeq/10-equ_rc.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" extern int __VERIFIER_nondet_int(); #include diff --git a/tests/regression/06-symbeq/11-equ_nr.c b/tests/regression/06-symbeq/11-equ_nr.c index f3525ce9c2..5e1d6cd9ff 100644 --- a/tests/regression/06-symbeq/11-equ_nr.c +++ b/tests/regression/06-symbeq/11-equ_nr.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" extern int __VERIFIER_nondet_int(); #include diff --git a/tests/regression/06-symbeq/13-equ_proc_nr.c b/tests/regression/06-symbeq/13-equ_proc_nr.c index e13dd898b3..0a33f8780f 100644 --- a/tests/regression/06-symbeq/13-equ_proc_nr.c +++ b/tests/regression/06-symbeq/13-equ_proc_nr.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" extern int __VERIFIER_nondet_int(); #include diff --git a/tests/regression/06-symbeq/14-list_entry_rc.c b/tests/regression/06-symbeq/14-list_entry_rc.c index cdf4e3caee..ccf5da4234 100644 --- a/tests/regression/06-symbeq/14-list_entry_rc.c +++ b/tests/regression/06-symbeq/14-list_entry_rc.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include diff --git a/tests/regression/06-symbeq/15-list_entry_nr.c b/tests/regression/06-symbeq/15-list_entry_nr.c index 84397101d9..419815915b 100644 --- a/tests/regression/06-symbeq/15-list_entry_nr.c +++ b/tests/regression/06-symbeq/15-list_entry_nr.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include diff --git a/tests/regression/06-symbeq/16-type_rc.c b/tests/regression/06-symbeq/16-type_rc.c index b3767fe1bb..efeb6c768b 100644 --- a/tests/regression/06-symbeq/16-type_rc.c +++ b/tests/regression/06-symbeq/16-type_rc.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include struct s { diff --git a/tests/regression/06-symbeq/16-type_rc.t b/tests/regression/06-symbeq/16-type_rc.t index 0d122ae37e..17de2b05fa 100644 --- a/tests/regression/06-symbeq/16-type_rc.t +++ b/tests/regression/06-symbeq/16-type_rc.t @@ -1,4 +1,4 @@ - $ goblint --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c + $ goblint --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:23:3-23:14) [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (16-type_rc.c:23:3-23:14) @@ -78,7 +78,7 @@ unsafe: 1 total memory locations: 26 - $ goblint --enable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c + $ goblint --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:23:3-23:14) [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (16-type_rc.c:23:3-23:14) diff --git a/tests/regression/06-symbeq/17-type_nr.c b/tests/regression/06-symbeq/17-type_nr.c index b6237ab054..8919f0ad99 100644 --- a/tests/regression/06-symbeq/17-type_nr.c +++ b/tests/regression/06-symbeq/17-type_nr.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include struct s { diff --git a/tests/regression/06-symbeq/18-symbeq_addrs.c b/tests/regression/06-symbeq/18-symbeq_addrs.c index 63c6d68340..6cd5e8e49e 100644 --- a/tests/regression/06-symbeq/18-symbeq_addrs.c +++ b/tests/regression/06-symbeq/18-symbeq_addrs.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" #include #include diff --git a/tests/regression/06-symbeq/19-symbeq_funcs.c b/tests/regression/06-symbeq/19-symbeq_funcs.c index ab5e8bd1b7..f9d85349a0 100644 --- a/tests/regression/06-symbeq/19-symbeq_funcs.c +++ b/tests/regression/06-symbeq/19-symbeq_funcs.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" #include void inc(int * a){ diff --git a/tests/regression/06-symbeq/20-mult_accs_nr.c b/tests/regression/06-symbeq/20-mult_accs_nr.c index 859349fc94..7d66e3f5d2 100644 --- a/tests/regression/06-symbeq/20-mult_accs_nr.c +++ b/tests/regression/06-symbeq/20-mult_accs_nr.c @@ -1,4 +1,4 @@ -// SKIP PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// SKIP PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include struct s { @@ -10,7 +10,7 @@ struct s { extern struct s *get_s(); void *t_fun(void *arg) { - struct s *s; + struct s *s; s = get_s(); pthread_mutex_lock(&s->mutex); s->data = 5; // NORACE diff --git a/tests/regression/06-symbeq/21-mult_accs_rc.c b/tests/regression/06-symbeq/21-mult_accs_rc.c index b7aa6d9c7e..62550fab55 100644 --- a/tests/regression/06-symbeq/21-mult_accs_rc.c +++ b/tests/regression/06-symbeq/21-mult_accs_rc.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include struct s { diff --git a/tests/regression/06-symbeq/21-mult_accs_rc.t b/tests/regression/06-symbeq/21-mult_accs_rc.t index dc7abc76f8..5491a9fbac 100644 --- a/tests/regression/06-symbeq/21-mult_accs_rc.t +++ b/tests/regression/06-symbeq/21-mult_accs_rc.t @@ -1,4 +1,4 @@ - $ goblint --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c + $ goblint --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:27:3-27:14) [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:27:3-27:14) @@ -87,7 +87,7 @@ unsafe: 1 total memory locations: 26 - $ goblint --enable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c + $ goblint --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:27:3-27:14) [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:27:3-27:14) diff --git a/tests/regression/06-symbeq/22-var_eq_types.c b/tests/regression/06-symbeq/22-var_eq_types.c index 853691b914..348ea1574a 100644 --- a/tests/regression/06-symbeq/22-var_eq_types.c +++ b/tests/regression/06-symbeq/22-var_eq_types.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" #include #include diff --git a/tests/regression/06-symbeq/37-funloop_index.c b/tests/regression/06-symbeq/37-funloop_index.c index d4c269cc05..2bb9929ffb 100644 --- a/tests/regression/06-symbeq/37-funloop_index.c +++ b/tests/regression/06-symbeq/37-funloop_index.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" // copy of 06/02 with additional index accesses #include #include diff --git a/tests/regression/06-symbeq/39-funloop_index_bad.c b/tests/regression/06-symbeq/39-funloop_index_bad.c index 1983887796..122b82d6c9 100644 --- a/tests/regression/06-symbeq/39-funloop_index_bad.c +++ b/tests/regression/06-symbeq/39-funloop_index_bad.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" // copy of 06/02 with additional index accesses (that are wrong) #include #include diff --git a/tests/regression/06-symbeq/43-type_nr_disjoint_types.c b/tests/regression/06-symbeq/43-type_nr_disjoint_types.c index a809de4e99..d279b8d154 100644 --- a/tests/regression/06-symbeq/43-type_nr_disjoint_types.c +++ b/tests/regression/06-symbeq/43-type_nr_disjoint_types.c @@ -1,4 +1,4 @@ -// PARAM: --enable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include struct s { diff --git a/tests/regression/06-symbeq/44-type_rc_type_field.c b/tests/regression/06-symbeq/44-type_rc_type_field.c index 078b842c22..d9d1149c7f 100644 --- a/tests/regression/06-symbeq/44-type_rc_type_field.c +++ b/tests/regression/06-symbeq/44-type_rc_type_field.c @@ -1,4 +1,4 @@ -// PARAM: --enable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include struct s { diff --git a/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c b/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c index 4f33fe0202..1c407f1110 100644 --- a/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c +++ b/tests/regression/06-symbeq/50-type_array_via_ptr_rc.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include struct s { diff --git a/tests/regression/06-symbeq/51-typedef_rc.c b/tests/regression/06-symbeq/51-typedef_rc.c index c5aacfe4f6..a4faa1fb8a 100644 --- a/tests/regression/06-symbeq/51-typedef_rc.c +++ b/tests/regression/06-symbeq/51-typedef_rc.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" // Simplified example from the silver searcher #include diff --git a/tests/regression/06-symbeq/52-typedef2_rc.c b/tests/regression/06-symbeq/52-typedef2_rc.c index d9b8ffd8af..920d443b52 100644 --- a/tests/regression/06-symbeq/52-typedef2_rc.c +++ b/tests/regression/06-symbeq/52-typedef2_rc.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" // MANUAL must have race on (int), not safe on (int) and (int2) #include diff --git a/tests/regression/11-heap/14-list_entry_rc-unroll.c b/tests/regression/11-heap/14-list_entry_rc-unroll.c index 37e262b611..dfe103dd3e 100644 --- a/tests/regression/11-heap/14-list_entry_rc-unroll.c +++ b/tests/regression/11-heap/14-list_entry_rc-unroll.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --set ana.malloc.unique_address_count 1 +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --set ana.malloc.unique_address_count 1 // Copied from 06-symbeq/14-list_entry_rc, proven safe thanks to unique address #include #include diff --git a/tests/regression/28-race_reach/70-funloop_racefree.c b/tests/regression/28-race_reach/70-funloop_racefree.c index 492e836d1f..11f44100cd 100644 --- a/tests/regression/28-race_reach/70-funloop_racefree.c +++ b/tests/regression/28-race_reach/70-funloop_racefree.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/71-funloop_racing.c b/tests/regression/28-race_reach/71-funloop_racing.c index 92fa29967b..d34be23175 100644 --- a/tests/regression/28-race_reach/71-funloop_racing.c +++ b/tests/regression/28-race_reach/71-funloop_racing.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/72-funloop_hard_racing.c b/tests/regression/28-race_reach/72-funloop_hard_racing.c index 9fc24a96e1..d913bb16a6 100644 --- a/tests/regression/28-race_reach/72-funloop_hard_racing.c +++ b/tests/regression/28-race_reach/72-funloop_hard_racing.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/73-funloop_hard_racefree.c b/tests/regression/28-race_reach/73-funloop_hard_racefree.c index 67028e10f9..33571b8c4d 100644 --- a/tests/regression/28-race_reach/73-funloop_hard_racefree.c +++ b/tests/regression/28-race_reach/73-funloop_hard_racefree.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/74-tricky_address1_racefree.c b/tests/regression/28-race_reach/74-tricky_address1_racefree.c index e98dd0e9a9..0fdacd23c2 100644 --- a/tests/regression/28-race_reach/74-tricky_address1_racefree.c +++ b/tests/regression/28-race_reach/74-tricky_address1_racefree.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/75-tricky_address2_racefree.c b/tests/regression/28-race_reach/75-tricky_address2_racefree.c index d69025c5df..76b3b3752a 100644 --- a/tests/regression/28-race_reach/75-tricky_address2_racefree.c +++ b/tests/regression/28-race_reach/75-tricky_address2_racefree.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/76-tricky_address3_racefree.c b/tests/regression/28-race_reach/76-tricky_address3_racefree.c index 6787175741..1a782b670e 100644 --- a/tests/regression/28-race_reach/76-tricky_address3_racefree.c +++ b/tests/regression/28-race_reach/76-tricky_address3_racefree.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/77-tricky_address4_racing.c b/tests/regression/28-race_reach/77-tricky_address4_racing.c index fbe705cc10..5b189aa221 100644 --- a/tests/regression/28-race_reach/77-tricky_address4_racing.c +++ b/tests/regression/28-race_reach/77-tricky_address4_racing.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/78-equ_racing.c b/tests/regression/28-race_reach/78-equ_racing.c index 703ed7cce5..32e10d5a02 100644 --- a/tests/regression/28-race_reach/78-equ_racing.c +++ b/tests/regression/28-race_reach/78-equ_racing.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" diff --git a/tests/regression/28-race_reach/79-equ_racefree.c b/tests/regression/28-race_reach/79-equ_racefree.c index fcea2bb341..ba9affb71f 100644 --- a/tests/regression/28-race_reach/79-equ_racefree.c +++ b/tests/regression/28-race_reach/79-equ_racefree.c @@ -1,4 +1,4 @@ -// PARAM: --disable ana.mutex.disjoint_types --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" +// PARAM: --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" #include #include #include "racemacros.h" From db42e88ee4495d886606b54cf731476d516abb60 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 13 Jun 2023 15:01:16 +0300 Subject: [PATCH 490/518] Extract Access.nested_offsets --- src/domains/access.ml | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index ce35e90e64..b310eeb539 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -183,27 +183,28 @@ let add_one side memo: unit = if not ignorable then side memo +(** Find all nested offsets in type. *) +let rec nested_offsets ty: Offset.Unit.t list = + (* TODO: is_ignorable_type outside of TComp if ty itself is ignorable? *) + match unrollType ty with + | TComp (ci,_) -> + let one_field fld = + if is_ignorable_type fld.ftype then + [] + else + List.map (fun x -> `Field (fld,x)) (nested_offsets fld.ftype) + in + List.concat_map one_field ci.cfields + | TArray (t,_,_) -> + List.map (fun x -> `Index ((), x)) (nested_offsets t) + | _ -> [`NoOffset] + (** Distribute access to contained fields. *) let add_distribute_inner side memo: unit = if M.tracing then M.tracei "access" "add_distribute_inner %a\n" Memo.pretty memo; - let rec dist_fields ty : Offset.Unit.t list = (* Find all nested offsets in type. *) - (* TODO: is_ignorable_type outside of TComp if ty itself is ignorable? *) - match unrollType ty with - | TComp (ci,_) -> - let one_field fld = - if is_ignorable_type fld.ftype then - [] - else - List.map (fun x -> `Field (fld,x)) (dist_fields fld.ftype) - in - List.concat_map one_field ci.cfields - | TArray (t,_,_) -> - List.map (fun x -> `Index ((), x)) (dist_fields t) - | _ -> [`NoOffset] - in begin match Memo.type_of memo with | t -> - let oss = dist_fields t in + let oss = nested_offsets t in List.iter (fun os -> add_one side (Memo.add_offset memo os) (* distribute to all nested offsets *) ) oss From 36e47f6f37150d750019c90fcfbacd64920af304 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 13 Jun 2023 15:23:01 +0300 Subject: [PATCH 491/518] Implement nicer anonstruct and anonunion matching in Access.is_ignorable_type --- src/domains/access.ml | 7 ++++++- src/util/cilfacade.ml | 17 +++++++++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/src/domains/access.ml b/src/domains/access.ml index b310eeb539..574e912d34 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -14,7 +14,12 @@ let is_ignorable_type (t: typ): bool = match t with | TNamed ({ tname = "atomic_t" | "pthread_mutex_t" | "pthread_rwlock_t" | "pthread_spinlock_t" | "spinlock_t" | "pthread_cond_t"; _ }, _) -> true | TComp ({ cname = "__pthread_mutex_s" | "__pthread_rwlock_arch_t" | "__jmp_buf_tag" | "_pthread_cleanup_buffer" | "__pthread_cleanup_frame" | "__cancel_jmp_buf_tag"; _}, _) -> true - | TComp ({ cname; _}, _) when String.starts_with_stdlib ~prefix:"__anonunion_pthread_mutexattr_t" cname || String.starts_with_stdlib ~prefix:"__anonunion_pthread_condattr_t" cname || String.starts_with_stdlib ~prefix:"__anonstruct___once_flag" cname || String.starts_with_stdlib ~prefix:"__anonunion_pthread_barrierattr_t" cname || String.starts_with_stdlib ~prefix:"__anonstruct___pthread_unwind_buf_t" cname || String.starts_with_stdlib ~prefix:"__anonstruct___cancel_jmp_buf" cname -> true + | TComp ({ cname; _}, _) when String.starts_with_stdlib ~prefix:"__anon" cname -> + begin match Cilfacade.split_anoncomp_name cname with + | (true, ("__once_flag" | "__pthread_unwind_buf_t" | "__cancel_jmp_buf"), _) -> true (* anonstruct *) + | (false, ("pthread_mutexattr_t" | "pthread_condattr_t" | "pthread_barrierattr_t"), _) -> true (* anonunion *) + | _ -> false + end | TComp ({ cname = "lock_class_key"; _ }, _) -> true | TInt (IInt, attr) when hasAttribute "mutex" attr -> true | t when hasAttribute "atomic" (typeAttrs t) -> true (* C11 _Atomic *) diff --git a/src/util/cilfacade.ml b/src/util/cilfacade.ml index fa5cf09c19..d0dcc428ad 100644 --- a/src/util/cilfacade.ml +++ b/src/util/cilfacade.ml @@ -342,6 +342,23 @@ let makeBinOp binop e1 e2 = let (_, e) = Cabs2cil.doBinOp binop e1 t1 e2 t2 in e +let anoncomp_name_regexp = Str.regexp {|^__anon\(struct\|union\)_\(.+\)_\([0-9]+\)$|} + +let split_anoncomp_name name = + (* __anonunion_pthread_mutexattr_t_488594144 *) + if Str.string_match anoncomp_name_regexp name 0 then ( + let struct_ = match Str.matched_group 1 name with + | "struct" -> true + | "union" -> false + | _ -> assert false + in + let name' = Str.matched_group 2 name in + let id = int_of_string (Str.matched_group 3 name) in + (struct_, name', id) + ) + else + invalid_arg "Cilfacade.split_anoncomp_name" + (** HashSet of line numbers *) let locs = Hashtbl.create 200 From d13aceae05cb3ade97981da209edc1d42d98748d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 14 Jun 2023 10:28:52 +0300 Subject: [PATCH 492/518] Remove system-dependent parts of cram tests --- .../regression/04-mutex/49-type-invariants.t | 7 ++- tests/regression/06-symbeq/16-type_rc.t | 56 +------------------ tests/regression/06-symbeq/21-mult_accs_rc.t | 56 +------------------ 3 files changed, 10 insertions(+), 109 deletions(-) diff --git a/tests/regression/04-mutex/49-type-invariants.t b/tests/regression/04-mutex/49-type-invariants.t index c8eca36d3f..31d90e52e0 100644 --- a/tests/regression/04-mutex/49-type-invariants.t +++ b/tests/regression/04-mutex/49-type-invariants.t @@ -37,10 +37,11 @@ total lines: 7 [Success][Race] Memory location (struct S).field (safe): write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) - [Success][Race] Memory location s.field@49-type-invariants.c:9:10-9:11 (safe): + [Warning][Race] Memory location s.field@49-type-invariants.c:9:10-9:11 (race with conf. 110): + write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) read with [mhp:{tid=[main, t_fun@49-type-invariants.c:21:3-21:40#top]}, thread:[main, t_fun@49-type-invariants.c:21:3-21:40#top]] (conf. 110) (exp: & s.field) (49-type-invariants.c:12:3-12:23) [Info][Race] Memory locations race summary: - safe: 2 + safe: 1 vulnerable: 0 - unsafe: 0 + unsafe: 1 total memory locations: 2 diff --git a/tests/regression/06-symbeq/16-type_rc.t b/tests/regression/06-symbeq/16-type_rc.t index 17de2b05fa..6aa5bb552d 100644 --- a/tests/regression/06-symbeq/16-type_rc.t +++ b/tests/regression/06-symbeq/16-type_rc.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c + $ goblint --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 16-type_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:23:3-23:14) [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (16-type_rc.c:23:3-23:14) @@ -19,64 +19,14 @@ live: 11 dead: 0 total lines: 11 - [Success][Race] Memory location (struct __anonstruct___cancel_jmp_buf_572769531).__mask_was_saved (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __anonunion_pthread_mutexattr_t_488594144).__align (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct _pthread_cleanup_buffer).__canceltype (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (int ) (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) [Warning][Race] Memory location (struct s).datum (race with conf. 100): write with [mhp:{tid=[main, t_fun@16-type_rc.c:27:3-27:37#top]}, thread:[main, t_fun@16-type_rc.c:27:3-27:37#top]] (conf. 100) (exp: & s->datum) (16-type_rc.c:13:3-13:15) write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __anonunion_pthread_condattr_t_488594145).__align (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_year (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_isdst (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location __daylight@/usr/include/time.h:160:12-160:22 (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __pthread_mutex_s).__lock (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_sec (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_min (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __pthread_cleanup_frame).__do_it (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_mday (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __pthread_mutex_s).__owner (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_wday (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_yday (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __pthread_mutex_s).__kind (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_mon (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __pthread_rwlock_arch_t).__cur_writer (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __pthread_cleanup_frame).__cancel_type (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct sched_param).sched_priority (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct tm).tm_hour (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __anonunion_pthread_barrierattr_t_951761806).__align (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location daylight@/usr/include/time.h:174:12-174:20 (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Success][Race] Memory location (struct __pthread_rwlock_arch_t).__shared (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) [Info][Race] Memory locations race summary: - safe: 25 + safe: 14 vulnerable: 0 unsafe: 1 - total memory locations: 26 + total memory locations: 15 $ goblint --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) diff --git a/tests/regression/06-symbeq/21-mult_accs_rc.t b/tests/regression/06-symbeq/21-mult_accs_rc.t index 5491a9fbac..474da9c89f 100644 --- a/tests/regression/06-symbeq/21-mult_accs_rc.t +++ b/tests/regression/06-symbeq/21-mult_accs_rc.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c + $ goblint --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 21-mult_accs_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:27:3-27:14) [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:27:3-27:14) @@ -28,64 +28,14 @@ live: 16 dead: 0 total lines: 16 - [Success][Race] Memory location (struct __anonstruct___cancel_jmp_buf_572769531).__mask_was_saved (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __anonunion_pthread_mutexattr_t_488594144).__align (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct _pthread_cleanup_buffer).__canceltype (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (int ) (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __anonunion_pthread_condattr_t_488594145).__align (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_year (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_isdst (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location __daylight@/usr/include/time.h:160:12-160:22 (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __pthread_mutex_s).__lock (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_sec (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_min (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __pthread_cleanup_frame).__do_it (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_mday (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __pthread_mutex_s).__owner (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_wday (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_yday (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __pthread_mutex_s).__kind (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) [Warning][Race] Memory location (struct s).data (race with conf. 100): write with [mhp:{tid=[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}, thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_mon (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __pthread_rwlock_arch_t).__cur_writer (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __pthread_cleanup_frame).__cancel_type (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct sched_param).sched_priority (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct tm).tm_hour (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __anonunion_pthread_barrierattr_t_951761806).__align (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location daylight@/usr/include/time.h:174:12-174:20 (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Success][Race] Memory location (struct __pthread_rwlock_arch_t).__shared (safe): - write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) [Info][Race] Memory locations race summary: - safe: 25 + safe: 14 vulnerable: 0 unsafe: 1 - total memory locations: 26 + total memory locations: 15 $ goblint --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) From bb07fd5dc1572f56997f6ef45729037f28e00220 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 14 Jun 2023 10:32:12 +0300 Subject: [PATCH 493/518] Add "fix indentation in baseInvariant" to .git-blame-ignore-revs --- .git-blame-ignore-revs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index b77b865719..53dd9114cc 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -28,3 +28,6 @@ ec8611a3a72ae0d95ec82ffee16c5c4785111aa1 # Set up end-of-line normalization. 78fd79e7f4d15c4412221b155971fac2e0616b90 + +# fix indentation in baseInvariant +f3ffd5e45c034574020f56519ccdb021da2a1479 From b592c3c6157ec94198254b0d85bbf6903f949751 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 14 Jun 2023 10:35:33 +0300 Subject: [PATCH 494/518] Fix MutexAnalysis indentation (PR #1073) --- src/analyses/mutexAnalysis.ml | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index 3bfb8711a9..d9cdef9286 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -19,12 +19,14 @@ struct (* the maximum multiplicity which we keep track of precisely *) let max_count () = 4 - module Count = Lattice.Reverse( - Lattice.Chain (struct - let n () = max_count () + 1 - let names x = if x = max_count () then Format.asprintf ">= %d" x else Format.asprintf "%d" x - end) - ) + module Count = Lattice.Reverse ( + Lattice.Chain ( + struct + let n () = max_count () + 1 + let names x = if x = max_count () then Format.asprintf ">= %d" x else Format.asprintf "%d" x + end + ) + ) include MapDomain.MapTop_LiftBot (ValueDomain.Addr) (Count) From 3fd471c81ee24a40046d940d03e296a7ef189e4c Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 14 Jun 2023 10:43:37 +0200 Subject: [PATCH 495/518] Enable intervals for test case. --- tests/regression/45-escape/06-local-escp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/45-escape/06-local-escp.c b/tests/regression/45-escape/06-local-escp.c index d89d569e45..50d27e200e 100644 --- a/tests/regression/45-escape/06-local-escp.c +++ b/tests/regression/45-escape/06-local-escp.c @@ -1,4 +1,4 @@ -// SKIP +// PARAM: --enable ana.int.interval #include #include #include From 006d4ea93506d906e3da230d2ada85f585987303 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 14 Jun 2023 11:09:07 +0200 Subject: [PATCH 496/518] ThreadEscape: Check for uniquness of thread. If the current thread is non-unqiue and may escape the variable queried with (MayEscape v), then v may be escaped. --- src/analyses/threadEscape.ml | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index f7335dde54..85d4df754a 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -73,16 +73,31 @@ struct else begin let possibly_started current = function | `Lifted tid -> - let not_started = MHP.definitely_not_started (current, ctx.ask Queries.CreatedThreads) tid in + let threads = ctx.ask Queries.CreatedThreads in + let not_started = MHP.definitely_not_started (current, threads) tid in + M.tracel "threadescape" "tid: %a, not_started: %b\n" ThreadIdDomain.FlagConfiguredTID.pretty tid not_started; let possibly_started = not not_started in possibly_started - | `Top + | `Top -> true + | `Bot -> false + in + let equal_current_not_unique current = function + | `Lifted tid -> + ThreadId.Thread.equal current tid && not (ThreadId.Thread.is_unique current) + | `Top -> true | `Bot -> false in match ctx.ask Queries.CurrentThreadId with | `Lifted current -> let possibly_started = ThreadIdSet.exists (possibly_started current) threads in - possibly_started || D.mem v ctx.local + if possibly_started then + true + else if ThreadIdSet.exists (equal_current_not_unique current) threads then + (* Another instance of the non-unqiue current thread may have escaped the variable *) + true + else + (* Check whether current unique thread has escaped the variable *) + D.mem v ctx.local | `Top -> true | `Bot -> From 7d70907c5c10e9b24aa52997863422721985374e Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 14 Jun 2023 12:34:02 +0200 Subject: [PATCH 497/518] RelationAnalysis.threadenter: include reachable thread create args in rel. Reuse implementation of enter in threadenter to determine what to add to rel. --- src/analyses/apron/relationAnalysis.apron.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 7e03e7b98e..877ec7a55a 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -280,7 +280,7 @@ struct | None -> true | Some v -> any_local_reachable - let enter ctx r f args = + let make_callee_rel ctx f args = let fundec = Node.find_fundec ctx.node in let st = ctx.local in if M.tracing then M.tracel "combine" "relation enter f: %a\n" CilType.Varinfo.pretty f.svar; @@ -311,7 +311,12 @@ struct | _ -> false (* keep everything else (just added args, globals, global privs) *) ); if M.tracing then M.tracel "combine" "relation enter newd: %a\n" RD.pretty new_rel; - [st, {st with rel = new_rel}] + new_rel + + let enter ctx r f args = + let callee_rel = make_callee_rel ctx f args in + let callee_st = {ctx.local with rel = callee_rel} in + [ctx.local, callee_st] let body ctx f = let st = ctx.local in @@ -627,12 +632,7 @@ struct if not (ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ignore (Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st); let st' = Priv.threadenter (Analyses.ask_of_ctx ctx) ctx.global st in - let arg_vars = - fd.sformals - |> List.filter RD.Tracked.varinfo_tracked - |> List.map RV.arg - in - let new_rel = RD.add_vars st'.rel arg_vars in + let new_rel = make_callee_rel ctx fd args in [{st' with rel = new_rel}] | exception Not_found -> (* Unknown functions *) From 44d560e3b015522f3996504e6cd0b4f09eba7dc9 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 14 Jun 2023 12:39:57 +0200 Subject: [PATCH 498/518] ThreadEscape.threadenter: set local state (i.e., variables secaped in thread) to empty set. Previous solution that had a non-empty state was required only due to RelationAnalysis that did not pass reachable variables to the created thread in threadenter. --- src/analyses/threadEscape.ml | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 85d4df754a..feacee7981 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -140,13 +140,7 @@ struct let exitstate v = D.bot () let threadenter ctx lval f args = - match args with - | [ptc_arg] -> - let escaped = reachable (Analyses.ask_of_ctx ctx) ptc_arg in - let escaped = D.filter (fun v -> not v.vglob) escaped in - emit_escape_event ctx escaped; - [D.join ctx.local escaped] - | _ -> [ctx.local] + [D.bot ()] let threadspawn ctx lval f args fctx = D.join ctx.local @@ From fb9356377647338adc0f98fcfeac60124fafb631 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 14 Jun 2023 12:41:31 +0200 Subject: [PATCH 499/518] Remove debug output. --- src/analyses/threadEscape.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index feacee7981..9871d26a94 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -75,7 +75,6 @@ struct | `Lifted tid -> let threads = ctx.ask Queries.CreatedThreads in let not_started = MHP.definitely_not_started (current, threads) tid in - M.tracel "threadescape" "tid: %a, not_started: %b\n" ThreadIdDomain.FlagConfiguredTID.pretty tid not_started; let possibly_started = not not_started in possibly_started | `Top -> true From 4bdc294b30b250489804d5aca09963c2c51f0add Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 14 Jun 2023 15:25:09 +0300 Subject: [PATCH 500/518] Disable info messages in type-based access cram tests --- tests/regression/06-symbeq/16-type_rc.t | 44 ++-------------- tests/regression/06-symbeq/21-mult_accs_rc.t | 54 ++------------------ 2 files changed, 8 insertions(+), 90 deletions(-) diff --git a/tests/regression/06-symbeq/16-type_rc.t b/tests/regression/06-symbeq/16-type_rc.t index 6aa5bb552d..26337e9d1d 100644 --- a/tests/regression/06-symbeq/16-type_rc.t +++ b/tests/regression/06-symbeq/16-type_rc.t @@ -1,58 +1,22 @@ - $ goblint --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 16-type_rc.c +Disable info messages because race summary contains (safe) memory location count, which is different on Linux and OSX. + + $ goblint --disable warn.info --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 16-type_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:23:3-23:14) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (16-type_rc.c:23:3-23:14) - [Info][Unsound] Unknown address in {&s} has escaped. (16-type_rc.c:23:3-23:14) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (16-type_rc.c:23:3-23:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:24:3-24:16) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:25:3-25:16) [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:12:12-12:24) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:12:12-12:24) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (16-type_rc.c:12:12-12:24) - [Info][Unsound] Unknown address in {&tmp} has escaped. (16-type_rc.c:12:12-12:24) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (16-type_rc.c:12:12-12:24) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:13:3-13:15) - [Info][Unsound] Write to unknown address: privatization is unsound. (16-type_rc.c:13:3-13:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:28:3-28:9) - [Info][Unsound] Write to unknown address: privatization is unsound. (16-type_rc.c:28:3-28:9) - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 11 - dead: 0 - total lines: 11 [Warning][Race] Memory location (struct s).datum (race with conf. 100): write with [mhp:{tid=[main, t_fun@16-type_rc.c:27:3-27:37#top]}, thread:[main, t_fun@16-type_rc.c:27:3-27:37#top]] (conf. 100) (exp: & s->datum) (16-type_rc.c:13:3-13:15) write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - [Info][Race] Memory locations race summary: - safe: 14 - vulnerable: 0 - unsafe: 1 - total memory locations: 15 - $ goblint --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c + $ goblint --disable warn.info --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:23:3-23:14) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (16-type_rc.c:23:3-23:14) - [Info][Unsound] Unknown address in {&s} has escaped. (16-type_rc.c:23:3-23:14) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (16-type_rc.c:23:3-23:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:24:3-24:16) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:25:3-25:16) [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:12:12-12:24) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (16-type_rc.c:12:12-12:24) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (16-type_rc.c:12:12-12:24) - [Info][Unsound] Unknown address in {&tmp} has escaped. (16-type_rc.c:12:12-12:24) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (16-type_rc.c:12:12-12:24) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:13:3-13:15) - [Info][Unsound] Write to unknown address: privatization is unsound. (16-type_rc.c:13:3-13:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:28:3-28:9) - [Info][Unsound] Write to unknown address: privatization is unsound. (16-type_rc.c:28:3-28:9) - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 11 - dead: 0 - total lines: 11 [Success][Race] Memory location (struct s).datum (safe): write with [mhp:{tid=[main, t_fun@16-type_rc.c:27:3-27:37#top]}, thread:[main, t_fun@16-type_rc.c:27:3-27:37#top]] (conf. 100) (exp: & s->datum) (16-type_rc.c:13:3-13:15) - [Info][Race] Memory locations race summary: - safe: 1 - vulnerable: 0 - unsafe: 0 - total memory locations: 1 diff --git a/tests/regression/06-symbeq/21-mult_accs_rc.t b/tests/regression/06-symbeq/21-mult_accs_rc.t index 474da9c89f..afcad9b9f2 100644 --- a/tests/regression/06-symbeq/21-mult_accs_rc.t +++ b/tests/regression/06-symbeq/21-mult_accs_rc.t @@ -1,76 +1,30 @@ - $ goblint --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 21-mult_accs_rc.c +Disable info messages because race summary contains (safe) memory location count, which is different on Linux and OSX. + + $ goblint --disable warn.info --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 21-mult_accs_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:27:3-27:14) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:27:3-27:14) - [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:27:3-27:14) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:27:3-27:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:13:3-13:14) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:13:3-13:14) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:13:3-13:14) - [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:13:3-13:14) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:13:3-13:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:15:3-15:14) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:15:3-15:14) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:15:3-15:14) - [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:15:3-15:14) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:15:3-15:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:16:3-16:14) - [Info][Unsound] Write to unknown address: privatization is unsound. (21-mult_accs_rc.c:16:3-16:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:32) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:34:3-34:9) - [Info][Unsound] Write to unknown address: privatization is unsound. (21-mult_accs_rc.c:34:3-34:9) - [Info][Unsound] Unknown mutex unlocked, base privatization unsound (21-mult_accs_rc.c:35:3-35:26) [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 16 - dead: 0 - total lines: 16 [Warning][Race] Memory location (struct s).data (race with conf. 100): write with [mhp:{tid=[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}, thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - [Info][Race] Memory locations race summary: - safe: 14 - vulnerable: 0 - unsafe: 1 - total memory locations: 15 - $ goblint --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c + $ goblint --disable warn.info --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:27:3-27:14) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:27:3-27:14) - [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:27:3-27:14) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:27:3-27:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:13:3-13:14) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:13:3-13:14) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:13:3-13:14) - [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:13:3-13:14) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:13:3-13:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:15:3-15:14) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (21-mult_accs_rc.c:15:3-15:14) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (21-mult_accs_rc.c:15:3-15:14) - [Info][Unsound] Unknown address in {&s} has escaped. (21-mult_accs_rc.c:15:3-15:14) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (21-mult_accs_rc.c:15:3-15:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:16:3-16:14) - [Info][Unsound] Write to unknown address: privatization is unsound. (21-mult_accs_rc.c:16:3-16:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:32) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:34:3-34:9) - [Info][Unsound] Write to unknown address: privatization is unsound. (21-mult_accs_rc.c:34:3-34:9) - [Info][Unsound] Unknown mutex unlocked, base privatization unsound (21-mult_accs_rc.c:35:3-35:26) [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 16 - dead: 0 - total lines: 16 [Success][Race] Memory location (struct s).data (safe): write with [mhp:{tid=[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}, thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) - [Info][Race] Memory locations race summary: - safe: 1 - vulnerable: 0 - unsafe: 0 - total memory locations: 1 From 83e87e53e7a3ef06987c0230da1c3e92d1d225e4 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 14 Jun 2023 17:11:38 +0200 Subject: [PATCH 501/518] Revert "RelationAnalysis.threadenter: include reachable thread create args in rel." This reverts commit 7d70907c5c10e9b24aa52997863422721985374e. --- src/analyses/apron/relationAnalysis.apron.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 877ec7a55a..7e03e7b98e 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -280,7 +280,7 @@ struct | None -> true | Some v -> any_local_reachable - let make_callee_rel ctx f args = + let enter ctx r f args = let fundec = Node.find_fundec ctx.node in let st = ctx.local in if M.tracing then M.tracel "combine" "relation enter f: %a\n" CilType.Varinfo.pretty f.svar; @@ -311,12 +311,7 @@ struct | _ -> false (* keep everything else (just added args, globals, global privs) *) ); if M.tracing then M.tracel "combine" "relation enter newd: %a\n" RD.pretty new_rel; - new_rel - - let enter ctx r f args = - let callee_rel = make_callee_rel ctx f args in - let callee_st = {ctx.local with rel = callee_rel} in - [ctx.local, callee_st] + [st, {st with rel = new_rel}] let body ctx f = let st = ctx.local in @@ -632,7 +627,12 @@ struct if not (ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ignore (Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st); let st' = Priv.threadenter (Analyses.ask_of_ctx ctx) ctx.global st in - let new_rel = make_callee_rel ctx fd args in + let arg_vars = + fd.sformals + |> List.filter RD.Tracked.varinfo_tracked + |> List.map RV.arg + in + let new_rel = RD.add_vars st'.rel arg_vars in [{st' with rel = new_rel}] | exception Not_found -> (* Unknown functions *) From 6b6c00f812791e478623e3e6ac2df453401b81d8 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 14 Jun 2023 17:56:01 +0200 Subject: [PATCH 502/518] Fix apron threadenter for unreached fixedpoint for 63/16. --- src/analyses/apron/relationAnalysis.apron.ml | 28 +++++++++++++++----- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 7e03e7b98e..3908e24577 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -280,7 +280,7 @@ struct | None -> true | Some v -> any_local_reachable - let enter ctx r f args = + let make_callee_rel ~thread ctx f args = let fundec = Node.find_fundec ctx.node in let st = ctx.local in if M.tracing then M.tracel "combine" "relation enter f: %a\n" CilType.Varinfo.pretty f.svar; @@ -311,7 +311,11 @@ struct | _ -> false (* keep everything else (just added args, globals, global privs) *) ); if M.tracing then M.tracel "combine" "relation enter newd: %a\n" RD.pretty new_rel; - [st, {st with rel = new_rel}] + new_rel + + let enter ctx r f args = + let calle_rel = make_callee_rel ~thread:false ctx f args in + [ctx.local, {ctx.local with rel = calle_rel}] let body ctx f = let st = ctx.local in @@ -627,12 +631,22 @@ struct if not (ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ignore (Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st); let st' = Priv.threadenter (Analyses.ask_of_ctx ctx) ctx.global st in - let arg_vars = - fd.sformals - |> List.filter RD.Tracked.varinfo_tracked - |> List.map RV.arg + (* TODO: Deduplicate with enter *) + let arg_assigns = + GobList.combine_short fd.sformals args (* TODO: is it right to ignore missing formals/args? *) + |> List.filter (fun (x, _) -> RD.Tracked.varinfo_tracked x) + |> List.map (Tuple2.map1 RV.arg) in - let new_rel = RD.add_vars st'.rel arg_vars in + let reachable_from_args = List.fold (fun ls e -> Queries.LS.join ls (ctx.ask (ReachableFrom e))) (Queries.LS.empty ()) args in + let arg_vars = List.map fst arg_assigns in + let new_rel = RD.add_vars st.rel arg_vars in + let any_local_reachable = any_local_reachable fd reachable_from_args in + RD.remove_filter_with new_rel (fun var -> + match RV.find_metadata var with + | Some (Local _) when not (pass_to_callee fd any_local_reachable var) -> true (* remove caller locals provided they are unreachable *) + | Some (Arg _) when not (List.mem_cmp RD.Var.compare var arg_vars) -> true (* remove caller args, but keep just added args *) + | _ -> false (* keep everything else (just added args, globals, global privs) *) + ); [{st' with rel = new_rel}] | exception Not_found -> (* Unknown functions *) From 3d60727a3e07e76e4c308e5ef62fb1f5277471b1 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Wed, 14 Jun 2023 18:11:28 +0200 Subject: [PATCH 503/518] RelationAnalysis.threadenter: Deduplicate code with enter. --- src/analyses/apron/relationAnalysis.apron.ml | 37 +++++++------------- 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 3908e24577..4d8ad8a78e 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -283,9 +283,6 @@ struct let make_callee_rel ~thread ctx f args = let fundec = Node.find_fundec ctx.node in let st = ctx.local in - if M.tracing then M.tracel "combine" "relation enter f: %a\n" CilType.Varinfo.pretty f.svar; - if M.tracing then M.tracel "combine" "relation enter formals: %a\n" (d_list "," CilType.Varinfo.pretty) f.sformals; - if M.tracing then M.tracel "combine" "relation enter local: %a\n" D.pretty ctx.local; let arg_assigns = GobList.combine_short f.sformals args (* TODO: is it right to ignore missing formals/args? *) |> List.filter (fun (x, _) -> RD.Tracked.varinfo_tracked x) @@ -296,12 +293,17 @@ struct let new_rel = RD.add_vars st.rel arg_vars in (* RD.assign_exp_parallel_with new_rel arg_assigns; (* doesn't need to be parallel since exps aren't arg vars directly *) *) (* TODO: parallel version of assign_from_globals_wrapper? *) - let ask = Analyses.ask_of_ctx ctx in - let new_rel = List.fold_left (fun new_rel (var, e) -> - assign_from_globals_wrapper ask ctx.global {st with rel = new_rel} e (fun rel' e' -> - RD.assign_exp rel' var e' (no_overflow ask e) - ) - ) new_rel arg_assigns + let new_rel = + if thread then + (* TODO: Why does test 63/16 not reach fixpoint without copy here? *) + RD.copy new_rel + else + let ask = Analyses.ask_of_ctx ctx in + List.fold_left (fun new_rel (var, e) -> + assign_from_globals_wrapper ask ctx.global {st with rel = new_rel} e (fun rel' e' -> + RD.assign_exp rel' var e' (no_overflow ask e) + ) + ) new_rel arg_assigns in let any_local_reachable = any_local_reachable fundec reachable_from_args in RD.remove_filter_with new_rel (fun var -> @@ -631,22 +633,7 @@ struct if not (ThreadFlag.has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ignore (Priv.enter_multithreaded (Analyses.ask_of_ctx ctx) ctx.global ctx.sideg st); let st' = Priv.threadenter (Analyses.ask_of_ctx ctx) ctx.global st in - (* TODO: Deduplicate with enter *) - let arg_assigns = - GobList.combine_short fd.sformals args (* TODO: is it right to ignore missing formals/args? *) - |> List.filter (fun (x, _) -> RD.Tracked.varinfo_tracked x) - |> List.map (Tuple2.map1 RV.arg) - in - let reachable_from_args = List.fold (fun ls e -> Queries.LS.join ls (ctx.ask (ReachableFrom e))) (Queries.LS.empty ()) args in - let arg_vars = List.map fst arg_assigns in - let new_rel = RD.add_vars st.rel arg_vars in - let any_local_reachable = any_local_reachable fd reachable_from_args in - RD.remove_filter_with new_rel (fun var -> - match RV.find_metadata var with - | Some (Local _) when not (pass_to_callee fd any_local_reachable var) -> true (* remove caller locals provided they are unreachable *) - | Some (Arg _) when not (List.mem_cmp RD.Var.compare var arg_vars) -> true (* remove caller args, but keep just added args *) - | _ -> false (* keep everything else (just added args, globals, global privs) *) - ); + let new_rel = make_callee_rel ~thread:true ctx fd args in [{st' with rel = new_rel}] | exception Not_found -> (* Unknown functions *) From 1be5757c9c84e7896b0105cdddeee736c50b5518 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 15 Jun 2023 12:10:38 +0300 Subject: [PATCH 504/518] Document regression test annotations fully --- docs/developer-guide/testing.md | 40 +++++++++++++++++++++++++++++++-- 1 file changed, 38 insertions(+), 2 deletions(-) diff --git a/docs/developer-guide/testing.md b/docs/developer-guide/testing.md index e8dad33299..8aa19d3005 100644 --- a/docs/developer-guide/testing.md +++ b/docs/developer-guide/testing.md @@ -24,8 +24,44 @@ gobopt='--set ana.base.privatization write+lock' ./scripts/update_suite.rb ``` ### Writing -* Add parameters to a regression test in the first line: `// PARAM: --set warn.debug true` -* Annotate lines inside the regression test with comments: `arr[9] = 10; // WARN` +Regression tests use single-line comments (with `//`) as annotations. + +#### First line +A comment on the first line can contain the following: + +| Annotation | Comment | +| ---------- | ------- | +| `PARAM: `
(NB! space) | The following command line parameters are added to Goblint for this test. | +| `SKIP` | The test is skipped (except when run with `./scripts/update_suite.rb group`). | +| `NOMARSHAL` | Marshaling and unmarshaling of results is not tested on this program. | +| `TERM` | The expected Goblint result is that the program terminates. | +| `NONTERM`
or `NOTERM` | The expected Goblint result is that the program does not terminate. | + +#### End of line +Comments at the end of other lines indicate the behavior on that line: + +| Annotation | Expected Goblint result | Concrete semantics | Checks | +| ---------- | ----- | ------------- | --- | +| `SUCCESS`
or nothing | Assertion succeeds | Assertion always succeeds | Precision | +| `FAIL` | Assertion fails | Assertion always fails | Precision | +| `UNKNOWN!` | Assertion is unknown | Assertion may both
succeed or fail | Soundness | +| `UNKNOWN` | Assertion is unknown | — | Intended imprecision | +| `TODO`
or `SKIP` | Assertion is unknown
or succeeds | Assertion always succeeds | Precision improvement | +| `NORACE` | No race warning | No data race | Precision | +| `RACE!` | Race warning | Data race is possible | Soundness | +| `RACE` | Race warning | — | Intended imprecision | +| `NODEADLOCK` | No deadlock warning | No deadlock | Precision | +| `DEADLOCK` | Deadlock warning | Deadlock is possible | Soundness | +| `NOWARN` | No warning | — | Precision | +| `WARN` | Some warning | — | Soundness | + +#### Other +Other useful constructs are the following: + +| Code with annotation | Comment | +| -------------------- | ------- | +| `__goblint_check(1); // reachable` | Checks that the line is reachable according
to Goblint results (soundness). | +| `__goblint_check(0); // NOWARN (unreachable)` | Checks that the line is unreachable (precision). | ## Cram Tests [Cram-style tests](https://dune.readthedocs.io/en/stable/tests.html#cram-tests) are also used to verify that existing functionality hasn't been broken. From eb0e1c750bdc8c73b8aba4f7fdec8e6fd1ce6895 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 15 Jun 2023 12:26:04 +0300 Subject: [PATCH 505/518] Try to make cram test output deterministic Currently the order of messages may depend on varinfo IDs in hashtables or whatnot. Since these differ on Linux and OSX, so does the message order. --- src/framework/control.ml | 2 + src/util/messages.ml | 9 +++- src/util/options.schema.json | 6 +++ tests/regression/00-sanity/01-assert.t | 6 +-- .../00-sanity/36-strict-loop-dead.t | 2 +- tests/regression/04-mutex/01-simple_rc.t | 10 ++-- .../regression/04-mutex/49-type-invariants.t | 52 +++++++++---------- tests/regression/06-symbeq/16-type_rc.t | 16 +++--- tests/regression/06-symbeq/21-mult_accs_rc.t | 28 +++++----- 9 files changed, 73 insertions(+), 58 deletions(-) diff --git a/src/framework/control.ml b/src/framework/control.ml index 35cadfc12d..fb8a5a8ea1 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -767,6 +767,8 @@ struct Serialize.Cache.store_data () ); if get_bool "dbg.verbose" && get_string "result" <> "none" then print_endline ("Generating output: " ^ get_string "result"); + + Messages.finalize (); Timing.wrap "result output" (Result.output (lazy local_xml) gh make_global_fast_xml) file end diff --git a/src/util/messages.ml b/src/util/messages.ml index 8aa1f2678f..ddbcb12cd1 100644 --- a/src/util/messages.ml +++ b/src/util/messages.ml @@ -237,10 +237,17 @@ let print ?(ppf= !formatter) (m: Message.t) = let add m = if not (Table.mem m) then ( - print m; + if not (get_bool "warn.deterministic") then + print m; Table.add m ) +let finalize () = + if get_bool "warn.deterministic" then ( + !Table.messages_list + |> List.sort Message.compare + |> List.iter print + ) let current_context: ControlSpecC.t option ref = ref None diff --git a/src/util/options.schema.json b/src/util/options.schema.json index 5c0e27c586..60e2b6aba7 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -2117,6 +2117,12 @@ "description": "Races with confidence at least threshold are warnings, lower are infos.", "type": "integer", "default": 0 + }, + "deterministic": { + "title": "warn.deterministic", + "description": "Output messages in deterministic order. Useful for cram testing.", + "type": "boolean", + "default": false } }, "additionalProperties": false diff --git a/tests/regression/00-sanity/01-assert.t b/tests/regression/00-sanity/01-assert.t index 7205b70357..9142f805f9 100644 --- a/tests/regression/00-sanity/01-assert.t +++ b/tests/regression/00-sanity/01-assert.t @@ -1,7 +1,7 @@ - $ goblint 01-assert.c - [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) - [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + $ goblint --enable warn.deterministic 01-assert.c [Error][Assert] Assertion "fail" will fail. (01-assert.c:12:3-12:25) + [Warning][Assert] Assertion "unknown == 4" is unknown. (01-assert.c:11:3-11:33) + [Success][Assert] Assertion "success" will succeed (01-assert.c:10:3-10:28) [Warning][Deadcode] Function 'main' does not return [Warning][Deadcode] Function 'main' has dead code: on lines 13..14 (01-assert.c:13-14) diff --git a/tests/regression/00-sanity/36-strict-loop-dead.t b/tests/regression/00-sanity/36-strict-loop-dead.t index 5e2fed39bc..a985909480 100644 --- a/tests/regression/00-sanity/36-strict-loop-dead.t +++ b/tests/regression/00-sanity/36-strict-loop-dead.t @@ -1,4 +1,4 @@ - $ goblint 36-strict-loop-dead.c + $ goblint --enable warn.deterministic 36-strict-loop-dead.c [Warning][Deadcode] Function 'basic2' has dead code: on line 8 (36-strict-loop-dead.c:8-8) on line 11 (36-strict-loop-dead.c:11-11) diff --git a/tests/regression/04-mutex/01-simple_rc.t b/tests/regression/04-mutex/01-simple_rc.t index 00cf7ea684..78c79eb0d1 100644 --- a/tests/regression/04-mutex/01-simple_rc.t +++ b/tests/regression/04-mutex/01-simple_rc.t @@ -1,8 +1,4 @@ - $ goblint 01-simple_rc.c - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 12 - dead: 0 - total lines: 12 + $ goblint --enable warn.deterministic 01-simple_rc.c [Warning][Race] Memory location myglobal@01-simple_rc.c:4:5-4:13 (race with conf. 110): write with [mhp:{tid=[main, t_fun@01-simple_rc.c:17:3-17:40#top]}, lock:{mutex1}, thread:[main, t_fun@01-simple_rc.c:17:3-17:40#top]] (conf. 110) (exp: & myglobal) (01-simple_rc.c:10:3-10:22) write with [mhp:{tid=[main]; created={[main, t_fun@01-simple_rc.c:17:3-17:40#top]}}, lock:{mutex2}, thread:[main]] (conf. 110) (exp: & myglobal) (01-simple_rc.c:19:3-19:22) @@ -13,3 +9,7 @@ vulnerable: 0 unsafe: 1 total memory locations: 1 + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 12 + dead: 0 + total lines: 12 diff --git a/tests/regression/04-mutex/49-type-invariants.t b/tests/regression/04-mutex/49-type-invariants.t index 31d90e52e0..30f79e9e56 100644 --- a/tests/regression/04-mutex/49-type-invariants.t +++ b/tests/regression/04-mutex/49-type-invariants.t @@ -1,18 +1,5 @@ - $ goblint --enable ana.race.direct-arithmetic --enable allglobs 49-type-invariants.c - [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:22:3-22:21) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:22:3-22:21) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:22:3-22:21) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (49-type-invariants.c:22:3-22:21) - [Info][Unsound] Unknown address in {&tmp} has escaped. (49-type-invariants.c:22:3-22:21) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (49-type-invariants.c:22:3-22:21) + $ goblint --enable warn.deterministic --enable ana.race.direct-arithmetic --enable allglobs 49-type-invariants.c [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (49-type-invariants.c:22:3-22:21) - [Info][Unsound] Write to unknown address: privatization is unsound. (49-type-invariants.c:22:3-22:21) - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 7 - dead: 0 - total lines: 7 - [Success][Race] Memory location (struct S).field (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) [Warning][Race] Memory location s.field@49-type-invariants.c:9:10-9:11 (race with conf. 110): write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) read with [mhp:{tid=[main, t_fun@49-type-invariants.c:21:3-21:40#top]}, thread:[main, t_fun@49-type-invariants.c:21:3-21:40#top]] (conf. 110) (exp: & s.field) (49-type-invariants.c:12:3-12:23) @@ -21,22 +8,22 @@ vulnerable: 0 unsafe: 1 total memory locations: 2 - - $ goblint --disable ana.race.direct-arithmetic --enable allglobs 49-type-invariants.c - [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:22:3-22:21) - [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:22:3-22:21) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:22:3-22:21) - [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (49-type-invariants.c:22:3-22:21) - [Info][Unsound] Unknown address in {&tmp} has escaped. (49-type-invariants.c:22:3-22:21) - [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (49-type-invariants.c:22:3-22:21) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (49-type-invariants.c:22:3-22:21) - [Info][Unsound] Write to unknown address: privatization is unsound. (49-type-invariants.c:22:3-22:21) + [Success][Race] Memory location (struct S).field (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) [Info][Deadcode] Logical lines of code (LLoC) summary: live: 7 dead: 0 total lines: 7 - [Success][Race] Memory location (struct S).field (safe): - write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Unknown address in {&tmp} has escaped. (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Write to unknown address: privatization is unsound. (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (49-type-invariants.c:22:3-22:21) + [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:22:3-22:21) + + $ goblint --enable warn.deterministic --disable ana.race.direct-arithmetic --enable allglobs 49-type-invariants.c + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (49-type-invariants.c:22:3-22:21) [Warning][Race] Memory location s.field@49-type-invariants.c:9:10-9:11 (race with conf. 110): write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) read with [mhp:{tid=[main, t_fun@49-type-invariants.c:21:3-21:40#top]}, thread:[main, t_fun@49-type-invariants.c:21:3-21:40#top]] (conf. 110) (exp: & s.field) (49-type-invariants.c:12:3-12:23) @@ -45,3 +32,16 @@ vulnerable: 0 unsafe: 1 total memory locations: 2 + [Success][Race] Memory location (struct S).field (safe): + write with [mhp:{tid=[main]; created={[main, t_fun@49-type-invariants.c:21:3-21:40#top]}}, thread:[main]] (conf. 100) (exp: & tmp->field) (49-type-invariants.c:22:3-22:21) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 0 + total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (49-type-invariants.c:22:3-22:21) + [Info][Unsound] Write to unknown address: privatization is unsound. (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:22:3-22:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (49-type-invariants.c:22:3-22:21) + [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:22:3-22:21) diff --git a/tests/regression/06-symbeq/16-type_rc.t b/tests/regression/06-symbeq/16-type_rc.t index 26337e9d1d..78c293b7ef 100644 --- a/tests/regression/06-symbeq/16-type_rc.t +++ b/tests/regression/06-symbeq/16-type_rc.t @@ -1,22 +1,22 @@ Disable info messages because race summary contains (safe) memory location count, which is different on Linux and OSX. - $ goblint --disable warn.info --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 16-type_rc.c - [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) + $ goblint --enable warn.deterministic --disable warn.info --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 16-type_rc.c + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:13:3-13:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:24:3-24:16) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:25:3-25:16) - [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:12:12-12:24) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:13:3-13:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:28:3-28:9) [Warning][Race] Memory location (struct s).datum (race with conf. 100): write with [mhp:{tid=[main, t_fun@16-type_rc.c:27:3-27:37#top]}, thread:[main, t_fun@16-type_rc.c:27:3-27:37#top]] (conf. 100) (exp: & s->datum) (16-type_rc.c:13:3-13:15) write with [mhp:{tid=[main]; created={[main, t_fun@16-type_rc.c:27:3-27:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (16-type_rc.c:28:3-28:9) - - $ goblint --disable warn.info --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c + [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:12:12-12:24) [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) + + $ goblint --enable warn.deterministic --disable warn.info --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 16-type_rc.c + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:13:3-13:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:24:3-24:16) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:25:3-25:16) - [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:12:12-12:24) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:13:3-13:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (16-type_rc.c:28:3-28:9) [Success][Race] Memory location (struct s).datum (safe): write with [mhp:{tid=[main, t_fun@16-type_rc.c:27:3-27:37#top]}, thread:[main, t_fun@16-type_rc.c:27:3-27:37#top]] (conf. 100) (exp: & s->datum) (16-type_rc.c:13:3-13:15) + [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:12:12-12:24) + [Error][Imprecise][Unsound] Function definition missing for get_s (16-type_rc.c:23:3-23:14) diff --git a/tests/regression/06-symbeq/21-mult_accs_rc.t b/tests/regression/06-symbeq/21-mult_accs_rc.t index afcad9b9f2..7a4439141d 100644 --- a/tests/regression/06-symbeq/21-mult_accs_rc.t +++ b/tests/regression/06-symbeq/21-mult_accs_rc.t @@ -1,30 +1,30 @@ Disable info messages because race summary contains (safe) memory location count, which is different on Linux and OSX. - $ goblint --disable warn.info --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 21-mult_accs_rc.c - [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) - [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:13:3-13:14) + $ goblint --enable warn.deterministic --disable warn.info --enable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" 21-mult_accs_rc.c [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) - [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:15:3-15:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:16:3-16:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:32) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:34:3-34:9) - [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) [Warning][Race] Memory location (struct s).data (race with conf. 100): write with [mhp:{tid=[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}, thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) write with [symblock:{p-lock:*.mutex}, mhp:{tid=[main]; created={[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}}, thread:[main]] (conf. 100) (exp: & *d) (21-mult_accs_rc.c:34:3-34:9) - - $ goblint --disable warn.info --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c - [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) + [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:13:3-13:14) - [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:15:3-15:14) + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) + + $ goblint --enable warn.deterministic --disable warn.info --disable ana.race.direct-arithmetic --set ana.activated[+] "'var_eq'" --set ana.activated[+] "'symb_locks'" --enable allglobs 21-mult_accs_rc.c + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:14:3-14:32) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:16:3-16:14) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:17:3-17:32) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:28:3-28:16) + [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:29:3-29:15) [Warning][Behavior > Undefined > NullPointerDereference][CWE-476] May dereference NULL pointer (21-mult_accs_rc.c:34:3-34:9) - [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) [Success][Race] Memory location (struct s).data (safe): write with [mhp:{tid=[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]}, thread:[main, t_fun@21-mult_accs_rc.c:31:3-31:37#top]] (conf. 100) (exp: & s->data) (21-mult_accs_rc.c:16:3-16:14) + [Warning][Unknown] unlocking unknown mutex which may not be held (21-mult_accs_rc.c:35:3-35:26) + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:13:3-13:14) + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:15:3-15:14) + [Error][Imprecise][Unsound] Function definition missing for get_s (21-mult_accs_rc.c:27:3-27:14) From 29568d2b8e3c29442152a223d4f1e5086231f1c5 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 16 Jun 2023 10:52:53 +0300 Subject: [PATCH 506/518] Replace TERM annotations with explicit main end reachability checks --- docs/developer-guide/testing.md | 2 -- scripts/update_suite.rb | 12 ++---------- tests/regression/00-sanity/02-minimal.c | 2 +- tests/regression/00-sanity/03-no_succ.c | 2 +- tests/regression/00-sanity/05-inf_loop.c | 2 +- tests/regression/00-sanity/06-term1.c | 2 +- tests/regression/00-sanity/07-term2.c | 2 +- tests/regression/00-sanity/08-asm_nop.c | 2 +- tests/regression/00-sanity/10-loop_label.c | 2 +- tests/regression/03-practical/05-deslash.c | 2 +- tests/regression/03-practical/10-big_init.c | 3 ++- tests/regression/03-practical/16-union_index.c | 2 +- 12 files changed, 13 insertions(+), 22 deletions(-) diff --git a/docs/developer-guide/testing.md b/docs/developer-guide/testing.md index 8aa19d3005..d2891af53e 100644 --- a/docs/developer-guide/testing.md +++ b/docs/developer-guide/testing.md @@ -34,8 +34,6 @@ A comment on the first line can contain the following: | `PARAM: `
(NB! space) | The following command line parameters are added to Goblint for this test. | | `SKIP` | The test is skipped (except when run with `./scripts/update_suite.rb group`). | | `NOMARSHAL` | Marshaling and unmarshaling of results is not tested on this program. | -| `TERM` | The expected Goblint result is that the program terminates. | -| `NONTERM`
or `NOTERM` | The expected Goblint result is that the program does not terminate. | #### End of line Comments at the end of other lines indicate the behavior on that line: diff --git a/scripts/update_suite.rb b/scripts/update_suite.rb index e99068829e..aeac526987 100755 --- a/scripts/update_suite.rb +++ b/scripts/update_suite.rb @@ -139,10 +139,8 @@ def report end def collect_warnings - warnings[-1] = "term" lines = IO.readlines(warnfile, :encoding => "UTF-8") lines.each do |l| - if l =~ /Function 'main' does not return/ then warnings[-1] = "noterm" end if l =~ /vars = (\d*).*evals = (\d+)/ then @vars = $1 @evals = $2 @@ -150,7 +148,7 @@ def collect_warnings next unless l =~ /(.*)\(.*?\:(\d+)(?:\:\d+)?(?:-(?:\d+)(?:\:\d+)?)?\)/ obj,i = $1,$2.to_i - ranking = ["other", "warn", "race", "norace", "deadlock", "nodeadlock", "success", "fail", "unknown", "term", "noterm"] + ranking = ["other", "warn", "race", "norace", "deadlock", "nodeadlock", "success", "fail", "unknown"] thiswarn = case obj when /\(conf\. \d+\)/ then "race" when /Deadlock/ then "deadlock" @@ -195,7 +193,7 @@ def compare_warnings end } case type - when "deadlock", "race", "fail", "noterm", "unknown", "term", "warn" + when "deadlock", "race", "fail", "unknown", "warn" check.call warnings[idx] == type when "nowarn" check.call warnings[idx].nil? @@ -308,12 +306,6 @@ def parse_tests (lines) end end end - case lines[0] - when /NON?TERM/ - tests[-1] = "noterm" - when /TERM/ - tests[-1] = "term" - end Tests.new(self, tests, tests_line, todo) end diff --git a/tests/regression/00-sanity/02-minimal.c b/tests/regression/00-sanity/02-minimal.c index b1ec6b10fa..01a86918af 100644 --- a/tests/regression/00-sanity/02-minimal.c +++ b/tests/regression/00-sanity/02-minimal.c @@ -1,4 +1,4 @@ -// TERM. int main() { + __goblint_check(1); // reachable, formerly TERM return 0; } diff --git a/tests/regression/00-sanity/03-no_succ.c b/tests/regression/00-sanity/03-no_succ.c index 33f35483fa..bda5eb8f47 100644 --- a/tests/regression/00-sanity/03-no_succ.c +++ b/tests/regression/00-sanity/03-no_succ.c @@ -1,5 +1,5 @@ -// TERM! int main() { + __goblint_check(1); // reachable, formerly TERM return 0; } diff --git a/tests/regression/00-sanity/05-inf_loop.c b/tests/regression/00-sanity/05-inf_loop.c index ba82fe2209..006844e3b6 100644 --- a/tests/regression/00-sanity/05-inf_loop.c +++ b/tests/regression/00-sanity/05-inf_loop.c @@ -1,6 +1,6 @@ -// NONTERM int main() { while (1); + __goblint_check(0); // NOWARN (unreachable), formerly NONTERM return 0; } diff --git a/tests/regression/00-sanity/06-term1.c b/tests/regression/00-sanity/06-term1.c index 1c57cb5abd..6ea19d58be 100644 --- a/tests/regression/00-sanity/06-term1.c +++ b/tests/regression/00-sanity/06-term1.c @@ -1,6 +1,6 @@ -// NONTERM int main() { int i; while (1); + __goblint_check(0); // NOWARN (unreachable), formerly NONTERM //return 0; // with this line it is okay) } diff --git a/tests/regression/00-sanity/07-term2.c b/tests/regression/00-sanity/07-term2.c index 9c26c07ad1..fdb8622e61 100644 --- a/tests/regression/00-sanity/07-term2.c +++ b/tests/regression/00-sanity/07-term2.c @@ -1,4 +1,3 @@ -// NONTERM #include void f() { @@ -7,5 +6,6 @@ void f() { int main() { while (1); + __goblint_check(0); // NOWARN (unreachable), formerly NONTERM return 0; } diff --git a/tests/regression/00-sanity/08-asm_nop.c b/tests/regression/00-sanity/08-asm_nop.c index 99780cea9a..e9d778fdb2 100644 --- a/tests/regression/00-sanity/08-asm_nop.c +++ b/tests/regression/00-sanity/08-asm_nop.c @@ -1,5 +1,5 @@ -// TERM. int main() { __asm__ ("nop"); + __goblint_check(1); // reachable, formerly TERM return (0); } diff --git a/tests/regression/00-sanity/10-loop_label.c b/tests/regression/00-sanity/10-loop_label.c index 8b76b3804d..dcdbbb08bc 100644 --- a/tests/regression/00-sanity/10-loop_label.c +++ b/tests/regression/00-sanity/10-loop_label.c @@ -1,7 +1,7 @@ -// NONTERM int main () { while (1) { while_1_continue: /* CIL label */ ; } + __goblint_check(0); // NOWARN (unreachable), formerly NONTERM return 0; } diff --git a/tests/regression/03-practical/05-deslash.c b/tests/regression/03-practical/05-deslash.c index d1767db4ab..844cc1b039 100644 --- a/tests/regression/03-practical/05-deslash.c +++ b/tests/regression/03-practical/05-deslash.c @@ -1,4 +1,3 @@ -// TERM. int deslash(unsigned char *str) { unsigned char *wp, *rp; @@ -70,6 +69,7 @@ int main() { char *x = "kala"; deslash(x); printf("%s",x); + __goblint_check(1); // reachable, formerly TERM return 0; } diff --git a/tests/regression/03-practical/10-big_init.c b/tests/regression/03-practical/10-big_init.c index 6c8cd29a55..0914420e4e 100644 --- a/tests/regression/03-practical/10-big_init.c +++ b/tests/regression/03-practical/10-big_init.c @@ -1,4 +1,4 @@ -// TERM. Well, just an example of slow initialization. +// Just an example of slow initialization. typedef unsigned char BYTE; BYTE Buffer[4096]; @@ -7,5 +7,6 @@ typedef TEXT TABLE[20]; TABLE MessageSystem[20]; int main() { + __goblint_check(1); // reachable, formerly TERM return 0; } diff --git a/tests/regression/03-practical/16-union_index.c b/tests/regression/03-practical/16-union_index.c index c39fd87466..de69c5bba3 100644 --- a/tests/regression/03-practical/16-union_index.c +++ b/tests/regression/03-practical/16-union_index.c @@ -1,4 +1,3 @@ -// TERM. typedef union { char c[4] ; // c needs to be at least as big as l long l ; @@ -7,5 +6,6 @@ typedef union { u uv; int main(){ + __goblint_check(1); // reachable, formerly TERM return 0; } From 5464235e9cc77156746da5f25d336f9d9dac0d1e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 16 Jun 2023 14:55:01 +0300 Subject: [PATCH 507/518] Fix typo and dead link in taint analysis tutorial --- src/analyses/tutorials/taint.ml | 2 +- tests/regression/99-tutorials/03-taint_simple.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/analyses/tutorials/taint.ml b/src/analyses/tutorials/taint.ml index 217125c8bd..3067449e31 100644 --- a/src/analyses/tutorials/taint.ml +++ b/src/analyses/tutorials/taint.ml @@ -1,8 +1,8 @@ (** Simple interprocedural taint analysis template ([taint]). *) (** An analysis specification for didactic purposes. *) -(* Helpful link on CIL: https://goblint.in.tum.de/assets/goblint-cil/ *) (* Goblint documentation: https://goblint.readthedocs.io/en/latest/ *) +(* Helpful link on CIL: https://goblint.github.io/cil/ *) (* You may test your analysis on our toy examples by running `ruby scripts/update_suite.rb group tutorials` *) (* after removing the `SKIP` from the beginning of the tests in tests/regression/99-tutorials/{03-taint_simple.c,04-taint_inter.c} *) diff --git a/tests/regression/99-tutorials/03-taint_simple.c b/tests/regression/99-tutorials/03-taint_simple.c index d9d00351c1..4cc206d949 100644 --- a/tests/regression/99-tutorials/03-taint_simple.c +++ b/tests/regression/99-tutorials/03-taint_simple.c @@ -31,7 +31,7 @@ int main(void) { // Trivial example showing how the analysis you just wrote benefits from other analyses - // If we wanted to write a real analysis, we would also aks other analyses questions, to e.g. handle pointers + // If we wanted to write a real analysis, we would also ask other analyses questions, to e.g. handle pointers int z; if(z == 0) { z = 5; From 761a970560723302661f5a715ea069211730f455 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 22 Jun 2023 00:37:21 +0200 Subject: [PATCH 508/518] Indentation Co-authored-by: Simmo Saan --- src/util/options.schema.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/util/options.schema.json b/src/util/options.schema.json index ae2a8509bb..f905ec0e1e 100644 --- a/src/util/options.schema.json +++ b/src/util/options.schema.json @@ -1003,7 +1003,7 @@ }, "additionalProperties": false } - }, + }, "additionalProperties": false }, "race": { From c8ed1b19a77e3fa191de3cd167277cb4607ddb42 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 21 Jun 2023 18:44:11 -0400 Subject: [PATCH 509/518] Clarify what D is --- src/analyses/threadId.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index bc5bb32288..4acf88a7ef 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -32,6 +32,7 @@ struct module N = Lattice.Flat (VNI) (struct let bot_name = "unknown node" let top_name = "unknown node" end) module TD = Thread.D + (** Uniqueness Counter * TID * (All thread creates of current thread * All thread creates of the current function and its callees) *) module D = Lattice.Prod3 (N) (ThreadLifted) (Lattice.Prod(TD)(TD)) module C = D module P = IdentityP (D) From 94b51d7da76b7dcb0422b8be2623a0a110bd1099 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 21 Jun 2023 18:49:24 -0400 Subject: [PATCH 510/518] Move tests to folder `40-` --- .../05-nc-simple.c} | 0 .../02-deep.c => 40-threadid/06-nc-deep.c} | 0 .../07-nc-createEdges.c} | 0 .../08-nc-fromThread.c} | 0 .../71-use_after_free/11-multithreaded.c | 30 +++++++++++++++++++ 5 files changed, 30 insertions(+) rename tests/regression/{74-threadCreate/01-simple.c => 40-threadid/05-nc-simple.c} (100%) rename tests/regression/{74-threadCreate/02-deep.c => 40-threadid/06-nc-deep.c} (100%) rename tests/regression/{74-threadCreate/03-createEdges.c => 40-threadid/07-nc-createEdges.c} (100%) rename tests/regression/{74-threadCreate/04-fromThread.c => 40-threadid/08-nc-fromThread.c} (100%) create mode 100644 tests/regression/71-use_after_free/11-multithreaded.c diff --git a/tests/regression/74-threadCreate/01-simple.c b/tests/regression/40-threadid/05-nc-simple.c similarity index 100% rename from tests/regression/74-threadCreate/01-simple.c rename to tests/regression/40-threadid/05-nc-simple.c diff --git a/tests/regression/74-threadCreate/02-deep.c b/tests/regression/40-threadid/06-nc-deep.c similarity index 100% rename from tests/regression/74-threadCreate/02-deep.c rename to tests/regression/40-threadid/06-nc-deep.c diff --git a/tests/regression/74-threadCreate/03-createEdges.c b/tests/regression/40-threadid/07-nc-createEdges.c similarity index 100% rename from tests/regression/74-threadCreate/03-createEdges.c rename to tests/regression/40-threadid/07-nc-createEdges.c diff --git a/tests/regression/74-threadCreate/04-fromThread.c b/tests/regression/40-threadid/08-nc-fromThread.c similarity index 100% rename from tests/regression/74-threadCreate/04-fromThread.c rename to tests/regression/40-threadid/08-nc-fromThread.c diff --git a/tests/regression/71-use_after_free/11-multithreaded.c b/tests/regression/71-use_after_free/11-multithreaded.c new file mode 100644 index 0000000000..3e00440f7a --- /dev/null +++ b/tests/regression/71-use_after_free/11-multithreaded.c @@ -0,0 +1,30 @@ +//PARAM: --set ana.activated[+] useAfterFree +#include +#include +#include + +int* gptr; + +// Mutex to ensure we don't get race warnings, but the UAF warnings we actually care about +pthread_mutex_t mtx = PTHREAD_MUTEX_INITIALIZER; + +void *t_other(void* p) { + pthread_mutex_lock(&mtx); + free(gptr); //WARN + pthread_mutex_unlock(&mtx); +} + +int main() { + gptr = malloc(sizeof(int)); + *gptr = 42; + + pthread_t thread; + pthread_create(&thread, NULL, t_other, NULL); + + pthread_mutex_lock(&mtx); + *gptr = 43; //WARN + free(gptr); //WARN + pthread_mutex_unlock(&mtx); + + return 0; +} From b8776b39d846048ec8210c5645ebff962e4d22b6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 22 Jun 2023 10:46:50 +0300 Subject: [PATCH 511/518] Document the Apron skipped tests hack --- docs/developer-guide/testing.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docs/developer-guide/testing.md b/docs/developer-guide/testing.md index d2891af53e..ca6e3e8d18 100644 --- a/docs/developer-guide/testing.md +++ b/docs/developer-guide/testing.md @@ -11,7 +11,8 @@ Regression tests can be run with various granularity: * Run all tests with: `./scripts/update_suite.rb`. * Run a group of tests with: `./scripts/update_suite.rb group sanity`. - Unfortunately this also runs skipped tests... + Unfortunately this also runs skipped tests. + This is bug is used as a feature in the tests with Apron, as not all CI jobs have the Apron library installed. * Run a single test with: `./scripts/update_suite.rb assert`. * Run a single test with full output: `./regtest.sh 00 01`. From 6ac8db2cd96131fbbc3d97eeb5c1d47112f08736 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 22 Jun 2023 12:59:25 +0300 Subject: [PATCH 512/518] Simplify access code Co-authored-by: Michael Schwarz --- src/analyses/raceAnalysis.ml | 3 +-- src/domains/access.ml | 4 ++-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index d83ecd5432..0ddd4a793a 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -68,10 +68,9 @@ struct | WarnGlobal g -> let g: V.t = Obj.obj g in begin match g with - | `Left g' -> (* accesses *) + | `Left memo -> (* accesses *) (* ignore (Pretty.printf "WarnGlobal %a\n" CilType.Varinfo.pretty g); *) let accs = G.access (ctx.global g) in - let memo = g' in let mem_loc_str = GobPretty.sprint Access.Memo.pretty memo in Timing.wrap ~args:[("memory location", `String mem_loc_str)] "race" (Access.warn_global safe vulnerable unsafe memo) accs | `Right _ -> (* vars *) diff --git a/src/domains/access.ml b/src/domains/access.ml index 574e912d34..5df81dd1df 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -434,7 +434,7 @@ let race_conf accs = let is_all_safe = ref true (* Commenting your code is for the WEAK! *) -let incr_summary safe vulnerable unsafe _ grouped_accs = +let incr_summary safe vulnerable unsafe grouped_accs = (* ignore(printf "Checking safety of %a:\n" d_memo (ty,lv)); *) let safety = grouped_accs @@ -483,5 +483,5 @@ let print_accesses memo grouped_accs = let warn_global safe vulnerable unsafe memo accs = let grouped_accs = group_may_race accs in (* do expensive component finding only once *) - incr_summary safe vulnerable unsafe memo grouped_accs; + incr_summary safe vulnerable unsafe grouped_accs; print_accesses memo grouped_accs From fec99ed451b8344850e5acc7a851400ed0f24dfa Mon Sep 17 00:00:00 2001 From: karoliineh Date: Thu, 22 Jun 2023 16:12:50 +0300 Subject: [PATCH 513/518] Fix wording of the Apron skipped tests hack in testing.md --- docs/developer-guide/testing.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/developer-guide/testing.md b/docs/developer-guide/testing.md index ca6e3e8d18..0854e4f33d 100644 --- a/docs/developer-guide/testing.md +++ b/docs/developer-guide/testing.md @@ -12,7 +12,7 @@ Regression tests can be run with various granularity: * Run a group of tests with: `./scripts/update_suite.rb group sanity`. Unfortunately this also runs skipped tests. - This is bug is used as a feature in the tests with Apron, as not all CI jobs have the Apron library installed. + This is a bug that is used as a feature in the tests with Apron, as not all CI jobs have the Apron library installed. * Run a single test with: `./scripts/update_suite.rb assert`. * Run a single test with full output: `./regtest.sh 00 01`. From a8c67225b724653b22c17e9449be6108a7e35d2c Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Mon, 26 Jun 2023 13:57:14 +0200 Subject: [PATCH 514/518] Extract check for thread-uniqueness out. --- src/analyses/threadEscape.ml | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index 9871d26a94..8a14f4102e 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -80,9 +80,9 @@ struct | `Top -> true | `Bot -> false in - let equal_current_not_unique current = function + let equal_current current = function | `Lifted tid -> - ThreadId.Thread.equal current tid && not (ThreadId.Thread.is_unique current) + ThreadId.Thread.equal current tid | `Top -> true | `Bot -> false in @@ -91,12 +91,15 @@ struct let possibly_started = ThreadIdSet.exists (possibly_started current) threads in if possibly_started then true - else if ThreadIdSet.exists (equal_current_not_unique current) threads then - (* Another instance of the non-unqiue current thread may have escaped the variable *) - true else - (* Check whether current unique thread has escaped the variable *) - D.mem v ctx.local + let current_is_unique = ThreadId.Thread.is_unique current in + let any_equal_current threads = ThreadIdSet.exists (equal_current current) threads in + if not current_is_unique && any_equal_current threads then + (* Another instance of the non-unqiue current thread may have escaped the variable *) + true + else + (* Check whether current unique thread has escaped the variable *) + D.mem v ctx.local | `Top -> true | `Bot -> From 491dfbd1b1f13fdd8cb5330bdb16c068a7de925b Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Mon, 26 Jun 2023 14:43:07 +0200 Subject: [PATCH 515/518] Move copy of relation to ensure that ctx.local.rel is not changed by following desctructive update. This ensures that new_rel is a disctinct object from ctx.local.rel to ensure that the latter is not modified by RD.remove_filter_with. --- src/analyses/apron/relationAnalysis.apron.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 4d8ad8a78e..ab659e00ce 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -295,8 +295,7 @@ struct (* TODO: parallel version of assign_from_globals_wrapper? *) let new_rel = if thread then - (* TODO: Why does test 63/16 not reach fixpoint without copy here? *) - RD.copy new_rel + new_rel else let ask = Analyses.ask_of_ctx ctx in List.fold_left (fun new_rel (var, e) -> @@ -306,6 +305,9 @@ struct ) new_rel arg_assigns in let any_local_reachable = any_local_reachable fundec reachable_from_args in + + (* Copy to ensure that ctx.local.rel is not changed *) + let new_rel = RD.copy new_rel in RD.remove_filter_with new_rel (fun var -> match RV.find_metadata var with | Some (Local _) when not (pass_to_callee fundec any_local_reachable var) -> true (* remove caller locals provided they are unreachable *) From 44233f6ecc1ccf0d7af402ad1bd52889982dce55 Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Mon, 26 Jun 2023 14:48:34 +0200 Subject: [PATCH 516/518] Move RD.copy up, so that copy is performed on possibly smaller rel. --- src/analyses/apron/relationAnalysis.apron.ml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index ab659e00ce..2b1165e3e0 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -290,7 +290,9 @@ struct in let reachable_from_args = List.fold (fun ls e -> Queries.LS.join ls (ctx.ask (ReachableFrom e))) (Queries.LS.empty ()) args in let arg_vars = List.map fst arg_assigns in - let new_rel = RD.add_vars st.rel arg_vars in + (* Copy to ensure that ctx.local.rel is not changed by remove_filter_with*) + let new_rel = RD.copy st.rel in + let new_rel = RD.add_vars new_rel arg_vars in (* RD.assign_exp_parallel_with new_rel arg_assigns; (* doesn't need to be parallel since exps aren't arg vars directly *) *) (* TODO: parallel version of assign_from_globals_wrapper? *) let new_rel = @@ -305,9 +307,6 @@ struct ) new_rel arg_assigns in let any_local_reachable = any_local_reachable fundec reachable_from_args in - - (* Copy to ensure that ctx.local.rel is not changed *) - let new_rel = RD.copy new_rel in RD.remove_filter_with new_rel (fun var -> match RV.find_metadata var with | Some (Local _) when not (pass_to_callee fundec any_local_reachable var) -> true (* remove caller locals provided they are unreachable *) From 525b20e386d82d2b0612fcb3cbc9d9c7624f2e09 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Thu, 29 Jun 2023 14:03:09 +0200 Subject: [PATCH 517/518] Rm accidentally committed file --- .../71-use_after_free/11-multithreaded.c | 30 ------------------- 1 file changed, 30 deletions(-) delete mode 100644 tests/regression/71-use_after_free/11-multithreaded.c diff --git a/tests/regression/71-use_after_free/11-multithreaded.c b/tests/regression/71-use_after_free/11-multithreaded.c deleted file mode 100644 index 3e00440f7a..0000000000 --- a/tests/regression/71-use_after_free/11-multithreaded.c +++ /dev/null @@ -1,30 +0,0 @@ -//PARAM: --set ana.activated[+] useAfterFree -#include -#include -#include - -int* gptr; - -// Mutex to ensure we don't get race warnings, but the UAF warnings we actually care about -pthread_mutex_t mtx = PTHREAD_MUTEX_INITIALIZER; - -void *t_other(void* p) { - pthread_mutex_lock(&mtx); - free(gptr); //WARN - pthread_mutex_unlock(&mtx); -} - -int main() { - gptr = malloc(sizeof(int)); - *gptr = 42; - - pthread_t thread; - pthread_create(&thread, NULL, t_other, NULL); - - pthread_mutex_lock(&mtx); - *gptr = 43; //WARN - free(gptr); //WARN - pthread_mutex_unlock(&mtx); - - return 0; -} From 90016e1acf0f7cae06bcee0baa5f6a6419c8028b Mon Sep 17 00:00:00 2001 From: Julian Erhard Date: Mon, 3 Jul 2023 13:05:25 +0200 Subject: [PATCH 518/518] AffineEqualityDomain: Perform explicit copy in add_vars, drop_vars, keep_vars, keep_filter. The operations on a relational domain (wihtout _with suffix) should ensure that the returned object is not physically equal. This way, the explicit copy in relationAnalysis.make_callee_rel can be avoided. --- src/analyses/apron/relationAnalysis.apron.ml | 4 +--- src/cdomains/apron/affineEqualityDomain.apron.ml | 4 ++++ 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 2b1165e3e0..8988a83c76 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -290,9 +290,7 @@ struct in let reachable_from_args = List.fold (fun ls e -> Queries.LS.join ls (ctx.ask (ReachableFrom e))) (Queries.LS.empty ()) args in let arg_vars = List.map fst arg_assigns in - (* Copy to ensure that ctx.local.rel is not changed by remove_filter_with*) - let new_rel = RD.copy st.rel in - let new_rel = RD.add_vars new_rel arg_vars in + let new_rel = RD.add_vars st.rel arg_vars in (* RD.assign_exp_parallel_with new_rel arg_assigns; (* doesn't need to be parallel since exps aren't arg vars directly *) *) (* TODO: parallel version of assign_from_globals_wrapper? *) let new_rel = diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 6c24a46c6e..a6f00fdba0 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -79,12 +79,14 @@ struct let change_d t new_env add del = timing_wrap "dimension change" (change_d t new_env add) del let add_vars t vars = + let t = copy t in let env' = add_vars t.env vars in change_d t env' true false let add_vars t vars = timing_wrap "add_vars" (add_vars t) vars let drop_vars t vars del = + let t = copy t in let env' = remove_vars t.env vars in change_d t env' false del @@ -111,12 +113,14 @@ struct t.env <- t'.env let keep_filter t f = + let t = copy t in let env' = keep_filter t.env f in change_d t env' false false let keep_filter t f = timing_wrap "keep_filter" (keep_filter t) f let keep_vars t vs = + let t = copy t in let env' = keep_vars t.env vs in change_d t env' false false