From b38e7a98689a2b1b84efbe829c52e30ae64f18da Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 12:15:23 +0300 Subject: [PATCH 001/133] Add ppx_deriving_lattice using ppx_easy_deriving --- dune-project | 1 + goblint.opam | 2 + goblint.opam.locked | 22 ++++-- goblint.opam.template | 1 + src/dune | 2 +- src/ppx/lattice/dune | 8 ++ src/ppx/lattice/ppx_deriving_lattice.ml | 97 +++++++++++++++++++++++++ 7 files changed, 125 insertions(+), 8 deletions(-) create mode 100644 src/ppx/lattice/dune create mode 100644 src/ppx/lattice/ppx_deriving_lattice.ml diff --git a/dune-project b/dune-project index 2fbfb271fc..903148201e 100644 --- a/dune-project +++ b/dune-project @@ -32,6 +32,7 @@ ppx_deriving ppx_deriving_hash (ppx_deriving_yojson (>= 3.7.0)) + ppx_easy_deriving (ounit2 :with-test) (qcheck-ounit :with-test) (odoc :with-doc) diff --git a/goblint.opam b/goblint.opam index 678ad53d13..4eac826d63 100644 --- a/goblint.opam +++ b/goblint.opam @@ -29,6 +29,7 @@ depends: [ "ppx_deriving" "ppx_deriving_hash" "ppx_deriving_yojson" {>= "3.7.0"} + "ppx_easy_deriving" "ounit2" {with-test} "qcheck-ounit" {with-test} "odoc" {with-doc} @@ -76,6 +77,7 @@ dev-repo: "git+https://github.com/goblint/analyzer.git" available: os-distribution != "alpine" & arch != "arm64" pin-depends: [ [ "goblint-cil.2.0.1" "git+https://github.com/goblint/cil.git#4df989fe625d91ce07d94afe1d85b3b5c6cdd63e" ] + [ "ppx_easy_deriving.~dev" "git+https://github.com/sim642/ppx_easy_deriving.git#3d599fdfb231e4a1f9bad0e914068210901533a4" ] # 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 diff --git a/goblint.opam.locked b/goblint.opam.locked index acb49a7b14..7fb916100b 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -50,12 +50,14 @@ depends: [ "cpu" {= "2.0.0"} "csexp" {= "1.5.1"} "ctypes" {= "0.20.1"} - "dune" {= "3.6.1"} + "dune" {= "3.8.0"} "dune-build-info" {= "3.6.1"} "dune-configurator" {= "3.6.1"} "dune-private-libs" {= "3.6.1"} "dune-site" {= "3.6.1"} "dyn" {= "3.6.1"} + "either" {= "1.0.0"} + "fileutils" {= "0.6.4"} "fmt" {= "0.9.0"} "fpath" {= "0.7.3"} "goblint-cil" {= "2.0.1"} @@ -67,11 +69,11 @@ depends: [ "mlgmpidl" {= "1.2.14"} "num" {= "1.4"} "ocaml" {= "4.14.0"} - "ocaml-variants" {= "4.14.0+options"} "ocaml-compiler-libs" {= "v0.12.4"} "ocaml-config" {= "2"} "ocaml-option-flambda" {= "1"} "ocaml-syntax-shims" {= "1.0.0"} + "ocaml-variants" {= "4.14.0+options"} "ocamlbuild" {= "0.14.2"} "ocamlfind" {= "1.9.5"} "odoc" {= "2.2.0" & with-doc} @@ -83,7 +85,8 @@ depends: [ "ppx_deriving" {= "5.2.1"} "ppx_deriving_hash" {= "0.1.1"} "ppx_deriving_yojson" {= "3.7.0"} - "ppxlib" {= "0.28.0"} + "ppx_easy_deriving" {= "~dev"} + "ppxlib" {= "0.30.0"} "qcheck-core" {= "0.20"} "qcheck-ounit" {= "0.20" & with-test} "re" {= "1.10.4" & with-doc} @@ -127,16 +130,21 @@ conflicts: [ ] # TODO: manually reordered to avoid opam pin crash: https://github.com/ocaml/opam/issues/4936 pin-depends: [ - [ - "goblint-cil.2.0.1" - "git+https://github.com/goblint/cil.git#4df989fe625d91ce07d94afe1d85b3b5c6cdd63e" - ] [ "apron.v0.9.13" "git+https://github.com/antoinemine/apron.git#1a8e91062c0d7d1e80333d19d5a432332bbbaec8" ] + [ + "goblint-cil.2.0.1" + "git+https://github.com/goblint/cil.git#4df989fe625d91ce07d94afe1d85b3b5c6cdd63e" + ] [ "ppx_deriving.5.2.1" "git+https://github.com/ocaml-ppx/ppx_deriving.git#0a89b619f94cbbfc3b0fb3255ab4fe5bc77d32d6" ] + [ + "ppx_easy_deriving.~dev" + "git+ssh://git@github.com/sim642/ppx_easy_deriving.git#master" +] ] + diff --git a/goblint.opam.template b/goblint.opam.template index b7f5a7abff..72855dd72e 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -3,6 +3,7 @@ available: os-distribution != "alpine" & arch != "arm64" pin-depends: [ [ "goblint-cil.2.0.1" "git+https://github.com/goblint/cil.git#4df989fe625d91ce07d94afe1d85b3b5c6cdd63e" ] + [ "ppx_easy_deriving.~dev" "git+https://github.com/sim642/ppx_easy_deriving.git#3d599fdfb231e4a1f9bad0e914068210901533a4" ] # 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 diff --git a/src/dune b/src/dune index 85944375ea..1ab30920e1 100644 --- a/src/dune +++ b/src/dune @@ -59,7 +59,7 @@ (foreign_stubs (language c) (names stubs)) (ocamlopt_flags :standard -no-float-const-prop) (preprocess - (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson ppx_blob)) + (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson ppx_blob ppx_deriving_lattice)) (preprocessor_deps (file util/options.schema.json)) (instrumentation (backend bisect_ppx)) ) diff --git a/src/ppx/lattice/dune b/src/ppx/lattice/dune new file mode 100644 index 0000000000..4c057c6fab --- /dev/null +++ b/src/ppx/lattice/dune @@ -0,0 +1,8 @@ +(include_subdirs no) + +(library + (name ppx_deriving_lattice) + (kind ppx_deriver) + (libraries ppxlib ppx_easy_deriving) + (ppx_runtime_libraries ppx_easy_deriving.runtime) + (preprocess (pps ppxlib.metaquot))) diff --git a/src/ppx/lattice/ppx_deriving_lattice.ml b/src/ppx/lattice/ppx_deriving_lattice.ml new file mode 100644 index 0000000000..e78e88644a --- /dev/null +++ b/src/ppx/lattice/ppx_deriving_lattice.ml @@ -0,0 +1,97 @@ +open Ppxlib +open Ppx_easy_deriving + +module LeqArg: Product.Reduce.Conjunctive.S = +struct + let name = "leq" +end + +module LeqDeriver = Deriver.Make (Product.Reduce2.Make (Product.Reduce.Conjunctive.Make (LeqArg))) +let leq_deriving = LeqDeriver.register () + + +module JoinArg: Product.Map2.S = +struct + let name = "join" +end + +module JoinDeriver = Deriver.Make (Product.Map2.Make (JoinArg)) +let join_deriving = JoinDeriver.register () + + +module MeetArg: Product.Map2.S = +struct + let name = "meet" +end + +module MeetDeriver = Deriver.Make (Product.Map2.Make (MeetArg)) +let meet_deriving = MeetDeriver.register () + + +module WidenArg: Product.Map2.S = +struct + let name = "widen" +end + +module WidenDeriver = Deriver.Make (Product.Map2.Make (WidenArg)) +let widen_deriving = WidenDeriver.register () + + +module NarrowArg: Product.Map2.S = +struct + let name = "narrow" +end + +module NarrowDeriver = Deriver.Make (Product.Map2.Make (NarrowArg)) +let narrow_deriving = NarrowDeriver.register () + + +module BotArg: Product.Create.S = +struct + let name = "bot" + let typ ~loc _ = [%type: unit] +end + +module BotDeriver = Deriver.Make (Product.Create.Make (BotArg)) +let bot_deriving = BotDeriver.register () + + +module IsBotArg: Product.Reduce.Conjunctive.S = +struct + let name = "is_bot" +end + +module IsBotDeriver = Deriver.Make (Product.Reduce1.Make (Product.Reduce.Conjunctive.Make (IsBotArg))) +let is_bot_deriving = IsBotDeriver.register () + + +module TopArg: Product.Create.S = +struct + let name = "top" + let typ ~loc _ = [%type: unit] +end + +module TopDeriver = Deriver.Make (Product.Create.Make (TopArg)) +let top_deriving = TopDeriver.register () + + +module IsTopArg: Product.Reduce.Conjunctive.S = +struct + let name = "is_top" +end + +module IsTopDeriver = Deriver.Make (Product.Reduce1.Make (Product.Reduce.Conjunctive.Make (IsTopArg))) +let is_top_deriving = IsTopDeriver.register () + + +let _ = Ppxlib.Deriving.add_alias "lattice" [ + leq_deriving; + join_deriving; + meet_deriving; + widen_deriving; + narrow_deriving; + bot_deriving; + is_bot_deriving; + top_deriving; + is_top_deriving; + ] From a4ef64ec4a44058c6f46131ac9e5f266124d6780 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 12 May 2021 11:44:48 +0300 Subject: [PATCH 002/133] Use lattice deriver for Lattice.ProdConf --- src/domains/lattice.ml | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index 4cdaa8fb9f..0147939413 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -409,27 +409,17 @@ end module ProdConf (C: Printable.ProdConfiguration) (Base1: S) (Base2: S) = struct - include Printable.ProdConf (C) (Base1) (Base2) - - let bot () = (Base1.bot (), Base2.bot ()) - let is_bot (x1,x2) = Base1.is_bot x1 && Base2.is_bot x2 - let top () = (Base1.top (), Base2.top ()) - let is_top (x1,x2) = Base1.is_top x1 && Base2.is_top x2 - - let leq (x1,x2) (y1,y2) = Base1.leq x1 y1 && Base2.leq x2 y2 + open struct (* open to avoid leaking P and causing conflicts *) + module P = Printable.ProdConf (C) (Base1) (Base2) + end + type t = Base1.t * Base2.t [@@deriving lattice] + include (P: module type of P with type t := t) let pretty_diff () ((x1,x2:t),(y1,y2:t)): Pretty.doc = if Base1.leq x1 y1 then Base2.pretty_diff () (x2,y2) else Base1.pretty_diff () (x1,y1) - - let op_scheme op1 op2 (x1,x2) (y1,y2): t = (op1 x1 y1, op2 x2 y2) - let join = op_scheme Base1.join Base2.join - let meet = op_scheme Base1.meet Base2.meet - let narrow = op_scheme Base1.narrow Base2.narrow - let widen = op_scheme Base1.widen Base2.widen - end From 35fe676dd6af8424ecca1a0f25181ac71adf8400 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 12 May 2021 11:46:10 +0300 Subject: [PATCH 003/133] Use lattice deriver for Lattice.Prod3 --- src/domains/lattice.ml | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index 0147939413..2ed13ad385 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -428,14 +428,11 @@ module ProdSimple = ProdConf (struct let expand_fst = false let expand_snd = fal module Prod3 (Base1: S) (Base2: S) (Base3: S) = struct - include Printable.Prod3 (Base1) (Base2) (Base3) - - let bot () = (Base1.bot (), Base2.bot (), Base3.bot ()) - let is_bot (x1,x2,x3) = Base1.is_bot x1 && Base2.is_bot x2 && Base3.is_bot x3 - let top () = (Base1.top (), Base2.top (), Base3.top ()) - let is_top (x1,x2,x3) = Base1.is_top x1 && Base2.is_top x2 && Base3.is_top x3 - - let leq (x1,x2,x3) (y1,y2,y3) = Base1.leq x1 y1 && Base2.leq x2 y2 && Base3.leq x3 y3 + open struct (* open to avoid leaking P and causing conflicts *) + module P = Printable.Prod3 (Base1) (Base2) (Base3) + end + type t = Base1.t * Base2.t * Base3.t [@@deriving lattice] + include (P: module type of P with type t := t) let pretty_diff () ((x1,x2,x3:t),(y1,y2,y3:t)): Pretty.doc = if not (Base1.leq x1 y1) then @@ -444,12 +441,6 @@ struct Base2.pretty_diff () (x2,y2) else Base3.pretty_diff () (x3,y3) - - let op_scheme op1 op2 op3 (x1,x2,x3) (y1,y2,y3): t = (op1 x1 y1, op2 x2 y2, op3 x3 y3) - let join = op_scheme Base1.join Base2.join Base3.join - let meet = op_scheme Base1.meet Base2.meet Base3.meet - let widen = op_scheme Base1.widen Base2.widen Base3.widen - let narrow = op_scheme Base1.narrow Base2.narrow Base3.narrow end module Prod4 (Base1: S) (Base2: S) (Base3: S) (Base4: S) = From 7989ea4d4a1bd8cf9bd721888cddba12b782bed0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 12:27:08 +0300 Subject: [PATCH 004/133] Remove unused Prod4 --- src/domains/lattice.ml | 27 --------------------------- src/domains/printable.ml | 29 ----------------------------- 2 files changed, 56 deletions(-) diff --git a/src/domains/lattice.ml b/src/domains/lattice.ml index 2ed13ad385..01cbf9b9cf 100644 --- a/src/domains/lattice.ml +++ b/src/domains/lattice.ml @@ -443,33 +443,6 @@ struct Base3.pretty_diff () (x3,y3) 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 59d22957b4..495d294e6e 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -430,35 +430,6 @@ 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] From a7d42a44cc0cc3843a74a3b789889641b95a7e2b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 12:35:55 +0300 Subject: [PATCH 005/133] Use lattice deriver for BaseDomain.BaseComponents --- src/cdomains/baseDomain.ml | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml index 6950c16889..e3a775020f 100644 --- a/src/cdomains/baseDomain.ml +++ b/src/cdomains/baseDomain.ml @@ -45,7 +45,7 @@ type 'a basecomponents_t = { deps: PartDeps.t; weak: WeakUpdates.t; priv: 'a; -} [@@deriving eq, ord, hash] +} [@@deriving eq, ord, hash, lattice] module BaseComponents (PrivD: Lattice.S): @@ -54,7 +54,7 @@ sig val op_scheme: (CPA.t -> CPA.t -> CPA.t) -> (PartDeps.t -> PartDeps.t -> PartDeps.t) -> (WeakUpdates.t -> WeakUpdates.t -> WeakUpdates.t) -> (PrivD.t -> PrivD.t -> PrivD.t) -> t -> t -> t end = struct - type t = PrivD.t basecomponents_t [@@deriving eq, ord, hash] + type t = PrivD.t basecomponents_t [@@deriving eq, ord, hash, lattice] include Printable.Std open Pretty @@ -97,14 +97,6 @@ struct let tr = QCheck.quad (CPA.arbitrary ()) (PartDeps.arbitrary ()) (WeakUpdates.arbitrary ()) (PrivD.arbitrary ()) in QCheck.map ~rev:to_tuple of_tuple tr - let bot () = { cpa = CPA.bot (); deps = PartDeps.bot (); weak = WeakUpdates.bot (); priv = PrivD.bot ()} - let is_bot {cpa; deps; weak; priv} = CPA.is_bot cpa && PartDeps.is_bot deps && WeakUpdates.is_bot weak && PrivD.is_bot priv - let top () = {cpa = CPA.top (); deps = PartDeps.top (); weak = WeakUpdates.top () ; priv = PrivD.bot ()} - let is_top {cpa; deps; weak; priv} = CPA.is_top cpa && PartDeps.is_top deps && WeakUpdates.is_top weak && PrivD.is_top priv - - let leq {cpa=x1; deps=x2; weak=x3; priv=x4 } {cpa=y1; deps=y2; weak=y3; priv=y4} = - CPA.leq x1 y1 && PartDeps.leq x2 y2 && WeakUpdates.leq x3 y3 && PrivD.leq x4 y4 - let pretty_diff () (({cpa=x1; deps=x2; weak=x3; priv=x4}:t),({cpa=y1; deps=y2; weak=y3; priv=y4}:t)): Pretty.doc = if not (CPA.leq x1 y1) then CPA.pretty_diff () (x1,y1) @@ -117,10 +109,6 @@ struct let op_scheme op1 op2 op3 op4 {cpa=x1; deps=x2; weak=x3; priv=x4} {cpa=y1; deps=y2; weak=y3; priv=y4}: t = {cpa = op1 x1 y1; deps = op2 x2 y2; weak = op3 x3 y3; priv = op4 x4 y4 } - let join = op_scheme CPA.join PartDeps.join WeakUpdates.join PrivD.join - let meet = op_scheme CPA.meet PartDeps.meet WeakUpdates.meet PrivD.meet - let widen = op_scheme CPA.widen PartDeps.widen WeakUpdates.widen PrivD.widen - let narrow = op_scheme CPA.narrow PartDeps.narrow WeakUpdates.narrow PrivD.narrow let relift {cpa; deps; weak; priv} = {cpa = CPA.relift cpa; deps = PartDeps.relift deps; weak = WeakUpdates.relift weak; priv = PrivD.relift priv} From 9a34f8c3a6e353053cdac5edfc7b35a978ea43f0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 12:37:45 +0300 Subject: [PATCH 006/133] Use lattice deriver for RelationDomain.RelComponents --- src/cdomains/apron/relationDomain.apron.ml | 19 ++----------------- 1 file changed, 2 insertions(+), 17 deletions(-) diff --git a/src/cdomains/apron/relationDomain.apron.ml b/src/cdomains/apron/relationDomain.apron.ml index c5b6a0a89b..c8942c2c6b 100644 --- a/src/cdomains/apron/relationDomain.apron.ml +++ b/src/cdomains/apron/relationDomain.apron.ml @@ -151,7 +151,7 @@ end type ('a, 'b) relcomponents_t = { rel: 'a; priv: 'b; -} [@@deriving eq, ord, hash, to_yojson] +} [@@deriving eq, ord, hash, to_yojson, lattice] module RelComponents (D3: S3) (PrivD: Lattice.S): sig @@ -160,7 +160,7 @@ sig end = struct module RD = D3 - type t = (RD.t, PrivD.t) relcomponents_t [@@deriving eq, ord, hash, to_yojson] + type t = (RD.t, PrivD.t) relcomponents_t [@@deriving eq, ord, hash, to_yojson, lattice] include Printable.Std open Pretty @@ -191,26 +191,11 @@ struct let tr = QCheck.pair (RD.arbitrary ()) (PrivD.arbitrary ()) in QCheck.map ~rev:to_tuple of_tuple tr - let bot () = {rel = RD.bot (); priv = PrivD.bot ()} - let is_bot {rel; priv} = RD.is_bot rel && PrivD.is_bot priv - let top () = {rel = RD.top (); priv = PrivD.bot ()} - let is_top {rel; priv} = RD.is_top rel && PrivD.is_top priv - - let leq {rel=x1; priv=x3 } {rel=y1; priv=y3} = - RD.leq x1 y1 && PrivD.leq x3 y3 - let pretty_diff () (({rel=x1; priv=x3}:t),({rel=y1; priv=y3}:t)): Pretty.doc = if not (RD.leq x1 y1) then RD.pretty_diff () (x1,y1) else PrivD.pretty_diff () (x3,y3) - - let op_scheme op1 op3 {rel=x1; priv=x3} {rel=y1; priv=y3}: t = - {rel = op1 x1 y1; priv = op3 x3 y3 } - let join = op_scheme RD.join PrivD.join - let meet = op_scheme RD.meet PrivD.meet - let widen = op_scheme RD.widen PrivD.widen - let narrow = op_scheme RD.narrow PrivD.narrow end From b0c207f141bc5336754ee1a479a7d7a2520cd7b3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 12:39:42 +0300 Subject: [PATCH 007/133] Use lattice deriver for PthreadDomain.D --- src/cdomains/pthreadDomain.ml | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/src/cdomains/pthreadDomain.ml b/src/cdomains/pthreadDomain.ml index 8cef57bdbd..145da447f6 100644 --- a/src/cdomains/pthreadDomain.ml +++ b/src/cdomains/pthreadDomain.ml @@ -25,8 +25,7 @@ end module D = struct include Printable.StdLeaf - type domain = { tid : Tid.t; pred : Pred.t; ctx : Ctx.t } [@@deriving to_yojson] - type t = domain + type t = { tid : Tid.t; pred : Pred.t; ctx : Ctx.t } [@@deriving to_yojson, lattice] (** printing *) let show x = @@ -36,7 +35,7 @@ module D = struct (Pred.show x.pred) (Ctx.show x.ctx) - include Printable.SimpleShow(struct type t = domain let show = show end) + include Printable.SimpleShow(struct type nonrec t = t let show = show end) let name () = "pthread state" @@ -59,22 +58,11 @@ module D = struct (** let hash = Hashtbl.hash *) let hash x = Hashtbl.hash (Tid.hash x.tid, Pred.hash x.pred, Ctx.hash x.ctx) let make tid pred ctx = { tid; pred; ctx } - let bot () = { tid = Tid.bot (); pred = Pred.bot (); ctx = Ctx.bot () } - let is_bot x = Tid.is_bot x.tid && Pred.is_bot x.pred && Ctx.is_bot x.ctx let any_is_bot x = Tid.is_bot x.tid || Pred.is_bot x.pred - let top () = { tid = Tid.top (); pred = Pred.top (); ctx = Ctx.top () } - let is_top x = Tid.is_top x.tid && Pred.is_top x.pred && Ctx.is_top x.ctx - - let leq x y = Tid.leq x.tid y.tid && Pred.leq x.pred y.pred && Ctx.leq x.ctx y.ctx let op_scheme op1 op2 op3 x y : t = { tid = op1 x.tid y.tid; pred = op2 x.pred y.pred; ctx = op3 x.ctx y.ctx } - let join = op_scheme Tid.join Pred.join Ctx.join - let widen = join - let meet = op_scheme Tid.meet Pred.meet Ctx.meet - let narrow = meet - let pretty_diff () (x,y) = if not (Tid.leq x.tid y.tid) then Tid.pretty_diff () (x.tid,y.tid) From a96262ef23ac2c8a7611327eb27ee65377fcfd5a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 12:41:00 +0300 Subject: [PATCH 008/133] Use more derivers for PthreadDomain.D --- src/cdomains/pthreadDomain.ml | 28 +++++----------------------- 1 file changed, 5 insertions(+), 23 deletions(-) diff --git a/src/cdomains/pthreadDomain.ml b/src/cdomains/pthreadDomain.ml index 145da447f6..7bed37a267 100644 --- a/src/cdomains/pthreadDomain.ml +++ b/src/cdomains/pthreadDomain.ml @@ -25,7 +25,7 @@ end module D = struct include Printable.StdLeaf - type t = { tid : Tid.t; pred : Pred.t; ctx : Ctx.t } [@@deriving to_yojson, lattice] + type t = { tid : Tid.t; pred : Pred.t; ctx : Ctx.t } [@@deriving eq, ord, hash, to_yojson, lattice] (** printing *) let show x = @@ -35,34 +35,16 @@ module D = struct (Pred.show x.pred) (Ctx.show x.ctx) - include Printable.SimpleShow(struct type nonrec t = t let show = show end) + include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) let name () = "pthread state" - (** let equal = Util.equals *) - let equal x y = - Tid.equal x.tid y.tid && Pred.equal x.pred y.pred && Ctx.equal x.ctx y.ctx - - - (** compare all fields with correspoding compare operators *) - let compare x y = - List.fold_left - (fun acc v -> if acc = 0 && v <> 0 then v else acc) - 0 - [ Tid.compare x.tid y.tid - ; Pred.compare x.pred y.pred - ; Ctx.compare x.ctx y.ctx - ] - - - (** let hash = Hashtbl.hash *) - let hash x = Hashtbl.hash (Tid.hash x.tid, Pred.hash x.pred, Ctx.hash x.ctx) let make tid pred ctx = { tid; pred; ctx } let any_is_bot x = Tid.is_bot x.tid || Pred.is_bot x.pred - let op_scheme op1 op2 op3 x y : t = - { tid = op1 x.tid y.tid; pred = op2 x.pred y.pred; ctx = op3 x.ctx y.ctx } - let pretty_diff () (x,y) = if not (Tid.leq x.tid y.tid) then Tid.pretty_diff () (x.tid,y.tid) From 17aa06c5e80e75d869d0b74797534c16060f6d61 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 12:46:24 +0300 Subject: [PATCH 009/133] Derive hash for IntDomain and FloatDomain --- src/cdomains/floatDomain.ml | 6 +----- src/cdomains/intDomain.ml | 3 +-- 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/src/cdomains/floatDomain.ml b/src/cdomains/floatDomain.ml index 4eb024adf9..23e967ca65 100644 --- a/src/cdomains/floatDomain.ml +++ b/src/cdomains/floatDomain.ml @@ -939,7 +939,7 @@ module FloatDomTupleImpl = struct module F1 = FloatIntervalImplLifted open Batteries - type t = F1.t option [@@deriving to_yojson, eq, ord] + type t = F1.t option [@@deriving eq, ord, hash] let name () = "floatdomtuple" @@ -986,10 +986,6 @@ module FloatDomTupleImpl = struct Option.map_default identity "" (mapp { fp= (fun (type a) (module F : FloatDomain with type t = a) x -> F.name () ^ ":" ^ F.show x); } x) - let hash x = - Option.map_default identity 0 - (mapp { fp= (fun (type a) (module F : FloatDomain with type t = a) -> F.hash); } x) - let of_const fkind = create { fi= (fun (type a) (module F : FloatDomain with type t = a) -> F.of_const fkind); } diff --git a/src/cdomains/intDomain.ml b/src/cdomains/intDomain.ml index 589239810f..d70d5b8ac1 100644 --- a/src/cdomains/intDomain.ml +++ b/src/cdomains/intDomain.ml @@ -3313,7 +3313,7 @@ module IntDomTupleImpl = struct module I5 = IntervalSetFunctor (BI) type t = I1.t option * I2.t option * I3.t option * I4.t option * I5.t option - [@@deriving to_yojson, eq, ord] + [@@deriving eq, ord, hash] let name () = "intdomtuple" @@ -3623,7 +3623,6 @@ module IntDomTupleImpl = struct (* others *) let show = String.concat "; " % to_list % mapp { fp = fun (type a) (module I:SOverflow with type t = a) x -> I.name () ^ ":" ^ (I.show x) } let to_yojson = [%to_yojson: Yojson.Safe.t list] % to_list % mapp { fp = fun (type a) (module I:SOverflow with type t = a) x -> I.to_yojson x } - let hash = List.fold_left (lxor) 0 % to_list % mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.hash } (* `map/opt_map` are used by `project` *) let opt_map b f = From 5ed8049a1f308ff8d14675d0baeccc2eb30390df Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 13:20:47 +0300 Subject: [PATCH 010/133] Add ppx_deriving_printable using ppx_easy_deriving --- src/dune | 2 +- src/ppx/printable/dune | 8 ++++++++ src/ppx/printable/ppx_deriving_printable.ml | 15 +++++++++++++++ 3 files changed, 24 insertions(+), 1 deletion(-) create mode 100644 src/ppx/printable/dune create mode 100644 src/ppx/printable/ppx_deriving_printable.ml diff --git a/src/dune b/src/dune index 1ab30920e1..e7b4733abd 100644 --- a/src/dune +++ b/src/dune @@ -59,7 +59,7 @@ (foreign_stubs (language c) (names stubs)) (ocamlopt_flags :standard -no-float-const-prop) (preprocess - (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson ppx_blob ppx_deriving_lattice)) + (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson ppx_blob ppx_deriving_printable ppx_deriving_lattice)) (preprocessor_deps (file util/options.schema.json)) (instrumentation (backend bisect_ppx)) ) diff --git a/src/ppx/printable/dune b/src/ppx/printable/dune new file mode 100644 index 0000000000..2b620d2319 --- /dev/null +++ b/src/ppx/printable/dune @@ -0,0 +1,8 @@ +(include_subdirs no) + +(library + (name ppx_deriving_printable) + (kind ppx_deriver) + (libraries ppxlib ppx_easy_deriving) + (ppx_runtime_libraries ppx_easy_deriving.runtime) + (preprocess (pps ppxlib.metaquot))) diff --git a/src/ppx/printable/ppx_deriving_printable.ml b/src/ppx/printable/ppx_deriving_printable.ml new file mode 100644 index 0000000000..ad57b93e45 --- /dev/null +++ b/src/ppx/printable/ppx_deriving_printable.ml @@ -0,0 +1,15 @@ +open Ppx_easy_deriving + +module ReliftArg: Product.Map1.S = +struct + let name = "relift" +end + +module ReliftDeriver = Deriver.Make (Product.Map1.Make (ReliftArg)) +let relift_deriving = ReliftDeriver.register () + + +(* TODO: needs https://github.com/ocaml-ppx/ppxlib/pull/124 to include eq, ord, hash *) +(* let _ = Ppxlib.Deriving.add_alias "printable" [ + relift_deriving; + ] *) From 816a6f56f6c5302997d7bc0984c027b7cd126ece Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 13:21:24 +0300 Subject: [PATCH 011/133] Use relift deriver with lattice deriver --- src/cdomains/apron/relationDomain.apron.ml | 6 ++---- src/cdomains/baseDomain.ml | 7 ++----- src/cdomains/pthreadDomain.ml | 2 +- src/domains/printable.ml | 7 ++----- 4 files changed, 7 insertions(+), 15 deletions(-) diff --git a/src/cdomains/apron/relationDomain.apron.ml b/src/cdomains/apron/relationDomain.apron.ml index c8942c2c6b..fdaced26ca 100644 --- a/src/cdomains/apron/relationDomain.apron.ml +++ b/src/cdomains/apron/relationDomain.apron.ml @@ -151,7 +151,7 @@ end type ('a, 'b) relcomponents_t = { rel: 'a; priv: 'b; -} [@@deriving eq, ord, hash, to_yojson, lattice] +} [@@deriving eq, ord, hash, to_yojson, relift, lattice] module RelComponents (D3: S3) (PrivD: Lattice.S): sig @@ -160,13 +160,11 @@ sig end = struct module RD = D3 - type t = (RD.t, PrivD.t) relcomponents_t [@@deriving eq, ord, hash, to_yojson, lattice] + type t = (RD.t, PrivD.t) relcomponents_t [@@deriving eq, ord, hash, to_yojson, relift, lattice] include Printable.Std open Pretty - let relift {rel; priv} = {rel = RD.relift rel; priv = PrivD.relift priv} - let show r = let first = RD.show r.rel in let third = PrivD.show r.priv in diff --git a/src/cdomains/baseDomain.ml b/src/cdomains/baseDomain.ml index e3a775020f..1c1a3c6a66 100644 --- a/src/cdomains/baseDomain.ml +++ b/src/cdomains/baseDomain.ml @@ -45,7 +45,7 @@ type 'a basecomponents_t = { deps: PartDeps.t; weak: WeakUpdates.t; priv: 'a; -} [@@deriving eq, ord, hash, lattice] +} [@@deriving eq, ord, hash, relift, lattice] module BaseComponents (PrivD: Lattice.S): @@ -54,7 +54,7 @@ sig val op_scheme: (CPA.t -> CPA.t -> CPA.t) -> (PartDeps.t -> PartDeps.t -> PartDeps.t) -> (WeakUpdates.t -> WeakUpdates.t -> WeakUpdates.t) -> (PrivD.t -> PrivD.t -> PrivD.t) -> t -> t -> t end = struct - type t = PrivD.t basecomponents_t [@@deriving eq, ord, hash, lattice] + type t = PrivD.t basecomponents_t [@@deriving eq, ord, hash, relift, lattice] include Printable.Std open Pretty @@ -109,9 +109,6 @@ struct let op_scheme op1 op2 op3 op4 {cpa=x1; deps=x2; weak=x3; priv=x4} {cpa=y1; deps=y2; weak=y3; priv=y4}: t = {cpa = op1 x1 y1; deps = op2 x2 y2; weak = op3 x3 y3; priv = op4 x4 y4 } - - let relift {cpa; deps; weak; priv} = - {cpa = CPA.relift cpa; deps = PartDeps.relift deps; weak = WeakUpdates.relift weak; priv = PrivD.relift priv} end module type ExpEvaluator = diff --git a/src/cdomains/pthreadDomain.ml b/src/cdomains/pthreadDomain.ml index 7bed37a267..a26cd3dfa5 100644 --- a/src/cdomains/pthreadDomain.ml +++ b/src/cdomains/pthreadDomain.ml @@ -25,7 +25,7 @@ end module D = struct include Printable.StdLeaf - type t = { tid : Tid.t; pred : Pred.t; ctx : Ctx.t } [@@deriving eq, ord, hash, to_yojson, lattice] + type t = { tid : Tid.t; pred : Pred.t; ctx : Ctx.t } [@@deriving eq, ord, hash, relift, to_yojson, lattice] (** printing *) let show x = diff --git a/src/domains/printable.ml b/src/domains/printable.ml index 495d294e6e..625af0e0c7 100644 --- a/src/domains/printable.ml +++ b/src/domains/printable.ml @@ -356,7 +356,7 @@ module ProdConf (C: ProdConfiguration) (Base1: S) (Base2: S)= struct include C - type t = Base1.t * Base2.t [@@deriving eq, ord, hash] + type t = Base1.t * Base2.t [@@deriving eq, ord, hash, relift] include Std @@ -387,8 +387,6 @@ struct `Assoc [ (Base1.name (), Base1.to_yojson x); (Base2.name (), Base2.to_yojson y) ] let arbitrary () = QCheck.pair (Base1.arbitrary ()) (Base2.arbitrary ()) - - let relift (x,y) = (Base1.relift x, Base2.relift y) end module Prod = ProdConf (struct let expand_fst = true let expand_snd = true end) @@ -396,7 +394,7 @@ module ProdSimple = ProdConf (struct let expand_fst = false let expand_snd = fal module Prod3 (Base1: S) (Base2: S) (Base3: S) = struct - type t = Base1.t * Base2.t * Base3.t [@@deriving eq, ord, hash] + type t = Base1.t * Base2.t * Base3.t [@@deriving eq, ord, hash, relift] include Std let show (x,y,z) = @@ -426,7 +424,6 @@ struct let name () = Base1.name () ^ " * " ^ Base2.name () ^ " * " ^ Base3.name () - let relift (x,y,z) = (Base1.relift x, Base2.relift y, Base3.relift z) let arbitrary () = QCheck.triple (Base1.arbitrary ()) (Base2.arbitrary ()) (Base3.arbitrary ()) end From 2e2bcc3e2ec63695d67a559b578e71886385e66c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 28 Jun 2023 13:24:13 +0300 Subject: [PATCH 012/133] Use relift deriver more --- src/cdomains/mHP.ml | 5 +---- src/framework/analyses.ml | 3 +-- src/ppx/printable/ppx_deriving_printable.ml | 1 + 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/src/cdomains/mHP.ml b/src/cdomains/mHP.ml index 8037cfa21d..f0f2fc8c12 100644 --- a/src/cdomains/mHP.ml +++ b/src/cdomains/mHP.ml @@ -11,10 +11,7 @@ type t = { tid: ThreadIdDomain.ThreadLifted.t; created: ConcDomain.ThreadSet.t; must_joined: ConcDomain.ThreadSet.t; -} [@@deriving eq, ord, hash] - -let relift {tid; created; must_joined} = - {tid = ThreadIdDomain.ThreadLifted.relift tid; created = ConcDomain.ThreadSet.relift created; must_joined = ConcDomain.ThreadSet.relift must_joined} +} [@@deriving eq, ord, hash, relift] let current (ask:Queries.ask) = { diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 1a3a4ebeb1..a40a3b0bb5 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -32,8 +32,7 @@ end module Var = struct - type t = Node.t [@@deriving eq, ord, hash] - let relift = Node.relift + type t = Node.t [@@deriving eq, ord, hash, relift] let printXml f n = let l = Node.location n in diff --git a/src/ppx/printable/ppx_deriving_printable.ml b/src/ppx/printable/ppx_deriving_printable.ml index ad57b93e45..b8b80d6730 100644 --- a/src/ppx/printable/ppx_deriving_printable.ml +++ b/src/ppx/printable/ppx_deriving_printable.ml @@ -5,6 +5,7 @@ struct let name = "relift" end +(* TODO: Map1 should also do variants *) module ReliftDeriver = Deriver.Make (Product.Map1.Make (ReliftArg)) let relift_deriving = ReliftDeriver.register () From 9b4b255f29f887b5cffb38280e7ebf86ed7cdd4c Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 27 May 2024 17:45:58 +0200 Subject: [PATCH 013/133] Fix `mutex-meet` for malloc after thread creation --- src/analyses/apron/relationPriv.apron.ml | 9 +++++++-- tests/regression/46-apron2/89-malloc.c | 21 +++++++++++++++++++++ tests/regression/46-apron2/90-malloc2.c | 21 +++++++++++++++++++++ 3 files changed, 49 insertions(+), 2 deletions(-) create mode 100644 tests/regression/46-apron2/89-malloc.c create mode 100644 tests/regression/46-apron2/90-malloc2.c diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 61da6ddc42..046e1230d7 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -479,7 +479,7 @@ struct let get_mutex_inits' = keep_only_protected_globals ask m get_mutex_inits in RD.join get_m get_mutex_inits' - let get_mutex_global_g_with_mutex_inits ask getg g = + let get_mutex_global_g_with_mutex_inits (ask:Q.ask) getg g = let g_var = AV.global g in let get_mutex_global_g = if Param.handle_atomic then ( @@ -487,7 +487,12 @@ struct RD.keep_vars (getg (V.mutex atomic_mutex)) [g_var] ) else - getg (V.global g) + let r = getg (V.global g) in + if RD.is_bot r && (ask.f (Queries.IsAllocVar g)) then + (* malloc'ed blobs may not have a value here yet *) + RD.top () + else + r in let get_mutex_inits = getg V.mutex_inits in let get_mutex_inits' = RD.keep_vars get_mutex_inits [g_var] in diff --git a/tests/regression/46-apron2/89-malloc.c b/tests/regression/46-apron2/89-malloc.c new file mode 100644 index 0000000000..8780568748 --- /dev/null +++ b/tests/regression/46-apron2/89-malloc.c @@ -0,0 +1,21 @@ +// SKIP PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet --set ana.apron.domain interval --set sem.int.signed_overflow assume_none +// Checks that assinging to malloc'ed memory does not cause both branches to be dead +#include +#include +void nop(void* arg) { +} + +void main() { + pthread_t thread; + pthread_create(&thread, 0, &nop, 0); + + long *k = malloc(sizeof(long)); + *k = 5; + if (1) + ; + + __goblint_check(*k >= 5); // Reachable and true + + *k = *k+1; + __goblint_check(*k >= 5); // Reachable and true +} diff --git a/tests/regression/46-apron2/90-malloc2.c b/tests/regression/46-apron2/90-malloc2.c new file mode 100644 index 0000000000..36696956e7 --- /dev/null +++ b/tests/regression/46-apron2/90-malloc2.c @@ -0,0 +1,21 @@ +// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --set ana.relation.privatization mutex-meet-tid --set ana.apron.domain interval --set sem.int.signed_overflow assume_none +// Checks that assinging to malloc'ed memory does not cause both branches to be dead +#include +#include +void nop(void* arg) { +} + +void main() { + pthread_t thread; + pthread_create(&thread, 0, &nop, 0); + + long *k = malloc(sizeof(long)); + *k = 5; + if (1) + ; + + __goblint_check(*k >= 5); // Reachable and true + + *k = *k+1; + __goblint_check(*k >= 5); // Reachable and true +} From 896f236c98ba829aee25e5f02cb08d4bb2bba9b1 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 27 May 2024 17:55:00 +0200 Subject: [PATCH 014/133] Also fix atomic --- src/analyses/apron/relationPriv.apron.ml | 21 ++++++++++--------- tests/regression/46-apron2/91-malloc-atomic.c | 21 +++++++++++++++++++ 2 files changed, 32 insertions(+), 10 deletions(-) create mode 100644 tests/regression/46-apron2/91-malloc-atomic.c diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 046e1230d7..78a06dc227 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -482,17 +482,18 @@ struct let get_mutex_global_g_with_mutex_inits (ask:Q.ask) getg g = let g_var = AV.global g in let get_mutex_global_g = - if Param.handle_atomic then ( - (* Unprotected invariant is one big relation. *) - RD.keep_vars (getg (V.mutex atomic_mutex)) [g_var] - ) - else - let r = getg (V.global g) in - if RD.is_bot r && (ask.f (Queries.IsAllocVar g)) then - (* malloc'ed blobs may not have a value here yet *) - RD.top () + let r = + if Param.handle_atomic then + (* Unprotected invariant is one big relation. *) + RD.keep_vars (getg (V.mutex atomic_mutex)) [g_var] else - r + getg (V.global g) + in + if RD.is_bot r && (ask.f (Queries.IsAllocVar g)) then + (* malloc'ed blobs may not have a value here yet *) + RD.top () + else + r in let get_mutex_inits = getg V.mutex_inits in let get_mutex_inits' = RD.keep_vars get_mutex_inits [g_var] in diff --git a/tests/regression/46-apron2/91-malloc-atomic.c b/tests/regression/46-apron2/91-malloc-atomic.c new file mode 100644 index 0000000000..b2f057f6a4 --- /dev/null +++ b/tests/regression/46-apron2/91-malloc-atomic.c @@ -0,0 +1,21 @@ +// SKIP PARAM: --set ana.activated[+] apron --set ana.relation.privatization mutex-meet-atomic --set ana.apron.domain interval --set sem.int.signed_overflow assume_none +// Checks that assinging to malloc'ed memory does not cause both branches to be dead +#include +#include +void nop(void* arg) { +} + +void main() { + pthread_t thread; + pthread_create(&thread, 0, &nop, 0); + + long *k = malloc(sizeof(long)); + *k = 5; + if (1) + ; + + __goblint_check(*k >= 5); // Reachable and true + + *k = *k+1; + __goblint_check(*k >= 5); // Reachable and true +} From ab78123429e6805415a97a4ecd737008ff3a5411 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Tue, 28 May 2024 10:32:19 +0200 Subject: [PATCH 015/133] [skip ci] int_of_scalar now returning Q.t --- src/cdomains/apron/sharedFunctions.apron.ml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 827dc252fc..b287bb9bae 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -20,21 +20,21 @@ let int_of_scalar ?round (scalar: Scalar.t) = | None when Stdlib.Float.is_integer f -> Some f | None -> None in - Z.of_float f + Q.make (Z.of_float f) Z.one | Mpqf scalar -> (* octMPQ, boxMPQ, polkaMPQ *) let n = Mpqf.get_num scalar in let d = Mpqf.get_den scalar in - let+ z = + let+ (n,d) = if Mpzf.cmp_int d 1 = 0 then (* exact integer (denominator 1) *) - Some n + Some (n,Mpzf.of_int 1) else begin match round with - | Some `Floor -> Some (Mpzf.fdiv_q n d) (* floor division *) - | Some `Ceil -> Some (Mpzf.cdiv_q n d) (* ceiling division *) - | None -> None + | Some `Floor -> Some (Mpzf.fdiv_q n d, Mpzf.of_int 1) (* floor division *) + | Some `Ceil -> Some (Mpzf.cdiv_q n d, Mpzf.of_int 1) (* ceiling division *) + | None -> Some (n,d) end in - Z_mlgmpidl.z_of_mpzf z + Q.make (Z_mlgmpidl.z_of_mpzf n) (Z_mlgmpidl.z_of_mpzf d) | _ -> failwith ("int_of_scalar: unsupported: " ^ Scalar.to_string scalar) From a50dc813320c2714b6bb0414e62a9897cc140370 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 3 Jun 2024 11:38:52 +0300 Subject: [PATCH 016/133] Unpin ppx_deriving --- dune-project | 2 +- goblint.opam | 4 +--- goblint.opam.locked | 8 ++------ goblint.opam.template | 2 -- gobview | 2 +- 5 files changed, 5 insertions(+), 13 deletions(-) diff --git a/dune-project b/dune-project index 878abd3b4f..c5adaddf81 100644 --- a/dune-project +++ b/dune-project @@ -29,7 +29,7 @@ (zarith (>= 1.10)) (yojson (>= 2.0.0)) (qcheck-core (>= 0.19)) - ppx_deriving + (ppx_deriving (>= 6.0.2)) (ppx_deriving_hash (>= 0.1.2)) (ppx_deriving_yojson (>= 3.7.0)) (ounit2 :with-test) diff --git a/goblint.opam b/goblint.opam index 692625c965..0d8a561fa0 100644 --- a/goblint.opam +++ b/goblint.opam @@ -27,7 +27,7 @@ depends: [ "zarith" {>= "1.10"} "yojson" {>= "2.0.0"} "qcheck-core" {>= "0.19"} - "ppx_deriving" + "ppx_deriving" {>= "6.0.2"} "ppx_deriving_hash" {>= "0.1.2"} "ppx_deriving_yojson" {>= "3.7.0"} "ounit2" {with-test} @@ -79,8 +79,6 @@ available: os-distribution != "alpine" & arch != "arm64" pin-depends: [ # published goblint-cil 2.0.3 is currently up-to-date, so no pin needed [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] - # 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" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.locked b/goblint.opam.locked index f8de683948..d532457ced 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -81,10 +81,10 @@ depends: [ "ounit2" {= "2.2.6" & with-test} "pp" {= "1.1.2"} "ppx_derivers" {= "1.2.1"} - "ppx_deriving" {= "5.2.1"} + "ppx_deriving" {= "6.0.2"} "ppx_deriving_hash" {= "0.1.2"} "ppx_deriving_yojson" {= "3.7.0"} - "ppxlib" {= "0.28.0"} + "ppxlib" {= "0.32.1"} "qcheck-core" {= "0.20"} "qcheck-ounit" {= "0.20" & with-test} "re" {= "1.10.4" & with-doc} @@ -136,9 +136,5 @@ pin-depends: [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] - [ - "ppx_deriving.5.2.1" - "git+https://github.com/ocaml-ppx/ppx_deriving.git#0a89b619f94cbbfc3b0fb3255ab4fe5bc77d32d6" - ] ] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.template b/goblint.opam.template index 2d5ef10bc9..a730d5c064 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -4,8 +4,6 @@ available: os-distribution != "alpine" & arch != "arm64" pin-depends: [ # published goblint-cil 2.0.3 is currently up-to-date, so no pin needed [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] - # 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" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/gobview b/gobview index 72abbb576b..195c61cbae 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 72abbb576b8ffc8759dcfa31501738f6b561b05a +Subproject commit 195c61cbae86b8ffb8af4a21f2acd689665c1c0e From 682eb0c183c897a31c8862c95a05bbc416437eb9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 13:15:22 +0300 Subject: [PATCH 017/133] Refactor many privatizations to use LockDomain.MustLockset --- src/analyses/apron/relationPriv.apron.ml | 4 +- src/analyses/basePriv.ml | 102 +++++++++++------------ src/analyses/commonPriv.ml | 14 ++-- src/cdomains/lockDomain.ml | 16 ++++ 4 files changed, 75 insertions(+), 61 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 61da6ddc42..cada5ff888 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -579,7 +579,7 @@ struct let lock ask getg (st: relation_components_t) m = let atomic = Param.handle_atomic && LockDomain.Addr.equal m (atomic_mutex) in (* TODO: somehow actually unneeded here? *) - if not atomic && Locksets.(not (Lockset.mem m (current_lockset ask))) then ( + if not atomic && Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( let rel = st.rel in let get_m = get_m_with_mutex_inits ask getg m in (* Additionally filter get_m in case it contains variables it no longer protects. E.g. in 36/22. *) @@ -1089,7 +1089,7 @@ struct let lock ask getg (st: relation_components_t) m = let atomic = Param.handle_atomic && LockDomain.Addr.equal m (atomic_mutex) in - if not atomic && Locksets.(not (Lockset.mem m (current_lockset ask))) then ( + if not atomic && Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( let rel = st.rel in let _,lmust,l = st.priv in let lm = LLock.mutex m in diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index cecc838b9e..f874232176 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -281,7 +281,7 @@ struct cpa' *) let lock ask getg (st: BaseComponents (D).t) m = - if Locksets.(not (Lockset.mem m (current_lockset ask))) then ( + if Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( let get_m = get_m_with_mutex_inits ask getg m in (* Really we want is_unprotected, but pthread_cond_wait emits unlock-lock events, where our (necessary) original context still has the mutex, @@ -377,7 +377,7 @@ struct cpa' *) let lock (ask: Queries.ask) getg (st: BaseComponents (D).t) m = - if Locksets.(not (Lockset.mem m (current_lockset ask))) then ( + if Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( let get_m = get_m_with_mutex_inits ask getg m in (* Additionally filter get_m in case it contains variables it no longer protects. *) let is_in_Gm x _ = is_protected_by ask m x in @@ -523,7 +523,7 @@ struct {st with cpa = cpa'; priv = (W.add x w,LMust.add lm lmust,l')} let lock (ask: Queries.ask) getg (st: BaseComponents (D).t) m = - if Locksets.(not (Lockset.mem m (current_lockset ask))) then ( + if Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( let _,lmust,l = st.priv in let lm = LLock.mutex m in let get_m = get_m_with_mutex_inits (not (LMust.mem lm lmust)) ask getg m in @@ -847,12 +847,12 @@ struct module GWeak = struct - include MapDomain.MapBot (Lockset) (WeakRange) + include MapDomain.MapBot (MustLockset) (WeakRange) let name () = "weak" end module GSync = struct - include MapDomain.MapBot (Lockset) (SyncRange) + include MapDomain.MapBot (MustLockset) (SyncRange) let name () = "synchronized" end module G = @@ -908,10 +908,10 @@ struct let invariant_vars ask getg st = let module VS = Set.Make (CilType.Varinfo) in let s = current_lockset ask in - Lockset.fold (fun m acc -> + MustLockset.fold (fun m acc -> GSync.fold (fun s' cpa' acc -> SyncRange.fold_sync_vars VS.add cpa' acc - ) (G.sync (getg (V.mutex m))) acc + ) (G.sync (getg (V.mutex_mustlock m))) acc ) s VS.empty |> VS.elements end @@ -987,7 +987,7 @@ struct let read_global ask getg (st: BaseComponents (D).t) x = let s = current_lockset ask in GWeak.fold (fun s' tm acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then ThreadMap.fold (fun t' v acc -> VD.join v acc ) tm acc @@ -1007,7 +1007,7 @@ struct let lock ask getg (st: BaseComponents (D).t) m = let s = current_lockset ask in let cpa' = GSync.fold (fun s' cpa' acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then CPA.join cpa' acc else acc @@ -1016,13 +1016,13 @@ struct {st with cpa = cpa'} let unlock ask getg sideg (st: BaseComponents (D).t) m = - let s = Lockset.remove m (current_lockset ask) in + let s = MustLockset.remove_addr m (current_lockset ask) in let t = current_thread ask in let side_cpa = CPA.filter (fun x _ -> GWeak.fold (fun s' tm acc -> (* TODO: swap 2^M and T partitioning for lookup by t here first? *) let v = ThreadMap.find t tm in - (Lockset.mem m s' && not (VD.is_bot v)) || acc + (MustLockset.mem_addr m s' && not (VD.is_bot v)) || acc ) (G.weak (getg (V.global x))) false ) st.cpa in @@ -1048,7 +1048,7 @@ struct let read_global ask getg (st: BaseComponents (D).t) x = let s = current_lockset ask in GWeak.fold (fun s' v acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then VD.join v acc else acc @@ -1065,7 +1065,7 @@ struct let lock ask getg (st: BaseComponents (D).t) m = let s = current_lockset ask in let cpa' = GSync.fold (fun s' cpa' acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then CPA.join cpa' acc else acc @@ -1074,10 +1074,10 @@ struct {st with cpa = cpa'} let unlock ask getg sideg (st: BaseComponents (D).t) m = - let s = Lockset.remove m (current_lockset ask) in + let s = MustLockset.remove_addr m (current_lockset ask) in let side_cpa = CPA.filter (fun x _ -> GWeak.fold (fun s' v acc -> - (Lockset.mem m s' && not (VD.is_bot v)) || acc + (MustLockset.mem_addr m s' && not (VD.is_bot v)) || acc ) (G.weak (getg (V.global x))) false ) st.cpa in @@ -1119,7 +1119,7 @@ struct let read_global ask getg (st: BaseComponents (D).t) x = let s = current_lockset ask in GWeak.fold (fun s' v acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then VD.join v acc else acc @@ -1140,7 +1140,7 @@ struct let lock ask getg (st: BaseComponents (D).t) m = let s = current_lockset ask in let cpa' = GSync.fold (fun s' cpa' acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then CPA.join cpa' acc else acc @@ -1149,7 +1149,7 @@ struct {st with cpa = cpa'} let unlock ask getg sideg (st: BaseComponents (D).t) m = - let s = Lockset.remove m (current_lockset ask) in + let s = MustLockset.remove_addr m (current_lockset ask) in let is_in_W x _ = W.mem x st.priv in let side_cpa = CPA.filter is_in_W st.cpa in sideg (V.mutex m) (G.create_sync (GSync.singleton s side_cpa)); @@ -1169,7 +1169,7 @@ struct if Param.side_effect_global_init then ( CPA.fold (fun x v (st: BaseComponents (D).t) -> if is_global ask x then ( - sideg (V.global x) (G.create_weak (GWeak.singleton (Lockset.empty ()) v)); + sideg (V.global x) (G.create_weak (GWeak.singleton (MustLockset.empty ()) v)); {st with priv = W.add x st.priv} (* TODO: is this add necessary? *) ) else @@ -1222,7 +1222,7 @@ struct let startstate () = (DV.bot (), L.bot ()) - let lockset_init = Lockset.top () + let lockset_init = MustLockset.all () let distr_init getg x v = if get_bool "exp.priv-distr-init" then @@ -1241,7 +1241,7 @@ struct let syncs = UnwrappedG.sync (getg (V.mutex m)) in MinLocksets.fold (fun b acc -> GSync.fold (fun s' cpa' acc -> - if Lockset.disjoint b s' then + if MustLockset.disjoint b s' then let v = CPA.find x cpa' in VD.join v acc else @@ -1254,7 +1254,7 @@ struct in let weaks = UnwrappedG.weak (getg (V.global x)) in let d_weak = GWeak.fold (fun s' v acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then VD.join v acc else acc @@ -1301,7 +1301,7 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let sideg = Wrapper.sideg ask sideg in let getg = Wrapper.getg ask getg in - let s = Lockset.remove m (current_lockset ask) in + let s = MustLockset.remove_addr m (current_lockset ask) in let is_in_G x _ = is_global ask x in let side_cpa = CPA.filter is_in_G st.cpa in let side_cpa = CPA.mapi (fun x v -> @@ -1355,13 +1355,13 @@ struct module GWeakW = struct - include MapDomain.MapBot (Lockset) (VD) + include MapDomain.MapBot (MustLockset) (VD) let fold_weak f m a = fold (fun _ v a -> f v a) m a end module GSyncW = struct - include MapDomain.MapBot (Lockset) (LockCenteredBase.CPA) + include MapDomain.MapBot (MustLockset) (LockCenteredBase.CPA) let fold_sync_vars f m a = fold (fun _ cpa a -> @@ -1393,11 +1393,11 @@ struct let startstate () = (W.bot (), P.top ()) - let lockset_init = Lockset.top () + let lockset_init = MustLockset.all () let distr_init getg x v = if get_bool "exp.priv-distr-init" then - let v_init = GWeakW.find lockset_init (GWeak.find (Lockset.empty ()) (UnwrappedG.weak (getg (V.global x)))) in + let v_init = GWeakW.find lockset_init (GWeak.find (MustLockset.empty ()) (UnwrappedG.weak (getg (V.global x)))) in VD.join v v_init else v @@ -1408,13 +1408,13 @@ struct let (w, p) = st.priv in let p_x = P.find x p in let d_cpa = CPA.find x st.cpa in - let d_sync = Lockset.fold (fun m acc -> - if MinLocksets.exists (fun s''' -> not (Lockset.mem m s''')) p_x then - let syncs = UnwrappedG.sync (getg (V.mutex m)) in + let d_sync = MustLockset.fold (fun m acc -> + if MinLocksets.exists (fun s''' -> not (MustLockset.mem m s''')) p_x then + let syncs = UnwrappedG.sync (getg (V.mutex_mustlock m)) in GSync.fold (fun s' gsyncw' acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then GSyncW.fold (fun w' cpa' acc -> - if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then + if MinLocksets.exists (fun s'' -> MustLockset.disjoint s'' w') p_x then let v = CPA.find x cpa' in VD.join v acc else @@ -1429,9 +1429,9 @@ struct in let weaks = UnwrappedG.weak (getg (V.global x)) in let d_weak = GWeak.fold (fun s' gweakw' acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then GWeakW.fold (fun w' v acc -> - if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then + if MinLocksets.exists (fun s'' -> MustLockset.disjoint s'' w') p_x then VD.join v acc else acc @@ -1471,7 +1471,7 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let getg = Wrapper.getg ask getg in let sideg = Wrapper.sideg ask sideg in - let s = Lockset.remove m (current_lockset ask) in + let s = MustLockset.remove_addr m (current_lockset ask) in let (w, p) = st.priv in let p' = P.map (fun s' -> MinLocksets.add s s') p in if M.tracing then M.traceli "priv" "unlock %a %a" Lock.pretty m CPA.pretty st.cpa; @@ -1507,7 +1507,7 @@ struct if EscapeDomain.EscapedVars.mem x escaped then ( let (w, p) = st.priv in let p' = P.add x (MinLocksets.singleton s) p in - sideg (V.global x) (UnwrappedG.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton lockset_init v))); + sideg (V.global x) (UnwrappedG.create_weak (GWeak.singleton (MustLockset.empty ()) (GWeakW.singleton lockset_init v))); {st with cpa = CPA.remove x st.cpa; priv = (w, p')} ) else @@ -1518,7 +1518,7 @@ struct let sideg = Wrapper.sideg ask sideg in CPA.fold (fun x v (st: BaseComponents (D).t) -> if is_global ask x then ( - sideg (V.global x) (UnwrappedG.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton lockset_init v))); + sideg (V.global x) (UnwrappedG.create_weak (GWeak.singleton (MustLockset.empty ()) (GWeakW.singleton lockset_init v))); {st with cpa = CPA.remove x st.cpa} ) else @@ -1548,11 +1548,11 @@ struct let startstate () = ((W.bot (), P.top ()), (DV.bot (), L.bot ())) - let lockset_init = Lockset.top () + let lockset_init = MustLockset.all () let distr_init getg x v = if get_bool "exp.priv-distr-init" then - let v_init = GWeakW.find lockset_init (GWeak.find (Lockset.empty ()) (UnwrappedG.weak (getg (V.global x)))) in + let v_init = GWeakW.find lockset_init (GWeak.find (MustLockset.empty ()) (UnwrappedG.weak (getg (V.global x)))) in VD.join v v_init else v @@ -1568,9 +1568,9 @@ struct let syncs = UnwrappedG.sync (getg (V.mutex m)) in MinLocksets.fold (fun b acc -> GSync.fold (fun s' gsyncw' acc -> - if Lockset.disjoint b s' then + if MustLockset.disjoint b s' then GSyncW.fold (fun w' cpa' acc -> - if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then + if MinLocksets.exists (fun s'' -> MustLockset.disjoint s'' w') p_x then let v = CPA.find x cpa' in VD.join v acc else @@ -1586,9 +1586,9 @@ struct in let weaks = UnwrappedG.weak (getg (V.global x)) in let d_m_weak = GWeak.fold (fun s' gweakw' acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then GWeakW.fold (fun w' v acc -> - if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then + if MinLocksets.exists (fun s'' -> MustLockset.disjoint s'' w') p_x then VD.join v acc else acc @@ -1598,13 +1598,13 @@ struct ) weaks (VD.bot ()) in let d_m = VD.join d_m_sync d_m_weak in - let d_g_sync = Lockset.fold (fun m acc -> - if MinLocksets.exists (fun s''' -> not (Lockset.mem m s''')) p_x then - let syncs = UnwrappedG.sync (getg (V.mutex m)) in + let d_g_sync = MustLockset.fold (fun m acc -> + if MinLocksets.exists (fun s''' -> not (MustLockset.mem m s''')) p_x then + let syncs = UnwrappedG.sync (getg (V.mutex_mustlock m)) in GSync.fold (fun s' gsyncw' acc -> - if Lockset.disjoint s s' then + if MustLockset.disjoint s s' then GSyncW.fold (fun w' cpa' acc -> - if MinLocksets.exists (fun s'' -> Lockset.disjoint s'' w') p_x then + if MinLocksets.exists (fun s'' -> MustLockset.disjoint s'' w') p_x then let v = CPA.find x cpa' in VD.join v acc else @@ -1656,7 +1656,7 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let getg = Wrapper.getg ask getg in let sideg = Wrapper.sideg ask sideg in - let s = Lockset.remove m (current_lockset ask) in + let s = MustLockset.remove_addr m (current_lockset ask) in let ((w, p), vl) = st.priv in let p' = P.map (fun s' -> MinLocksets.add s s') p in let side_gsyncw = CPA.fold (fun x v acc -> @@ -1689,7 +1689,7 @@ struct if EscapeDomain.EscapedVars.mem x escaped then ( let ((w, p), (vv, l)) = st.priv in let p' = P.add x (MinLocksets.singleton s) p in - sideg (V.global x) (UnwrappedG.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton lockset_init v))); + sideg (V.global x) (UnwrappedG.create_weak (GWeak.singleton (MustLockset.empty ()) (GWeakW.singleton lockset_init v))); {st with cpa = CPA.remove x st.cpa; priv = ((w, p'), (vv, l))} ) else @@ -1700,7 +1700,7 @@ struct let sideg = Wrapper.sideg ask sideg in CPA.fold (fun x v (st: BaseComponents (D).t) -> if is_global ask x then ( - sideg (V.global x) (UnwrappedG.create_weak (GWeak.singleton (Lockset.empty ()) (GWeakW.singleton lockset_init v))); + sideg (V.global x) (UnwrappedG.create_weak (GWeak.singleton (MustLockset.empty ()) (GWeakW.singleton lockset_init v))); {st with cpa = CPA.remove x st.cpa} ) else diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index aa829c4606..2334d76918 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -106,6 +106,7 @@ struct include Printable.Either3Conf (struct include Printable.DefaultConf let expand2 = false end) (VMutex) (VMutexInits) (VGlobal) let name () = "MutexGlobals" let mutex x: t = `Left x + let mutex_mustlock x = mutex (Addr (LockDomain.MustLock.to_mval x)) let mutex_inits: t = `Middle () let global x: t = `Right x end @@ -136,17 +137,14 @@ struct let name () = "lock" end - module Lockset = SetDomain.ToppedSet (Lock) (struct let topname = "All locks" end) + module MustLockset = LockDomain.MustLockset - module MustLockset = SetDomain.Reverse (Lockset) - - let current_lockset (ask: Q.ask): Lockset.t = + let current_lockset (ask: Q.ask): MustLockset.t = (* TODO: remove this global_init workaround *) if !AnalysisState.global_initialization then - Lockset.empty () + MustLockset.empty () else - let mls = ask.f Queries.MustLockset in - LockDomain.MustLockset.fold (fun ml acc -> Lockset.add (Addr (LockDomain.MustLock.to_mval ml)) acc) mls (Lockset.empty ()) (* TODO: use MustLockset as Lockset *) + ask.f Queries.MustLockset (* TODO: reversed SetDomain.Hoare *) module MinLocksets = HoareDomain.Set_LiftTop (MustLockset) (struct let topname = "All locksets" end) (* reverse Lockset because Hoare keeps maximal, but we need minimal *) @@ -171,7 +169,7 @@ struct let name () = "P" (* TODO: change MinLocksets.exists/top instead? *) - let find x p = find_opt x p |? MinLocksets.singleton (Lockset.empty ()) (* ensure exists has something to check for thread returns *) + let find x p = find_opt x p |? MinLocksets.singleton (MustLockset.empty ()) (* ensure exists has something to check for thread returns *) end end diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 35d73e5f28..1c9fcb98c7 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -35,6 +35,22 @@ module MustLockset = struct include SetDomain.Reverse (SetDomain.ToppedSet (MustLock) (struct let topname = "All mutexes" end)) + let mem_addr (a: Addr.t) (set: t) = (* TODO: replace with mem_mval *) + match Addr.to_mval a with + | Some mv when Mval.is_definite mv -> + let ml = MustLock.of_mval mv in + mem ml set + | _ -> + false + + let remove_addr (a: Addr.t) (set: t) = (* TODO: replace with remove_mval *) + match Addr.to_mval a with + | Some mv when Mval.is_definite mv -> + let ml = MustLock.of_mval mv in + remove ml set + | _ -> + set + let all (): t = `Top let is_all (set: t) = set = `Top end From aeae2a97d2d475bba55ed2f0b8af94d497e7ab1c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 16:37:20 +0300 Subject: [PATCH 018/133] Refactor privatizations' lock and unlock mutex type to Mustlock --- src/analyses/apron/relationPriv.apron.ml | 28 +++++++------- src/analyses/basePriv.ml | 48 ++++++++++++------------ src/analyses/basePriv.mli | 4 +- src/analyses/commonPriv.ml | 18 ++++----- src/cdomains/lockDomain.ml | 2 + 5 files changed, 51 insertions(+), 49 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index cada5ff888..1302fa3743 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -33,8 +33,8 @@ module type S = the state when following conditional guards. *) val write_global: ?invariant:bool -> Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> varinfo -> varinfo -> relation_components_t - val lock: Q.ask -> (V.t -> G.t) -> relation_components_t -> LockDomain.Addr.t -> relation_components_t - val unlock: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> LockDomain.Addr.t -> relation_components_t + val lock: Q.ask -> (V.t -> G.t) -> relation_components_t -> LockDomain.MustLock.t -> relation_components_t + val unlock: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> LockDomain.MustLock.t -> relation_components_t val sync: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> relation_components_t -> [`Normal | `Join | `Return | `Init | `Thread] -> relation_components_t @@ -471,7 +471,7 @@ struct let startstate () = () - let atomic_mutex = LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var + let atomic_mutex = LockDomain.MustLock.of_var LibraryFunctions.verifier_atomic_var let get_m_with_mutex_inits ask getg m = let get_m = getg (V.mutex m) in @@ -577,9 +577,9 @@ struct let write_escape = write_global_internal ~skip_meet:true let lock ask getg (st: relation_components_t) m = - let atomic = Param.handle_atomic && LockDomain.Addr.equal m (atomic_mutex) in + let atomic = Param.handle_atomic && LockDomain.MustLock.equal m atomic_mutex in (* TODO: somehow actually unneeded here? *) - if not atomic && Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( + if not atomic && Locksets.(not (MustLockset.mem m (current_lockset ask))) then ( let rel = st.rel in let get_m = get_m_with_mutex_inits ask getg m in (* Additionally filter get_m in case it contains variables it no longer protects. E.g. in 36/22. *) @@ -592,7 +592,7 @@ struct st (* sound w.r.t. recursive lock *) let unlock ask getg sideg (st: relation_components_t) m: relation_components_t = - let atomic = Param.handle_atomic && LockDomain.Addr.equal m (atomic_mutex) in + let atomic = Param.handle_atomic && LockDomain.MustLock.equal m atomic_mutex in let rel = st.rel in if not atomic then ( let rel_side = keep_only_protected_globals ask m rel in @@ -703,7 +703,7 @@ module type ClusterArg = functor (RD: RelationDomain.RD) -> sig module LRD: Lattice.S - val keep_only_protected_globals: Q.ask -> LockDomain.Addr.t -> LRD.t -> LRD.t + val keep_only_protected_globals: Q.ask -> LockDomain.MustLock.t -> LRD.t -> LRD.t val keep_global: varinfo -> LRD.t -> LRD.t val lock: RD.t -> LRD.t -> LRD.t -> RD.t @@ -962,7 +962,7 @@ struct 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" LockDomain.Addr.pretty m LRD.pretty get_m; + if M.tracing then M.traceli "relationpriv" "get_m_with_mutex_inits %a\n get=%a" LockDomain.MustLock.pretty m LRD.pretty get_m; let r = if not inits then get_m @@ -975,7 +975,7 @@ struct if M.tracing then M.traceu "relationpriv" "-> %a" LRD.pretty r; r - let atomic_mutex = LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var + let atomic_mutex = LockDomain.MustLock.of_var LibraryFunctions.verifier_atomic_var let get_mutex_global_g_with_mutex_inits inits ask getg g = let get_mutex_global_g = @@ -1088,8 +1088,8 @@ struct {rel = rel_local; priv = (W.add g w,lmust,l)} (* Keep write local as if it were protected by the atomic section. *) let lock ask getg (st: relation_components_t) m = - let atomic = Param.handle_atomic && LockDomain.Addr.equal m (atomic_mutex) in - if not atomic && Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( + let atomic = Param.handle_atomic && LockDomain.MustLock.equal m atomic_mutex in + if not atomic && Locksets.(not (MustLockset.mem m (current_lockset ask))) then ( let rel = st.rel in let _,lmust,l = st.priv in let lm = LLock.mutex m in @@ -1112,7 +1112,7 @@ struct RD.keep_filter oct protected let unlock ask getg sideg (st: relation_components_t) m: relation_components_t = - let atomic = Param.handle_atomic && LockDomain.Addr.equal m (atomic_mutex) in + let atomic = Param.handle_atomic && LockDomain.MustLock.equal m atomic_mutex in let rel = st.rel in let w,lmust,l = st.priv in if not atomic then ( @@ -1290,7 +1290,7 @@ struct r let lock ask getg st m = - if M.tracing then M.traceli "relationpriv" "lock %a" LockDomain.Addr.pretty m; + if M.tracing then M.traceli "relationpriv" "lock %a" LockDomain.MustLock.pretty m; if M.tracing then M.trace "relationpriv" "st: %a" RelComponents.pretty st; let getg x = let r = getg x in @@ -1302,7 +1302,7 @@ struct r let unlock ask getg sideg st m = - if M.tracing then M.traceli "relationpriv" "unlock %a" LockDomain.Addr.pretty m; + if M.tracing then M.traceli "relationpriv" "unlock %a" LockDomain.MustLock.pretty m; if M.tracing then M.trace "relationpriv" "st: %a" RelComponents.pretty st; let getg x = let r = getg x in diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index f874232176..9dbffe40b1 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -28,8 +28,8 @@ sig * the state when following conditional guards. *) val write_global: ?invariant:bool -> Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> varinfo -> VD.t -> BaseComponents (D).t - val lock: Q.ask -> (V.t -> G.t) -> BaseComponents (D).t -> LockDomain.Addr.t -> BaseComponents (D).t - val unlock: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> LockDomain.Addr.t -> BaseComponents (D).t + val lock: Q.ask -> (V.t -> G.t) -> BaseComponents (D).t -> LockDomain.MustLock.t -> BaseComponents (D).t + val unlock: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> LockDomain.MustLock.t -> BaseComponents (D).t val sync: Q.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseComponents (D).t -> [`Normal | `Join | `Return | `Init | `Thread] -> BaseComponents (D).t @@ -191,7 +191,7 @@ struct let get_mutex_inits = getg V.mutex_inits in let is_in_Gm x _ = is_protected_by ask m x in let get_mutex_inits' = CPA.filter is_in_Gm get_mutex_inits in - if M.tracing then M.tracel "priv" "get_m_with_mutex_inits %a:\n get_m: %a\n get_mutex_inits: %a\n get_mutex_inits': %a" LockDomain.Addr.pretty m CPA.pretty get_m CPA.pretty get_mutex_inits CPA.pretty get_mutex_inits'; + if M.tracing then M.tracel "priv" "get_m_with_mutex_inits %a:\n get_m: %a\n get_mutex_inits: %a\n get_mutex_inits': %a" LockDomain.MustLock.pretty m CPA.pretty get_m CPA.pretty get_mutex_inits CPA.pretty get_mutex_inits'; CPA.join get_m get_mutex_inits' (** [get_m_with_mutex_inits] optimized for implementation-specialized [read_global]. *) @@ -281,7 +281,7 @@ struct cpa' *) let lock ask getg (st: BaseComponents (D).t) m = - if Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( + if Locksets.(not (MustLockset.mem m (current_lockset ask))) then ( let get_m = get_m_with_mutex_inits ask getg m in (* Really we want is_unprotected, but pthread_cond_wait emits unlock-lock events, where our (necessary) original context still has the mutex, @@ -292,7 +292,7 @@ struct No other privatization uses is_unprotected, so this hack is only needed here. *) let is_in_V x _ = is_protected_by ask m x && is_unprotected_without ask x m in let cpa' = CPA.filter is_in_V get_m in - if M.tracing then M.tracel "priv" "PerMutexOplusPriv.lock m=%a cpa'=%a" LockDomain.Addr.pretty m CPA.pretty cpa'; + if M.tracing then M.tracel "priv" "PerMutexOplusPriv.lock m=%a cpa'=%a" LockDomain.MustLock.pretty m CPA.pretty cpa'; {st with cpa = CPA.fold CPA.add cpa' st.cpa} ) else @@ -301,7 +301,7 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let is_in_Gm x _ = is_protected_by ask m x in let side_m_cpa = CPA.filter is_in_Gm st.cpa in - if M.tracing then M.tracel "priv" "PerMutexOplusPriv.unlock m=%a side_m_cpa=%a" LockDomain.Addr.pretty m CPA.pretty side_m_cpa; + if M.tracing then M.tracel "priv" "PerMutexOplusPriv.unlock m=%a side_m_cpa=%a" LockDomain.MustLock.pretty m CPA.pretty side_m_cpa; sideg (V.mutex m) side_m_cpa; st @@ -377,14 +377,14 @@ struct cpa' *) let lock (ask: Queries.ask) getg (st: BaseComponents (D).t) m = - if Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( + if Locksets.(not (MustLockset.mem m (current_lockset ask))) then ( let get_m = get_m_with_mutex_inits ask getg m in (* Additionally filter get_m in case it contains variables it no longer protects. *) let is_in_Gm x _ = is_protected_by ask m x in let get_m = CPA.filter is_in_Gm get_m in let long_meet m1 m2 = CPA.long_map2 VD.meet m1 m2 in let meet = long_meet st.cpa get_m in - if M.tracing then M.tracel "priv" "LOCK %a:\n get_m: %a\n meet: %a" LockDomain.Addr.pretty m CPA.pretty get_m CPA.pretty meet; + if M.tracing then M.tracel "priv" "LOCK %a:\n get_m: %a\n meet: %a" LockDomain.MustLock.pretty m CPA.pretty get_m CPA.pretty meet; {st with cpa = meet} ) else @@ -523,7 +523,7 @@ struct {st with cpa = cpa'; priv = (W.add x w,LMust.add lm lmust,l')} let lock (ask: Queries.ask) getg (st: BaseComponents (D).t) m = - if Locksets.(not (MustLockset.mem_addr m (current_lockset ask))) then ( + if Locksets.(not (MustLockset.mem m (current_lockset ask))) then ( let _,lmust,l = st.priv in let lm = LLock.mutex m in let get_m = get_m_with_mutex_inits (not (LMust.mem lm lmust)) ask getg m in @@ -750,7 +750,7 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let sideg = Wrapper.sideg ask sideg in - let atomic = Param.handle_atomic && LockDomain.Addr.equal m (LockDomain.Addr.of_var LibraryFunctions.verifier_atomic_var) in + let atomic = Param.handle_atomic && LockDomain.MustLock.equal m (LockDomain.MustLock.of_var LibraryFunctions.verifier_atomic_var) in (* TODO: what about G_m globals in cpa that weren't actually written? *) CPA.fold (fun x v (st: BaseComponents (D).t) -> if is_protected_by ask m x then ( (* is_in_Gm *) @@ -1016,13 +1016,13 @@ struct {st with cpa = cpa'} let unlock ask getg sideg (st: BaseComponents (D).t) m = - let s = MustLockset.remove_addr m (current_lockset ask) in + let s = MustLockset.remove m (current_lockset ask) in let t = current_thread ask in let side_cpa = CPA.filter (fun x _ -> GWeak.fold (fun s' tm acc -> (* TODO: swap 2^M and T partitioning for lookup by t here first? *) let v = ThreadMap.find t tm in - (MustLockset.mem_addr m s' && not (VD.is_bot v)) || acc + (MustLockset.mem m s' && not (VD.is_bot v)) || acc ) (G.weak (getg (V.global x))) false ) st.cpa in @@ -1074,10 +1074,10 @@ struct {st with cpa = cpa'} let unlock ask getg sideg (st: BaseComponents (D).t) m = - let s = MustLockset.remove_addr m (current_lockset ask) in + let s = MustLockset.remove m (current_lockset ask) in let side_cpa = CPA.filter (fun x _ -> GWeak.fold (fun s' v acc -> - (MustLockset.mem_addr m s' && not (VD.is_bot v)) || acc + (MustLockset.mem m s' && not (VD.is_bot v)) || acc ) (G.weak (getg (V.global x))) false ) st.cpa in @@ -1149,7 +1149,7 @@ struct {st with cpa = cpa'} let unlock ask getg sideg (st: BaseComponents (D).t) m = - let s = MustLockset.remove_addr m (current_lockset ask) in + let s = MustLockset.remove m (current_lockset ask) in let is_in_W x _ = W.mem x st.priv in let side_cpa = CPA.filter is_in_W st.cpa in sideg (V.mutex m) (G.create_sync (GSync.singleton s side_cpa)); @@ -1192,13 +1192,13 @@ struct module DV = struct - include MapDomain.MapBot_LiftTop (Lock) (MustVars) + include MapDomain.MapBot_LiftTop (LockDomain.MustLock) (MustVars) let name () = "V" end module L = struct - include MapDomain.MapBot_LiftTop (Lock) (MinLocksets) + include MapDomain.MapBot_LiftTop (LockDomain.MustLock) (MinLocksets) let name () = "L" end end @@ -1301,7 +1301,7 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let sideg = Wrapper.sideg ask sideg in let getg = Wrapper.getg ask getg in - let s = MustLockset.remove_addr m (current_lockset ask) in + let s = MustLockset.remove m (current_lockset ask) in let is_in_G x _ = is_global ask x in let side_cpa = CPA.filter is_in_G st.cpa in let side_cpa = CPA.mapi (fun x v -> @@ -1471,10 +1471,10 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let getg = Wrapper.getg ask getg in let sideg = Wrapper.sideg ask sideg in - let s = MustLockset.remove_addr m (current_lockset ask) in + let s = MustLockset.remove m (current_lockset ask) in let (w, p) = st.priv in let p' = P.map (fun s' -> MinLocksets.add s s') p in - if M.tracing then M.traceli "priv" "unlock %a %a" Lock.pretty m CPA.pretty st.cpa; + if M.tracing then M.traceli "priv" "unlock %a %a" LockDomain.MustLock.pretty m CPA.pretty st.cpa; let side_gsyncw = CPA.fold (fun x v acc -> if is_global ask x then ( let w_x = W.find x w in @@ -1487,7 +1487,7 @@ struct acc ) st.cpa (GSyncW.bot ()) in - if M.tracing then M.traceu "priv" "unlock %a %a" Lock.pretty m GSyncW.pretty side_gsyncw; + if M.tracing then M.traceu "priv" "unlock %a %a" LockDomain.MustLock.pretty m GSyncW.pretty side_gsyncw; sideg (V.mutex m) (UnwrappedG.create_sync (GSync.singleton s side_gsyncw)); {st with priv = (w, p')} @@ -1656,7 +1656,7 @@ struct let unlock ask getg sideg (st: BaseComponents (D).t) m = let getg = Wrapper.getg ask getg in let sideg = Wrapper.sideg ask sideg in - let s = MustLockset.remove_addr m (current_lockset ask) in + let s = MustLockset.remove m (current_lockset ask) in let ((w, p), vl) = st.priv in let p' = P.map (fun s' -> MinLocksets.add s s') p in let side_gsyncw = CPA.fold (fun x v acc -> @@ -1809,7 +1809,7 @@ struct r let lock ask getg st m = - if M.tracing then M.traceli "priv" "lock %a" LockDomain.Addr.pretty m; + if M.tracing then M.traceli "priv" "lock %a" LockDomain.MustLock.pretty m; if M.tracing then M.trace "priv" "st: %a" BaseComponents.pretty st; let getg x = let r = getg x in @@ -1821,7 +1821,7 @@ struct r let unlock ask getg sideg st m = - if M.tracing then M.traceli "priv" "unlock %a" LockDomain.Addr.pretty m; + if M.tracing then M.traceli "priv" "unlock %a" LockDomain.MustLock.pretty m; if M.tracing then M.trace "priv" "st: %a" BaseComponents.pretty st; let getg x = let r = getg x in diff --git a/src/analyses/basePriv.mli b/src/analyses/basePriv.mli index e176a450fa..03a40405c0 100644 --- a/src/analyses/basePriv.mli +++ b/src/analyses/basePriv.mli @@ -17,8 +17,8 @@ sig val read_global: Queries.ask -> (V.t -> G.t) -> BaseDomain.BaseComponents (D).t -> varinfo -> BaseDomain.VD.t val write_global: ?invariant:bool -> Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> varinfo -> BaseDomain.VD.t -> BaseDomain.BaseComponents (D).t - val lock: Queries.ask -> (V.t -> G.t) -> BaseDomain.BaseComponents (D).t -> LockDomain.Addr.t -> BaseDomain.BaseComponents (D).t - val unlock: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> LockDomain.Addr.t -> BaseDomain.BaseComponents (D).t + val lock: Queries.ask -> (V.t -> G.t) -> BaseDomain.BaseComponents (D).t -> LockDomain.MustLock.t -> BaseDomain.BaseComponents (D).t + val unlock: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> LockDomain.MustLock.t -> BaseDomain.BaseComponents (D).t val sync: Queries.ask -> (V.t -> G.t) -> (V.t -> G.t -> unit) -> BaseDomain.BaseComponents (D).t -> [`Normal | `Join | `Return | `Init | `Thread] -> BaseDomain.BaseComponents (D).t diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index fe0611236c..5de56a8e59 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -74,12 +74,12 @@ struct 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}) + ask.f (Q.MayBePublicWithout {global=x; write; without_mutex=Addr (LockDomain.MustLock.to_mval m); protection}) (* TODO: no mutex conversion? *) 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; protection}) + ask.f (Q.MustBeProtectedBy {mutex=Addr (LockDomain.MustLock.to_mval m); global=x; write=true; protection}) (* TODO: no mutex conversion? *) let protected_vars (ask: Q.ask): varinfo list = LockDomain.MustLockset.fold (fun ml acc -> @@ -92,7 +92,7 @@ module MutexGlobals = struct module VMutex = struct - include LockDomain.Addr + include LockDomain.MustLock let name () = "mutex" end module VMutexInits = Printable.UnitConf (struct let name = "MUTEX_INITS" end) @@ -106,7 +106,7 @@ struct include Printable.Either3Conf (struct include Printable.DefaultConf let expand2 = false end) (VMutex) (VMutexInits) (VGlobal) let name () = "MutexGlobals" let mutex x: t = `Left x - let mutex_mustlock x = mutex (Addr (LockDomain.MustLock.to_mval x)) + let mutex_mustlock x = mutex x (* TODO: remove *) let mutex_inits: t = `Middle () let global x: t = `Right x end @@ -250,7 +250,7 @@ struct module LLock = struct - include Printable.Either (Locksets.Lock) (struct include CilType.Varinfo let name () = "global" end) + include Printable.Either (LockDomain.MustLock) (struct include CilType.Varinfo let name () = "global" end) let mutex m = `Left m let global x = `Right x end @@ -313,7 +313,7 @@ let lift_lock (ask: Q.ask) f st (addr: LockDomain.Addr.t) = match addr with | UnknownPtr -> st | Addr (v, _) when ask.f (IsMultiple v) -> st - | Addr mv when LockDomain.Mval.is_definite mv -> f st addr + | Addr mv when LockDomain.Mval.is_definite mv -> f st (LockDomain.MustLock.of_mval mv) | Addr _ | NullPtr | StrPtr _ -> st @@ -328,16 +328,16 @@ let lift_unlock (ask: Q.ask) f st (addr: LockDomain.Addr.t) = | UnknownPtr -> LockDomain.MustLockset.fold (fun ml st -> (* call privatization's unlock only with definite lock *) - f st (LockDomain.Addr.Addr (LockDomain.MustLock.to_mval ml)) (* TODO: no conversion *) + f st ml ) (ask.f MustLockset) st | StrPtr _ | NullPtr -> st - | Addr mv when LockDomain.Mval.is_definite mv -> f st addr + | Addr mv when LockDomain.Mval.is_definite mv -> f st (LockDomain.MustLock.of_mval mv) | Addr mv -> LockDomain.MustLockset.fold (fun ml st -> if LockDomain.MustLock.semantic_equal_mval ml mv = Some false then st else (* call privatization's unlock only with definite lock *) - f st (Addr (LockDomain.MustLock.to_mval ml)) (* TODO: no conversion *) + f st ml ) (ask.f MustLockset) st diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index 1c9fcb98c7..be22ec1aea 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -24,6 +24,8 @@ struct else Some false + let of_var v: t = (v, `NoOffset) + let of_mval ((v, o): Mval.t): t = (v, Offset.Poly.map_indices (fun i -> IndexDomain.to_int i |> Option.get) o) From 500b45236ecd10ccb85b60c87d3eecea40d30821 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 16:38:33 +0300 Subject: [PATCH 019/133] Remove now-unnecessary must lockset functions --- src/analyses/basePriv.ml | 6 +++--- src/analyses/commonPriv.ml | 7 ------- src/cdomains/lockDomain.ml | 16 ---------------- 3 files changed, 3 insertions(+), 26 deletions(-) diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 9dbffe40b1..6deec0e8ca 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -911,7 +911,7 @@ struct MustLockset.fold (fun m acc -> GSync.fold (fun s' cpa' acc -> SyncRange.fold_sync_vars VS.add cpa' acc - ) (G.sync (getg (V.mutex_mustlock m))) acc + ) (G.sync (getg (V.mutex m))) acc ) s VS.empty |> VS.elements end @@ -1410,7 +1410,7 @@ struct let d_cpa = CPA.find x st.cpa in let d_sync = MustLockset.fold (fun m acc -> if MinLocksets.exists (fun s''' -> not (MustLockset.mem m s''')) p_x then - let syncs = UnwrappedG.sync (getg (V.mutex_mustlock m)) in + let syncs = UnwrappedG.sync (getg (V.mutex m)) in GSync.fold (fun s' gsyncw' acc -> if MustLockset.disjoint s s' then GSyncW.fold (fun w' cpa' acc -> @@ -1600,7 +1600,7 @@ struct let d_m = VD.join d_m_sync d_m_weak in let d_g_sync = MustLockset.fold (fun m acc -> if MinLocksets.exists (fun s''' -> not (MustLockset.mem m s''')) p_x then - let syncs = UnwrappedG.sync (getg (V.mutex_mustlock m)) in + let syncs = UnwrappedG.sync (getg (V.mutex m)) in GSync.fold (fun s' gsyncw' acc -> if MustLockset.disjoint s s' then GSyncW.fold (fun w' cpa' acc -> diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 5de56a8e59..257fe9a038 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -106,7 +106,6 @@ struct include Printable.Either3Conf (struct include Printable.DefaultConf let expand2 = false end) (VMutex) (VMutexInits) (VGlobal) let name () = "MutexGlobals" let mutex x: t = `Left x - let mutex_mustlock x = mutex x (* TODO: remove *) let mutex_inits: t = `Middle () let global x: t = `Right x end @@ -131,12 +130,6 @@ end module Locksets = struct - module Lock = - struct - include LockDomain.Addr - let name () = "lock" - end - module MustLockset = LockDomain.MustLockset let current_lockset (ask: Q.ask): MustLockset.t = diff --git a/src/cdomains/lockDomain.ml b/src/cdomains/lockDomain.ml index be22ec1aea..08353f4795 100644 --- a/src/cdomains/lockDomain.ml +++ b/src/cdomains/lockDomain.ml @@ -37,22 +37,6 @@ module MustLockset = struct include SetDomain.Reverse (SetDomain.ToppedSet (MustLock) (struct let topname = "All mutexes" end)) - let mem_addr (a: Addr.t) (set: t) = (* TODO: replace with mem_mval *) - match Addr.to_mval a with - | Some mv when Mval.is_definite mv -> - let ml = MustLock.of_mval mv in - mem ml set - | _ -> - false - - let remove_addr (a: Addr.t) (set: t) = (* TODO: replace with remove_mval *) - match Addr.to_mval a with - | Some mv when Mval.is_definite mv -> - let ml = MustLock.of_mval mv in - remove ml set - | _ -> - set - let all (): t = `Top let is_all (set: t) = set = `Top end From 90fc5aa1af4b0b734289917c3f713b5bf326a408 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 4 Jun 2024 16:51:16 +0300 Subject: [PATCH 020/133] Refine MustBeProtectedBy and MayBePublicWithout query mutex type --- src/analyses/commonPriv.ml | 4 ++-- src/analyses/mutexAnalysis.ml | 5 ++--- src/domains/queries.ml | 4 ++-- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 257fe9a038..3673991fda 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -74,12 +74,12 @@ struct 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=Addr (LockDomain.MustLock.to_mval m); protection}) (* TODO: no mutex conversion? *) + ask.f (Q.MayBePublicWithout {global=x; write; without_mutex=m; protection}) 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=Addr (LockDomain.MustLock.to_mval m); global=x; write=true; protection}) (* TODO: no mutex conversion? *) + ask.f (Q.MustBeProtectedBy {mutex=m; global=x; write=true; protection}) let protected_vars (ask: Q.ask): varinfo list = LockDomain.MustLockset.fold (fun ml acc -> diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index b44795b6da..9b6aa4f4ca 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -209,15 +209,14 @@ struct MustLockset.disjoint held_locks protecting | Queries.MayBePublicWithout _ when MustLocksetRW.is_all ls -> false | Queries.MayBePublicWithout {global=v; write; without_mutex; protection} -> - let held_locks = MustLocksetRW.to_must_lockset @@ fst @@ Arg.remove' ctx ~warn:false without_mutex in + let held_locks = MustLockset.remove without_mutex (MustLocksetRW.to_must_lockset 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 (Lockset.remove (without_mutex, true) ctx.local)) then false else *) MustLockset.disjoint held_locks protecting - | Queries.MustBeProtectedBy {mutex = Addr mutex_mv; global=v; write; protection} when Mval.is_definite mutex_mv -> (* only definite Addrs can be in must-locksets to begin with, anything else cannot protect anything *) - let ml = LockDomain.MustLock.of_mval mutex_mv in + | Queries.MustBeProtectedBy {mutex = ml; global=v; write; protection} -> let protecting = protecting ~write protection v in (* TODO: unsound in 29/24, why did we do this before? *) (* if LockDomain.Addr.equal mutex (LockDomain.Addr.of_var LF.verifier_atomic_var) then diff --git a/src/domains/queries.ml b/src/domains/queries.ml index a904f696eb..edb5c44c56 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -49,8 +49,8 @@ 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 maybepublicwithout = {global: CilType.Varinfo.t; write: bool; without_mutex: LockDomain.MustLock.t; protection: Protection.t} [@@deriving ord, hash] +type mustbeprotectedby = {mutex: LockDomain.MustLock.t; global: CilType.Varinfo.t; write: bool; protection: Protection.t} [@@deriving ord, hash] type mustprotectedvars = {mutex: LockDomain.MustLock.t; write: bool} [@@deriving ord, hash] type access = | Memory of {exp: CilType.Exp.t; var_opt: CilType.Varinfo.t option; kind: AccessKind.t} (** Memory location access (race). *) From b9badb75d61cc013352afdb39e3bd29aad3ff53f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Sat, 8 Jun 2024 11:19:22 +0300 Subject: [PATCH 021/133] Bump and pin apron to v0.9.15 For breaking change: https://github.com/antoinemine/apron/pull/108. --- dune-project | 2 +- goblint.opam | 6 +++++- goblint.opam.locked | 6 +++++- goblint.opam.template | 1 + 4 files changed, 12 insertions(+), 3 deletions(-) diff --git a/dune-project b/dune-project index 878abd3b4f..751876f6b0 100644 --- a/dune-project +++ b/dune-project @@ -54,7 +54,7 @@ conf-gcc ; ensures opam-repository CI installs real gcc from homebrew on MacOS ) (depopts - apron + (apron (>= v0.9.15)) z3 ) (conflicts diff --git a/goblint.opam b/goblint.opam index 692625c965..ec6a1f8fcb 100644 --- a/goblint.opam +++ b/goblint.opam @@ -51,7 +51,10 @@ depends: [ "benchmark" {with-test} "conf-gcc" ] -depopts: ["apron" "z3"] +depopts: [ + "apron" {>= "v0.9.15"} + "z3" +] conflicts: [ "result" {< "1.5"} "ez-conf-lib" {= "1"} @@ -81,6 +84,7 @@ pin-depends: [ [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] # 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" ] + [ "apron.v0.9.15" "git+https://github.com/antoinemine/apron.git#b3172bd51e4bb0135716a300cab424a56970d96f" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.locked b/goblint.opam.locked index f8de683948..8b184e189d 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -22,7 +22,7 @@ doc: "https://goblint.readthedocs.io/en/latest/" bug-reports: "https://github.com/goblint/analyzer/issues" depends: [ "angstrom" {= "0.15.0"} - "apron" {= "v0.9.14~beta.2"} + "apron" {= "v0.9.15"} "arg-complete" {= "0.1.0"} "astring" {= "0.8.5"} "base-bigarray" {= "base"} @@ -140,5 +140,9 @@ pin-depends: [ "ppx_deriving.5.2.1" "git+https://github.com/ocaml-ppx/ppx_deriving.git#0a89b619f94cbbfc3b0fb3255ab4fe5bc77d32d6" ] + [ + "apron.v0.9.15" + "git+https://github.com/antoinemine/apron.git#b3172bd51e4bb0135716a300cab424a56970d96f" + ] ] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.template b/goblint.opam.template index 2d5ef10bc9..27be21015f 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -6,6 +6,7 @@ pin-depends: [ [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] # 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" ] + [ "apron.v0.9.15" "git+https://github.com/antoinemine/apron.git#b3172bd51e4bb0135716a300cab424a56970d96f" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} From ec675d4afc599d86b00e3b25b4f04946215f225f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Sat, 8 Jun 2024 11:26:27 +0300 Subject: [PATCH 022/133] Use Apron.Environment.cmp --- src/cdomains/apron/affineEqualityDomain.apron.ml | 4 ++-- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 7e60cce74b..75c12a0e63 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -257,7 +257,7 @@ struct let meet t1 t2 = timing_wrap "meet" (meet t1) t2 let leq t1 t2 = - let env_comp = Environment.compare t1.env t2.env in (* Apron's Environment.compare has defined return values. *) + let env_comp = Environment.cmp t1.env t2.env in (* Apron's Environment.cmp has defined return values. *) if env_comp = -2 || env_comp > 0 then (* -2: environments are not compatible (a variable has different types in the 2 environements *) (* -1: if env1 is a subset of env2, (OK) *) @@ -334,7 +334,7 @@ struct else match Option.get a.d, Option.get b.d with | x, y when is_top_env a || is_top_env b -> {d = Some (Matrix.empty ()); env = Environment.lce a.env b.env} - | x, y when (Environment.compare a.env b.env <> 0) -> + | x, y when (Environment.cmp a.env b.env <> 0) -> let sup_env = Environment.lce a.env b.env in let mod_x = dim_add (Environment.dimchange a.env sup_env) x in let mod_y = dim_add (Environment.dimchange b.env sup_env) y in diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 67bd67f4e5..b5f3bb5304 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -386,7 +386,7 @@ struct let meet t1 t2 = timing_wrap "meet" (meet t1) t2 let leq t1 t2 = - let env_comp = Environment.compare t1.env t2.env in (* Apron's Environment.compare has defined return values. *) + let env_comp = Environment.cmp t1.env t2.env in (* Apron's Environment.cmp has defined return values. *) let implies ts i (var, b) = let tuple_cmp = Tuple2.eq (Option.eq ~eq:Int.equal) (Z.equal) in match var with @@ -450,7 +450,7 @@ struct | Some x, Some y when is_top a || is_top b -> let new_env = Environment.lce a.env b.env in top_of new_env - | Some x, Some y when (Environment.compare a.env b.env <> 0) -> + | Some x, Some y when (Environment.cmp a.env b.env <> 0) -> let sup_env = Environment.lce a.env b.env in let mod_x = dim_add (Environment.dimchange a.env sup_env) x in let mod_y = dim_add (Environment.dimchange b.env sup_env) y in From 794b6ec21cc24bbd790518ede62bb85bbce5b98e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Sat, 8 Jun 2024 11:28:50 +0300 Subject: [PATCH 023/133] Implement GobApron.Environment.compare with TODO --- src/cdomains/apron/gobApron.apron.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/cdomains/apron/gobApron.apron.ml b/src/cdomains/apron/gobApron.apron.ml index c39a3e42db..40867f4889 100644 --- a/src/cdomains/apron/gobApron.apron.ml +++ b/src/cdomains/apron/gobApron.apron.ml @@ -42,6 +42,10 @@ module Environment = struct include Environment + let compare (x: t) (y: t): int = + (* TODO: implement total Environment order in OCaml *) + failwith "Apron.Environment doesn't have total order" (* https://github.com/antoinemine/apron/issues/99 *) + let ivars_only env = let ivs, fvs = Environment.vars env in assert (Array.length fvs = 0); (* shouldn't ever contain floats *) From a371b96d6c08177ff90545fc490ca40c69917077 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Sat, 8 Jun 2024 11:35:02 +0300 Subject: [PATCH 024/133] Remove broken Apron.Abstract1.compare --- src/cdomains/apron/apronDomain.apron.ml | 6 +++--- src/cdomains/apron/gobApron.apron.ml | 4 +++- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/cdomains/apron/apronDomain.apron.ml b/src/cdomains/apron/apronDomain.apron.ml index d0ef268ca6..9bf17b2f92 100644 --- a/src/cdomains/apron/apronDomain.apron.ml +++ b/src/cdomains/apron/apronDomain.apron.ml @@ -451,9 +451,9 @@ struct let hash (x:t) = A.hash Man.mgr x - let compare (x:t) y: int = - (* there is no A.compare, but polymorphic compare should delegate to Abstract0 and Environment compare's implemented in Apron's C *) - Stdlib.compare x y + let compare (x: t) (y: t): int = + failwith "Apron.Abstract1 doesn't have total order" (* https://github.com/antoinemine/apron/issues/99 *) + let printXml f x = BatPrintf.fprintf f "\n\n\nconstraints\n\n\n%s\n\nenv\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%a" A.print x)) (XmlUtil.escape (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) (A.env x))) let to_yojson (x: t) = diff --git a/src/cdomains/apron/gobApron.apron.ml b/src/cdomains/apron/gobApron.apron.ml index 40867f4889..46a0bbc28d 100644 --- a/src/cdomains/apron/gobApron.apron.ml +++ b/src/cdomains/apron/gobApron.apron.ml @@ -12,7 +12,9 @@ struct include Lincons1 let show = Format.asprintf "%a" print - let compare x y = String.compare (show x) (show y) (* HACK *) + let compare x y = + (* TODO: implement proper total Lincons1 order *) + String.compare (show x) (show y) (* HACK *) let num_vars x = (* Apron.Linexpr0.get_size returns some internal nonsense, so we count ourselves. *) From bde040e3f0214fdd966a5df9b8ef28dfa315581a Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Tue, 11 Jun 2024 15:42:47 +0200 Subject: [PATCH 025/133] frac_of_scalar instead of int_of_scalar --- src/cdomains/apron/sharedFunctions.apron.ml | 22 ++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index b287bb9bae..7c69cefda4 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -6,6 +6,14 @@ open GobApron module M = Messages +let frac_of_scalar scalar = + if Scalar.is_infty scalar <> 0 then (* infinity means unbounded *) + None + else match scalar with + | Float f -> if Stdlib.Float.is_integer f then Some (Q.of_float f) else None + | Mpqf f -> Some (Z_mlgmpidl.q_of_mpqf f) + | _ -> failwith "frac_of_scalar: unsupported" + let int_of_scalar ?round (scalar: Scalar.t) = if Scalar.is_infty scalar <> 0 then (* infinity means unbounded *) None @@ -20,21 +28,21 @@ let int_of_scalar ?round (scalar: Scalar.t) = | None when Stdlib.Float.is_integer f -> Some f | None -> None in - Q.make (Z.of_float f) Z.one + Z.of_float f | Mpqf scalar -> (* octMPQ, boxMPQ, polkaMPQ *) let n = Mpqf.get_num scalar in let d = Mpqf.get_den scalar in - let+ (n,d) = + let+ z = if Mpzf.cmp_int d 1 = 0 then (* exact integer (denominator 1) *) - Some (n,Mpzf.of_int 1) + Some n else begin match round with - | Some `Floor -> Some (Mpzf.fdiv_q n d, Mpzf.of_int 1) (* floor division *) - | Some `Ceil -> Some (Mpzf.cdiv_q n d, Mpzf.of_int 1) (* ceiling division *) - | None -> Some (n,d) + | Some `Floor -> Some (Mpzf.fdiv_q n d) (* floor division *) + | Some `Ceil -> Some (Mpzf.cdiv_q n d) (* ceiling division *) + | None -> None end in - Q.make (Z_mlgmpidl.z_of_mpzf n) (Z_mlgmpidl.z_of_mpzf d) + Z_mlgmpidl.z_of_mpzf z | _ -> failwith ("int_of_scalar: unsupported: " ^ Scalar.to_string scalar) From 2e915afaac498209620aee7fc0f5e547d2f7d300 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 13 Jun 2024 11:09:03 +0300 Subject: [PATCH 026/133] Enable pthreadMutexType analysis by default --- conf/examples/medium-program.json | 2 ++ conf/examples/very-precise.json | 2 ++ src/config/options.schema.json | 2 +- 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/conf/examples/medium-program.json b/conf/examples/medium-program.json index 2c1e7c7346..5afc1aa2f8 100644 --- a/conf/examples/medium-program.json +++ b/conf/examples/medium-program.json @@ -9,6 +9,7 @@ "base", "threadid", "threadflag", + "threadreturn", "mallocWrapper", "mutexEvents", "mutex", @@ -18,6 +19,7 @@ "expRelation", "mhp", "assert", + "pthreadMutexType", "var_eq", "symb_locks", "region", diff --git a/conf/examples/very-precise.json b/conf/examples/very-precise.json index 2197335eaf..074d448a85 100644 --- a/conf/examples/very-precise.json +++ b/conf/examples/very-precise.json @@ -22,6 +22,7 @@ "base", "threadid", "threadflag", + "threadreturn", "mallocWrapper", "mutexEvents", "mutex", @@ -31,6 +32,7 @@ "expRelation", "mhp", "assert", + "pthreadMutexType", "var_eq", "symb_locks", "region", diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 488fc494b0..7068cce719 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -344,7 +344,7 @@ "default": [ "expRelation", "base", "threadid", "threadflag", "threadreturn", "escape", "mutexEvents", "mutex", "access", "race", "mallocWrapper", "mhp", - "assert" + "assert", "pthreadMutexType" ] }, "path_sens": { From 5962aedde36fa0caadaf77123ae6bf80b90ecc28 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 13 Jun 2024 11:09:48 +0300 Subject: [PATCH 027/133] Add pthreadMutexType to single-threaded autotuner --- src/autoTune.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/autoTune.ml b/src/autoTune.ml index 434b4fb0b2..8ec77739e7 100644 --- a/src/autoTune.ml +++ b/src/autoTune.ml @@ -186,7 +186,7 @@ let enableAnalyses anas = (*escape is also still enabled, because otherwise we get a warning*) (*does not consider dynamic calls!*) -let notNeccessaryThreadAnalyses = ["race"; "deadlock"; "maylocks"; "symb_locks"; "thread"; "threadid"; "threadJoins"; "threadreturn"; "mhp"; "region"] +let notNeccessaryThreadAnalyses = ["race"; "deadlock"; "maylocks"; "symb_locks"; "thread"; "threadid"; "threadJoins"; "threadreturn"; "mhp"; "region"; "pthreadMutexType"] let reduceThreadAnalyses () = let isThreadCreate = function | LibraryDesc.ThreadCreate _ -> true From 30aeb975856b1fe4686bd82648cbd43c15ce686c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 13 Jun 2024 11:10:19 +0300 Subject: [PATCH 028/133] Use Mval.Unit for MutexTypeAnalysis.V --- src/analyses/mutexTypeAnalysis.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index 441f2e9953..e8edddd41e 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -15,8 +15,9 @@ struct (* 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 = Offset.Unit - module V = struct - include Printable.Prod(CilType.Varinfo)(O) (* TODO: use Mval.Unit *) + module V = + struct + include Mval.Unit let is_write_only _ = false end From 10fe38ecd5eab38d0a567e4551e99928508ca0b9 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Thu, 13 Jun 2024 11:10:48 +0300 Subject: [PATCH 029/133] Binary operations on pointer types should not generate overflow warnings in SV-COMP --- src/analyses/base.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index b80ac59d7f..6f768cc1d1 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -885,7 +885,11 @@ struct | None -> evalbinop ~ctx st LOr ~e1 ~e2 typ (* fallback to general case *) end | BinOp (op,e1,e2,typ) -> - evalbinop ~ctx st op ~e1 ~e2 typ + begin match typ with + | TPtr _ -> (* Binary operations on pointer types should not generate warnings in SV-COMP *) + GobRef.wrap AnalysisState.executing_speculative_computations true @@ fun () -> evalbinop ~ctx st op ~e1 ~e2 typ + | _ -> evalbinop ~ctx st op ~e1 ~e2 typ + end (* Unary operators *) | UnOp (op,arg1,typ) -> let a1 = eval_rv ~ctx st arg1 in From 578ca314fd3831f5dce193b0c6df49f60e47904b Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Thu, 13 Jun 2024 12:03:16 +0300 Subject: [PATCH 030/133] Revert "Binary operations on pointer types should not generate overflow warnings in SV-COMP" This reverts commit 10fe38ecd5eab38d0a567e4551e99928508ca0b9. --- src/analyses/base.ml | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 6f768cc1d1..b80ac59d7f 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -885,11 +885,7 @@ struct | None -> evalbinop ~ctx st LOr ~e1 ~e2 typ (* fallback to general case *) end | BinOp (op,e1,e2,typ) -> - begin match typ with - | TPtr _ -> (* Binary operations on pointer types should not generate warnings in SV-COMP *) - GobRef.wrap AnalysisState.executing_speculative_computations true @@ fun () -> evalbinop ~ctx st op ~e1 ~e2 typ - | _ -> evalbinop ~ctx st op ~e1 ~e2 typ - end + evalbinop ~ctx st op ~e1 ~e2 typ (* Unary operators *) | UnOp (op,arg1,typ) -> let a1 = eval_rv ~ctx st arg1 in From c818f0fd92cada2785aa3659ef5961dcc7036fc6 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Thu, 13 Jun 2024 12:08:01 +0300 Subject: [PATCH 031/133] Binary operations on pointer types should not generate overflow warnings in SV-COMP --- src/analyses/base.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index b80ac59d7f..2e89f98bb2 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -261,6 +261,8 @@ struct (* adds n to the last offset *) let rec addToOffset n (t:typ option) = function | `Index (i, `NoOffset) -> + (* Binary operations on pointer types should not generate warnings in SV-COMP *) + GobRef.wrap AnalysisState.executing_speculative_computations true @@ fun () -> (* If we have arrived at the last Offset and it is an Index, we add our integer to it *) `Index(IdxDom.add i (iDtoIdx n), `NoOffset) | `Field (f, `NoOffset) -> From a3b436284771cea0e1d86bda1a5b32da12f5e849 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 13 Jun 2024 18:04:33 +0300 Subject: [PATCH 032/133] Add YAML witness violation_sequence entry type --- src/witness/yamlWitnessType.ml | 200 +++++++++++++++++++++++++++++++++ 1 file changed, 200 insertions(+) diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 1630e05b69..526d52d327 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -426,6 +426,200 @@ struct let entry_type = "precondition_loop_invariant_certificate" end +module ViolationSequence = +struct + + module Constraint = + struct + type t = { + value: string; + format: string; + } + [@@deriving ord] + + let to_yaml {value; format} = + `O [ + ("value", `String value); + ("format", `String format); + ] + + let of_yaml y = + let open GobYaml in + let+ value = y |> find "value" >>= to_string + and+ format = y |> find "format" >>= to_string in + {value; format} + end + + module Assumption = + struct + type t = { + location: Location.t; + action: string; + constraint_: Constraint.t; + } + [@@deriving ord] + + let waypoint_type = "assumption" + + let to_yaml' {location; action; constraint_} = + [ + ("location", Location.to_yaml location); + ("action", `String action); + ("constraint", Constraint.to_yaml constraint_); + ] + + let of_yaml y = + let open GobYaml in + let+ location = y |> find "location" >>= Location.of_yaml + and+ action = y |> find "action" >>= to_string + and+ constraint_ = y |> find "constraint" >>= Constraint.of_yaml in + {location; action; constraint_} + end + + module Target = + struct + type t = { + location: Location.t; + action: string; + } + [@@deriving ord] + + let waypoint_type = "target" + + let to_yaml' {location; action} = + [ + ("location", Location.to_yaml location); + ("action", `String action); + ] + + let of_yaml y = + let open GobYaml in + let+ location = y |> find "location" >>= Location.of_yaml + and+ action = y |> find "action" >>= to_string in + {location; action} + end + + module FunctionEnter = + struct + include Target + + let waypoint_type = "function_enter" + end + + module FunctionReturn = + struct + include Assumption + + let waypoint_type = "function_return" + end + + module Branching = + struct + include Assumption + + let waypoint_type = "branching" + end + + (* TODO: could maybe use GADT, but adds ugly existential layer to entry type pattern matching *) + module WaypointType = + struct + type t = + | Assumption of Assumption.t + | Target of Target.t + | FunctionEnter of FunctionEnter.t + | FunctionReturn of FunctionReturn.t + | Branching of Branching.t + [@@deriving ord] + + let waypoint_type = function + | Assumption _ -> Assumption.waypoint_type + | Target _ -> Target.waypoint_type + | FunctionEnter _ -> FunctionEnter.waypoint_type + | FunctionReturn _ -> FunctionReturn.waypoint_type + | Branching _ -> Branching.waypoint_type + + let to_yaml' = function + | Assumption x -> Assumption.to_yaml' x + | Target x -> Target.to_yaml' x + | FunctionEnter x -> FunctionEnter.to_yaml' x + | FunctionReturn x -> FunctionReturn.to_yaml' x + | Branching x -> Branching.to_yaml' x + + let of_yaml y = + let open GobYaml in + let* waypoint_type = y |> find "type" >>= to_string in + if waypoint_type = Assumption.waypoint_type then + let+ x = y |> Assumption.of_yaml in + Assumption x + else if waypoint_type = Target.waypoint_type then + let+ x = y |> Target.of_yaml in + Target x + else if waypoint_type = FunctionEnter.waypoint_type then + let+ x = y |> FunctionEnter.of_yaml in + FunctionEnter x + else if waypoint_type = FunctionReturn.waypoint_type then + let+ x = y |> FunctionReturn.of_yaml in + FunctionReturn x + else if waypoint_type = Branching.waypoint_type then + let+ x = y |> Branching.of_yaml in + Branching x + else + Error (`Msg "type") + end + + module Waypoint = + struct + type t = { + waypoint_type: WaypointType.t; + } + [@@deriving ord] + + let to_yaml {waypoint_type} = + `O [ + ("waypoint", `O ([ + ("type", `String (WaypointType.waypoint_type waypoint_type)); + ] @ WaypointType.to_yaml' waypoint_type) + ) + ] + + let of_yaml y = + let open GobYaml in + let+ waypoint_type = y |> find "waypoint" >>= WaypointType.of_yaml in + {waypoint_type} + end + + module Segment = + struct + type t = { + segment: Waypoint.t list; + } + [@@deriving ord] + + let to_yaml {segment} = + `O [("segment", `A (List.map Waypoint.to_yaml segment))] + + let of_yaml y = + let open GobYaml in + let+ segment = y |> find "segment" >>= list >>= list_map Waypoint.of_yaml in + {segment} + end + + type t = { + content: Segment.t list; + } + [@@deriving ord] + + let entry_type = "violation_sequence" + + let to_yaml' {content} = + [("content", `A (List.map Segment.to_yaml content))] + + let of_yaml y = + let open GobYaml in + let+ content = y |> find "content" >>= list >>= list_map Segment.of_yaml in + {content} +end + (* TODO: could maybe use GADT, but adds ugly existential layer to entry type pattern matching *) module EntryType = struct @@ -437,6 +631,7 @@ struct | LoopInvariantCertificate of LoopInvariantCertificate.t | PreconditionLoopInvariantCertificate of PreconditionLoopInvariantCertificate.t | InvariantSet of InvariantSet.t + | ViolationSequence of ViolationSequence.t [@@deriving ord] let entry_type = function @@ -447,6 +642,7 @@ struct | LoopInvariantCertificate _ -> LoopInvariantCertificate.entry_type | PreconditionLoopInvariantCertificate _ -> PreconditionLoopInvariantCertificate.entry_type | InvariantSet _ -> InvariantSet.entry_type + | ViolationSequence _ -> ViolationSequence.entry_type let to_yaml' = function | LocationInvariant x -> LocationInvariant.to_yaml' x @@ -456,6 +652,7 @@ struct | LoopInvariantCertificate x -> LoopInvariantCertificate.to_yaml' x | PreconditionLoopInvariantCertificate x -> PreconditionLoopInvariantCertificate.to_yaml' x | InvariantSet x -> InvariantSet.to_yaml' x + | ViolationSequence x -> ViolationSequence.to_yaml' x let of_yaml y = let open GobYaml in @@ -481,6 +678,9 @@ struct else if entry_type = InvariantSet.entry_type then let+ x = y |> InvariantSet.of_yaml in InvariantSet x + else if entry_type = ViolationSequence.entry_type then + let+ x = y |> ViolationSequence.of_yaml in + ViolationSequence x else Error (`Msg "entry_type") end From a98da9d0c838a6073aff78515de848fb9d01047e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 14 Jun 2024 12:19:38 +0300 Subject: [PATCH 033/133] Implement violation_sequence in yamlWitnessStrip --- tests/util/yamlWitnessStrip.ml | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/tests/util/yamlWitnessStrip.ml b/tests/util/yamlWitnessStrip.ml index 8a5046d6ff..75c6cf3583 100644 --- a/tests/util/yamlWitnessStrip.ml +++ b/tests/util/yamlWitnessStrip.ml @@ -26,6 +26,25 @@ struct in {invariant_type} in + let waypoint_strip_file_hash ({waypoint_type}: ViolationSequence.Waypoint.t): ViolationSequence.Waypoint.t = + let waypoint_type: ViolationSequence.WaypointType.t = + match waypoint_type with + | Assumption x -> + Assumption {x with location = location_strip_file_hash x.location} + | Target x -> + Target {x with location = location_strip_file_hash x.location} + | FunctionEnter x -> + FunctionEnter {x with location = location_strip_file_hash x.location} + | FunctionReturn x -> + FunctionReturn {x with location = location_strip_file_hash x.location} + | Branching x -> + Branching {x with location = location_strip_file_hash x.location} + in + {waypoint_type} + in + let segment_strip_file_hash ({segment}: ViolationSequence.Segment.t): ViolationSequence.Segment.t = + {segment = List.map waypoint_strip_file_hash segment} + in let entry_type: EntryType.t = match entry_type with | LocationInvariant x -> @@ -42,6 +61,8 @@ struct PreconditionLoopInvariantCertificate {x with target = target_strip_file_hash x.target} | InvariantSet x -> InvariantSet {content = List.map invariant_strip_file_hash x.content} + | ViolationSequence x -> + ViolationSequence {content = List.map segment_strip_file_hash x.content} in {entry_type} From c4c4b258463442305d5837e08a6ef493a2afd304 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Fri, 14 Jun 2024 12:59:06 +0300 Subject: [PATCH 034/133] Add test for loop unrolling causing a signed integer overflow warning to appear --- .../55-loop-unrolling/12-loop-no-overflows.c | 37 ++++++++++ .../13-unrolled-loop-no-overflows.c | 72 +++++++++++++++++++ 2 files changed, 109 insertions(+) create mode 100644 tests/regression/55-loop-unrolling/12-loop-no-overflows.c create mode 100644 tests/regression/55-loop-unrolling/13-unrolled-loop-no-overflows.c diff --git a/tests/regression/55-loop-unrolling/12-loop-no-overflows.c b/tests/regression/55-loop-unrolling/12-loop-no-overflows.c new file mode 100644 index 0000000000..03554e06c5 --- /dev/null +++ b/tests/regression/55-loop-unrolling/12-loop-no-overflows.c @@ -0,0 +1,37 @@ +// PARAM: --enable ana.int.interval_set +// extracted from SV-COMP task ldv-memsafety/memleaks_test12-2.i + +typedef unsigned int size_t; +struct ldv_list_head { + struct ldv_list_head *next, *prev; +}; +struct ldv_list_head ldv_global_msg_list = {&(ldv_global_msg_list), &(ldv_global_msg_list)}; +struct ldv_msg { + void *data; + struct ldv_list_head list; +}; + +static inline void __ldv_list_del(struct ldv_list_head *prev, struct ldv_list_head *next) { + next->prev = prev; + prev->next = next; +} + +static inline void ldv_list_del(struct ldv_list_head *entry) { + __ldv_list_del(entry->prev, entry->next); +} + +void ldv_msg_free(struct ldv_msg *msg) { + free(msg->data); + free(msg); +} + +// ldv_destroy_msgs +void main(void) { + struct ldv_msg *msg; + struct ldv_msg *n; + for (msg = ({ const typeof( ((typeof(*msg) *)0)->list ) *__mptr = ((&ldv_global_msg_list)->next); (typeof(*msg) *)( (char *)__mptr - ((size_t) &((typeof(*msg) *)0)->list) ); }), n = ({ const typeof( ((typeof(*(msg)) *)0)->list ) *__mptr = ((msg)->list.next); (typeof(*(msg)) *)( (char *)__mptr - ((size_t) &((typeof(*(msg)) *)0)->list) ); }); &msg->list != (&ldv_global_msg_list); msg = n, n = ({ const typeof( ((typeof(*(n)) *)0)->list ) *__mptr = ((n)->list.next); (typeof(*(n)) *)( (char *)__mptr - ((size_t) &((typeof(*(n)) *)0)->list) ); })) // NOWARN + { + ldv_list_del(&msg->list); + ldv_msg_free(msg); + } +} \ No newline at end of file diff --git a/tests/regression/55-loop-unrolling/13-unrolled-loop-no-overflows.c b/tests/regression/55-loop-unrolling/13-unrolled-loop-no-overflows.c new file mode 100644 index 0000000000..84700ac9da --- /dev/null +++ b/tests/regression/55-loop-unrolling/13-unrolled-loop-no-overflows.c @@ -0,0 +1,72 @@ +// PARAM: --enable ana.int.interval_set +// extracted from SV-COMP task ldv-memsafety/memleaks_test12-2.i with --set exp.unrolling-factor 1 + +typedef unsigned int size_t; +struct ldv_list_head { + struct ldv_list_head *next, *prev; +}; +struct ldv_list_head ldv_global_msg_list = {&(ldv_global_msg_list), &(ldv_global_msg_list)}; +struct ldv_msg { + void *data; + struct ldv_list_head list; +}; + +__inline static void __ldv_list_del(struct ldv_list_head *prev, struct ldv_list_head *next) { + next->prev = prev; + prev->next = next; + return; +} + +__inline static void ldv_list_del(struct ldv_list_head *entry) { + __ldv_list_del(entry->prev, entry->next); + return; +} + +void ldv_msg_free(struct ldv_msg *msg) { + free(msg->data); + free((void *)msg); + return; +} + +// ldv_destroy_msgs +void main(void) { + struct ldv_msg *msg; + struct ldv_msg *n; + struct ldv_list_head const *__mptr; + struct ldv_list_head const *__mptr___0; + struct ldv_list_head const *__mptr___1; + + __mptr = (struct ldv_list_head const *)ldv_global_msg_list.next; + msg = (struct ldv_msg *)((char *)__mptr - (size_t)(&((struct ldv_msg *)0)->list)); + __mptr___0 = (struct ldv_list_head const *)msg->list.next; + n = (struct ldv_msg *)((char *)__mptr___0 - (size_t)(&((struct ldv_msg *)0)->list)); + + if (!((unsigned long)(&msg->list) != (unsigned long)(&ldv_global_msg_list))) { // NOWARN + goto loop_end; + } + + ldv_list_del(&msg->list); + ldv_msg_free(msg); + msg = n; + __mptr___1 = (struct ldv_list_head const *)n->list.next; + n = (struct ldv_msg *)((char *)__mptr___1 - (size_t)(&((struct ldv_msg *)0)->list)); + + loop_continue_0: /* CIL Label */; + { + while (1) { + while_continue: /* CIL Label */; + if (!((unsigned long)(&msg->list) != (unsigned long)(&ldv_global_msg_list))) { + goto while_break; + } + + ldv_list_del(&msg->list); + ldv_msg_free(msg); + msg = n; + __mptr___1 = (struct ldv_list_head const *)n->list.next; + n = (struct ldv_msg *)((char *)__mptr___1 - (size_t)(&((struct ldv_msg *)0)->list)); + } + while_break: /* CIL Label */; + } + loop_end: /* CIL Label */; + return; +} \ No newline at end of file From 44600c993976793a79c89177c68abc3b543a863d Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Fri, 14 Jun 2024 13:04:05 +0300 Subject: [PATCH 035/133] Binops on offsets should not generate overflow warnings in SV-COMP --- src/cdomain/value/cdomains/offset.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/offset.ml b/src/cdomain/value/cdomains/offset.ml index 9c9c5c3333..fa64f71daa 100644 --- a/src/cdomain/value/cdomains/offset.ml +++ b/src/cdomain/value/cdomains/offset.ml @@ -223,9 +223,10 @@ struct | _ -> (None, Idx.top ()) in - let bits_offset = Idx.mul item_size_in_bits x in + (* Binary operations on offsets should not generate overflow warnings in SV-COMP *) + let bits_offset = GobRef.wrap AnalysisState.executing_speculative_computations true @@ fun () -> 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 + GobRef.wrap AnalysisState.executing_speculative_computations true @@ fun () -> Idx.add bits_offset remaining_offset in offset_to_index_offset ?typ offs From e286a48decb04641f2e9bbe7fa1b96d1ba845293 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 14 Jun 2024 13:50:46 +0300 Subject: [PATCH 036/133] Make YAML witness location function optional In updated version 2.0 schema. --- src/witness/yamlWitness.ml | 2 +- src/witness/yamlWitnessType.ml | 23 ++++++++++++++--------- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 42254f30de..f5a8ae94e2 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -48,7 +48,7 @@ struct file_hash = sha256_file loc.file; line = loc.line; column = loc.column; - function_ = location_function; + function_ = Some location_function; } let invariant invariant: Invariant.t = { diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 1630e05b69..ff11fcbe9d 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -109,18 +109,23 @@ struct file_hash: string; line: int; column: int; - function_: string; + function_: string option; } [@@deriving ord] let to_yaml {file_name; file_hash; line; column; function_} = - `O [ - ("file_name", `String file_name); - ("file_hash", `String file_hash); - ("line", `Float (float_of_int line)); - ("column", `Float (float_of_int column)); - ("function", `String function_); - ] + `O ([ + ("file_name", `String file_name); + ("file_hash", `String file_hash); + ("line", `Float (float_of_int line)); + ("column", `Float (float_of_int column)); + ] @ match function_ with + | Some function_ -> [ + ("function", `String function_); + ] + | None -> + [] + ) let of_yaml y = let open GobYaml in @@ -128,7 +133,7 @@ struct and+ file_hash = y |> find "file_hash" >>= to_string and+ line = y |> find "line" >>= to_int and+ column = y |> find "column" >>= to_int - and+ function_ = y |> find "function" >>= to_string in + and+ function_ = y |> Yaml.Util.find "function" >>= option_map to_string in {file_name; file_hash; line; column; function_} end From 6a3569521a4dec529ceef50d82854db1ed350b0d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 14 Jun 2024 13:55:14 +0300 Subject: [PATCH 037/133] Make YAML witness location column optional In updated version 2.0 schema. --- src/analyses/unassumeAnalysis.ml | 22 +++++----------------- src/witness/yamlWitness.ml | 24 ++++++++++++------------ src/witness/yamlWitnessType.ml | 25 +++++++++++++++---------- 3 files changed, 32 insertions(+), 39 deletions(-) diff --git a/src/analyses/unassumeAnalysis.ml b/src/analyses/unassumeAnalysis.ml index 265e9c6925..ae7a8bc9a8 100644 --- a/src/analyses/unassumeAnalysis.ml +++ b/src/analyses/unassumeAnalysis.ml @@ -71,18 +71,6 @@ struct | _ -> () ); - let loc_of_location (location: YamlWitnessType.Location.t): Cil.location = { - file = location.file_name; - line = location.line; - column = location.column; - byte = -1; - endLine = -1; - endColumn = -1; - endByte = -1; - synthetic = false; - } - in - let yaml = match Yaml_unix.of_file (Fpath.v (GobConfig.get_string "witness.yaml.unassume")) with | Ok yaml -> yaml | Error (`Msg m) -> failwith ("Yaml_unix.of_file: " ^ m) @@ -123,7 +111,7 @@ struct in let unassume_location_invariant (location_invariant: YamlWitnessType.LocationInvariant.t) = - let loc = loc_of_location location_invariant.location in + let loc = YamlWitness.loc_of_location location_invariant.location in let inv = location_invariant.location_invariant.string in let msgLoc: M.Location.t = CilLocation loc in @@ -135,7 +123,7 @@ struct in let unassume_loop_invariant (loop_invariant: YamlWitnessType.LoopInvariant.t) = - let loc = loc_of_location loop_invariant.location in + let loc = YamlWitness.loc_of_location loop_invariant.location in let inv = loop_invariant.loop_invariant.string in let msgLoc: M.Location.t = CilLocation loc in @@ -185,7 +173,7 @@ struct in let unassume_precondition_loop_invariant (precondition_loop_invariant: YamlWitnessType.PreconditionLoopInvariant.t) = - let loc = loc_of_location precondition_loop_invariant.location in + let loc = YamlWitness.loc_of_location precondition_loop_invariant.location in let pre = precondition_loop_invariant.precondition.string in let inv = precondition_loop_invariant.loop_invariant.string in let msgLoc: M.Location.t = CilLocation loc in @@ -200,7 +188,7 @@ struct let unassume_invariant_set (invariant_set: YamlWitnessType.InvariantSet.t) = let unassume_location_invariant (location_invariant: YamlWitnessType.InvariantSet.LocationInvariant.t) = - let loc = loc_of_location location_invariant.location in + let loc = YamlWitness.loc_of_location location_invariant.location in let inv = location_invariant.value in let msgLoc: M.Location.t = CilLocation loc in @@ -212,7 +200,7 @@ struct in let unassume_loop_invariant (loop_invariant: YamlWitnessType.InvariantSet.LoopInvariant.t) = - let loc = loc_of_location loop_invariant.location in + let loc = YamlWitness.loc_of_location loop_invariant.location in let inv = loop_invariant.value in let msgLoc: M.Location.t = CilLocation loc in diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index f5a8ae94e2..cf6b1dfc44 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -47,7 +47,7 @@ struct file_name = loc.file; file_hash = sha256_file loc.file; line = loc.line; - column = loc.column; + column = Some loc.column; function_ = Some location_function; } @@ -515,6 +515,17 @@ struct end +let loc_of_location (location: YamlWitnessType.Location.t): Cil.location = { + file = location.file_name; + line = location.line; + column = Option.value location.column ~default:1; + byte = -1; + endLine = -1; + endColumn = -1; + endByte = -1; + synthetic = false; +} + module ValidationResult = struct (* constructor order is important for the chain lattice *) @@ -553,17 +564,6 @@ struct module InvariantParser = WitnessUtil.InvariantParser module VR = ValidationResult - let loc_of_location (location: YamlWitnessType.Location.t): Cil.location = { - file = location.file_name; - line = location.line; - column = location.column; - byte = -1; - endLine = -1; - endColumn = -1; - endByte = -1; - synthetic = false; - } - let validate () = let location_locator = Locator.create () in let loop_locator = Locator.create () in diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index ff11fcbe9d..23a0343c18 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -108,7 +108,7 @@ struct file_name: string; file_hash: string; line: int; - column: int; + column: int option; function_: string option; } [@@deriving ord] @@ -118,21 +118,26 @@ struct ("file_name", `String file_name); ("file_hash", `String file_hash); ("line", `Float (float_of_int line)); - ("column", `Float (float_of_int column)); - ] @ match function_ with - | Some function_ -> [ - ("function", `String function_); - ] - | None -> - [] - ) + ] @ (match column with + | Some column -> [ + ("column", `Float (float_of_int column)); + ] + | None -> + [] + ) @ (match function_ with + | Some function_ -> [ + ("function", `String function_); + ] + | None -> + [] + )) let of_yaml y = let open GobYaml in let+ file_name = y |> find "file_name" >>= to_string and+ file_hash = y |> find "file_hash" >>= to_string and+ line = y |> find "line" >>= to_int - and+ column = y |> find "column" >>= to_int + and+ column = y |> Yaml.Util.find "column" >>= option_map to_int and+ function_ = y |> Yaml.Util.find "function" >>= option_map to_string in {file_name; file_hash; line; column; function_} end From b3dd140985c1db0e086bb42b51f5d5a6a045fc92 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 14 Jun 2024 14:03:04 +0300 Subject: [PATCH 038/133] Make YAML witness location file_hash optional Removed from version 2.0 schema. --- src/witness/yamlWitness.ml | 21 ++++++++++++++------- src/witness/yamlWitnessType.ml | 16 +++++++++++----- tests/util/yamlWitnessStrip.ml | 9 +++++++-- 3 files changed, 32 insertions(+), 14 deletions(-) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index cf6b1dfc44..d880663547 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -43,13 +43,20 @@ struct specification } - let location ~location:(loc: Cil.location) ~(location_function): Location.t = { - file_name = loc.file; - file_hash = sha256_file loc.file; - line = loc.line; - column = Some loc.column; - function_ = Some location_function; - } + let location ~location:(loc: Cil.location) ~(location_function): Location.t = + let file_hash = + match GobConfig.get_string "witness.yaml.format-version" with + | "0.1" -> Some (sha256_file loc.file) + | "2.0" -> None + | _ -> assert false + in + { + file_name = loc.file; + file_hash; + line = loc.line; + column = Some loc.column; + function_ = Some location_function; + } let invariant invariant: Invariant.t = { string = invariant; diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 23a0343c18..aabf551109 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -106,7 +106,7 @@ module Location = struct type t = { file_name: string; - file_hash: string; + file_hash: string option; line: int; column: int option; function_: string option; @@ -116,9 +116,15 @@ struct let to_yaml {file_name; file_hash; line; column; function_} = `O ([ ("file_name", `String file_name); - ("file_hash", `String file_hash); - ("line", `Float (float_of_int line)); - ] @ (match column with + ] @ (match file_hash with + | Some file_hash -> [ + ("file_hash", `String file_hash); + ] + | None -> + [] + ) @ [ + ("line", `Float (float_of_int line)); + ] @ (match column with | Some column -> [ ("column", `Float (float_of_int column)); ] @@ -135,7 +141,7 @@ struct let of_yaml y = let open GobYaml in let+ file_name = y |> find "file_name" >>= to_string - and+ file_hash = y |> find "file_hash" >>= to_string + and+ file_hash = y |> Yaml.Util.find "file_hash" >>= option_map to_string and+ line = y |> find "line" >>= to_int and+ column = y |> Yaml.Util.find "column" >>= option_map to_int and+ function_ = y |> Yaml.Util.find "function" >>= option_map to_string in diff --git a/tests/util/yamlWitnessStrip.ml b/tests/util/yamlWitnessStrip.ml index 8a5046d6ff..1a463d1390 100644 --- a/tests/util/yamlWitnessStrip.ml +++ b/tests/util/yamlWitnessStrip.ml @@ -10,8 +10,13 @@ struct let strip_file_hashes {entry_type} = let stripped_file_hash = "$FILE_HASH" in - let location_strip_file_hash location: Location.t = - {location with file_hash = stripped_file_hash} + let location_strip_file_hash (location: Location.t): Location.t = + let file_hash = + match location.file_hash with + | Some _ -> Some stripped_file_hash (* TODO: or just map to None always? *) + | None -> None + in + {location with file_hash} in let target_strip_file_hash target: Target.t = {target with file_hash = stripped_file_hash} From 28cff0f0917ecd5d2bd38972b6f0d66369b2d873 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 14 Jun 2024 14:10:45 +0300 Subject: [PATCH 039/133] Make YAML witness waypoint constraint format optional --- src/witness/yamlWitnessType.ml | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index 159b0eedae..4fc2029801 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -449,20 +449,25 @@ struct struct type t = { value: string; - format: string; + format: string option; } [@@deriving ord] let to_yaml {value; format} = - `O [ - ("value", `String value); - ("format", `String format); - ] + `O ([ + ("value", `String value); + ] @ (match format with + | Some format -> [ + ("format", `String format); + ] + | None -> + [] + )) let of_yaml y = let open GobYaml in let+ value = y |> find "value" >>= to_string - and+ format = y |> find "format" >>= to_string in + and+ format = y |> Yaml.Util.find "format" >>= option_map to_string in {value; format} end @@ -593,8 +598,8 @@ struct let to_yaml {waypoint_type} = `O [ ("waypoint", `O ([ - ("type", `String (WaypointType.waypoint_type waypoint_type)); - ] @ WaypointType.to_yaml' waypoint_type) + ("type", `String (WaypointType.waypoint_type waypoint_type)); + ] @ WaypointType.to_yaml' waypoint_type) ) ] From 1bdb1aec3d0de987c83a3e3ff5ab0514bc965772 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 14 Jun 2024 14:58:32 +0300 Subject: [PATCH 040/133] Add primitive YAML violation_sequence refutation (issue #1301) --- src/config/options.schema.json | 3 ++- src/witness/yamlWitness.ml | 13 ++++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 488fc494b0..95fb1a9ff5 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -2574,7 +2574,8 @@ "precondition_loop_invariant", "loop_invariant_certificate", "precondition_loop_invariant_certificate", - "invariant_set" + "invariant_set", + "violation_sequence" ] }, "default": [ diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index d880663547..36e1e2b589 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -802,6 +802,15 @@ struct None in + let validate_violation_sequence (violation_sequence: YamlWitnessType.ViolationSequence.t) = + (* TODO: update cnt-s appropriately (needs access to SV-COMP result pre-witness validation) *) + (* Nothing needs to be checked here! + If program is correct and we can prove it, we output true, which counts as refutation of violation witness. + If program is correct and we cannot prove it, we output unknown. + If program is incorrect, we output unknown. *) + None + in + match entry_type_enabled target_type, entry.entry_type with | true, LocationInvariant x -> validate_location_invariant x @@ -811,7 +820,9 @@ struct validate_precondition_loop_invariant x | true, InvariantSet x -> validate_invariant_set x - | false, (LocationInvariant _ | LoopInvariant _ | PreconditionLoopInvariant _ | InvariantSet _) -> + | true, ViolationSequence x -> + validate_violation_sequence x + | false, (LocationInvariant _ | LoopInvariant _ | PreconditionLoopInvariant _ | InvariantSet _ | ViolationSequence _) -> incr cnt_disabled; M.info_noloc ~category:Witness "disabled entry of type %s" target_type; None From c546f2df8208ac3ff22886e65f64f3eb84c8e044 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 14 Jun 2024 15:00:10 +0300 Subject: [PATCH 041/133] Add svcomp-validate conf for next SV-COMP Compared to svcomp24-validate: 1. Enables abortUnless (like svcomp over svcomp24). 2. Enables YAML violation_sequence validation. --- conf/svcomp-validate.json | 142 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 142 insertions(+) create mode 100644 conf/svcomp-validate.json diff --git a/conf/svcomp-validate.json b/conf/svcomp-validate.json new file mode 100644 index 0000000000..a234aeb0d5 --- /dev/null +++ b/conf/svcomp-validate.json @@ -0,0 +1,142 @@ +{ + "ana": { + "sv-comp": { + "enabled": true, + "functions": true + }, + "int": { + "def_exc": true, + "enums": false, + "interval": true + }, + "float": { + "interval": true + }, + "activated": [ + "base", + "threadid", + "threadflag", + "threadreturn", + "mallocWrapper", + "mutexEvents", + "mutex", + "access", + "race", + "escape", + "expRelation", + "mhp", + "assert", + "var_eq", + "symb_locks", + "region", + "thread", + "threadJoins", + "abortUnless", + "unassume" + ], + "path_sens": [ + "mutex", + "malloc_null", + "uninit", + "expsplit", + "activeSetjmp", + "memLeak", + "threadflag" + ], + "context": { + "widen": false + }, + "malloc": { + "wrappers": [ + "kmalloc", + "__kmalloc", + "usb_alloc_urb", + "__builtin_alloca", + "kzalloc", + + "ldv_malloc", + + "kzalloc_node", + "ldv_zalloc", + "kmalloc_array", + "kcalloc", + + "ldv_xmalloc", + "ldv_xzalloc", + "ldv_calloc", + "ldv_kzalloc" + ] + }, + "base": { + "arrays": { + "domain": "partitioned" + } + }, + "race": { + "free": false, + "call": false + }, + "autotune": { + "enabled": true, + "activated": [ + "singleThreaded", + "mallocWrappers", + "noRecursiveIntervals", + "enums", + "congruence", + "octagon", + "wideningThresholds", + "loopUnrollHeuristic", + "memsafetySpecification", + "termination", + "tmpSpecialAnalysis" + ] + }, + "widen": { + "tokens": true + } + }, + "exp": { + "region-offsets": true + }, + "solver": "td3", + "sem": { + "unknown_function": { + "spawn": false + }, + "int": { + "signed_overflow": "assume_none" + }, + "null-pointer": { + "dereference": "assume_none" + } + }, + "witness": { + "graphml": { + "enabled": false + }, + "yaml": { + "enabled": false, + "strict": true, + "format-version": "2.0", + "entry-types": [ + "location_invariant", + "loop_invariant", + "invariant_set", + "violation_sequence" + ], + "invariant-types": [ + "location_invariant", + "loop_invariant" + ] + }, + "invariant": { + "loop-head": true, + "after-lock": true, + "other": true + } + }, + "pre": { + "enabled": false + } +} From fccc91efee6c2dc0ad92c3d82946e1b1e994d7d8 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 14 Jun 2024 15:57:34 +0300 Subject: [PATCH 042/133] Add cram test for YAML violation witness refutation --- .../witness/violation.t/correct-hard.c | 9 +++ .../witness/violation.t/correct-hard.yml | 26 +++++++++ .../regression/witness/violation.t/correct.c | 5 ++ .../witness/violation.t/correct.yml | 26 +++++++++ .../witness/violation.t/incorrect.c | 6 ++ .../witness/violation.t/incorrect.yml | 26 +++++++++ tests/regression/witness/violation.t/run.t | 57 +++++++++++++++++++ 7 files changed, 155 insertions(+) create mode 100644 tests/regression/witness/violation.t/correct-hard.c create mode 100644 tests/regression/witness/violation.t/correct-hard.yml create mode 100644 tests/regression/witness/violation.t/correct.c create mode 100644 tests/regression/witness/violation.t/correct.yml create mode 100644 tests/regression/witness/violation.t/incorrect.c create mode 100644 tests/regression/witness/violation.t/incorrect.yml create mode 100644 tests/regression/witness/violation.t/run.t diff --git a/tests/regression/witness/violation.t/correct-hard.c b/tests/regression/witness/violation.t/correct-hard.c new file mode 100644 index 0000000000..ce2b50a0c0 --- /dev/null +++ b/tests/regression/witness/violation.t/correct-hard.c @@ -0,0 +1,9 @@ +void reach_error(){} +extern int __VERIFIER_nondet_int(); + +int main() { + int x = __VERIFIER_nondet_int(); + if (x != x) + reach_error(); + return 0; +} diff --git a/tests/regression/witness/violation.t/correct-hard.yml b/tests/regression/witness/violation.t/correct-hard.yml new file mode 100644 index 0000000000..b8af2c2193 --- /dev/null +++ b/tests/regression/witness/violation.t/correct-hard.yml @@ -0,0 +1,26 @@ +- entry_type: violation_sequence + metadata: + format_version: "2.0" + uuid: 4412af70-389a-475e-849c-e57e5b92019e + creation_time: 2024-06-14T15:35:00+03:00 + producer: + name: Simmo Saan + version: n/a + task: + input_files: + - correct-hard.c + input_file_hashes: + correct-hard.c: 5cc49c1ce5a9aef64286c2a6e57f6955c5f4f9b19b43056507ae87a802802447 + specification: G ! call(reach_error()) + data_model: ILP32 + language: C + content: + - segment: + - waypoint: + type: target + action: follow + location: + file_name: correct-hard.c + line: 7 + column: 5 + function: main diff --git a/tests/regression/witness/violation.t/correct.c b/tests/regression/witness/violation.t/correct.c new file mode 100644 index 0000000000..30f58a2f7e --- /dev/null +++ b/tests/regression/witness/violation.t/correct.c @@ -0,0 +1,5 @@ +void reach_error(){} + +int main() { + return 0; +} diff --git a/tests/regression/witness/violation.t/correct.yml b/tests/regression/witness/violation.t/correct.yml new file mode 100644 index 0000000000..1f1d4f41da --- /dev/null +++ b/tests/regression/witness/violation.t/correct.yml @@ -0,0 +1,26 @@ +- entry_type: violation_sequence + metadata: + format_version: "2.0" + uuid: 4412af70-389a-475e-849c-e57e5b92019d + creation_time: 2024-06-14T15:35:00+03:00 + producer: + name: Simmo Saan + version: n/a + task: + input_files: + - correct.c + input_file_hashes: + correct.c: 6f760cf7f33fc152738bf3514fe623cc94e52cad9ddc2f0e744595ce0de07530 + specification: G ! call(reach_error()) + data_model: ILP32 + language: C + content: + - segment: + - waypoint: + type: target + action: follow + location: + file_name: correct.c + line: 4 + column: 3 + function: main diff --git a/tests/regression/witness/violation.t/incorrect.c b/tests/regression/witness/violation.t/incorrect.c new file mode 100644 index 0000000000..ff56fa2ef4 --- /dev/null +++ b/tests/regression/witness/violation.t/incorrect.c @@ -0,0 +1,6 @@ +void reach_error(){} + +int main() { + reach_error(); + return 0; +} diff --git a/tests/regression/witness/violation.t/incorrect.yml b/tests/regression/witness/violation.t/incorrect.yml new file mode 100644 index 0000000000..dd57ce3ca1 --- /dev/null +++ b/tests/regression/witness/violation.t/incorrect.yml @@ -0,0 +1,26 @@ +- entry_type: violation_sequence + metadata: + format_version: "2.0" + uuid: 4412af70-389a-475e-849c-e57e5b92019c + creation_time: 2024-06-14T15:35:00+03:00 + producer: + name: Simmo Saan + version: n/a + task: + input_files: + - incorrect.c + input_file_hashes: + incorrect.c: 1af4fd9e76418e4b95af9950b58248127e7c2d9eb791e1c9b92da53952e0fca2 + specification: G ! call(reach_error()) + data_model: ILP32 + language: C + content: + - segment: + - waypoint: + type: target + action: follow + location: + file_name: incorrect.c + line: 4 + column: 3 + function: main diff --git a/tests/regression/witness/violation.t/run.t b/tests/regression/witness/violation.t/run.t new file mode 100644 index 0000000000..1fc408635e --- /dev/null +++ b/tests/regression/witness/violation.t/run.t @@ -0,0 +1,57 @@ +Violation witness for a correct program can be refuted by proving the program correct and returning `true`: + + $ goblint --enable ana.sv-comp.enabled --set witness.yaml.entry-types[+] violation_sequence --set ana.specification "CHECK( init(main()), LTL(G ! call(reach_error())) )" correct.c --set witness.yaml.validate correct.yml + [Info] SV-COMP specification: CHECK( init(main()), LTL(G ! call(reach_error())) ) + [Warning][Deadcode] Function 'reach_error' is uncalled: 1 LLoC (correct.c:1:1-1:20) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 2 + dead: 1 (1 in uncalled functions) + total lines: 3 + [Info][Witness] witness validation summary: + confirmed: 0 + unconfirmed: 0 + refuted: 0 + error: 0 + unchecked: 0 + unsupported: 0 + disabled: 0 + total validation entries: 0 + SV-COMP result: true + +If a correct progtam cannot be proven correct, return `unknown` for the violation witness: + + $ goblint --set ana.activated[-] expRelation --enable ana.sv-comp.functions --enable ana.sv-comp.enabled --set witness.yaml.entry-types[+] violation_sequence --set ana.specification "CHECK( init(main()), LTL(G ! call(reach_error())) )" correct-hard.c --set witness.yaml.validate correct-hard.yml + [Info] SV-COMP specification: CHECK( init(main()), LTL(G ! call(reach_error())) ) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 7 + dead: 0 + total lines: 7 + [Info][Witness] witness validation summary: + confirmed: 0 + unconfirmed: 0 + refuted: 0 + error: 0 + unchecked: 0 + unsupported: 0 + disabled: 0 + total validation entries: 0 + SV-COMP result: unknown + +Violation witness for an incorrect program cannot be proven correct, so return `unknown`: + + $ goblint --enable ana.sv-comp.enabled --set witness.yaml.entry-types[+] violation_sequence --set ana.specification "CHECK( init(main()), LTL(G ! call(reach_error())) )" incorrect.c --set witness.yaml.validate incorrect.yml + [Info] SV-COMP specification: CHECK( init(main()), LTL(G ! call(reach_error())) ) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 4 + dead: 0 + total lines: 4 + [Info][Witness] witness validation summary: + confirmed: 0 + unconfirmed: 0 + refuted: 0 + error: 0 + unchecked: 0 + unsupported: 0 + disabled: 0 + total validation entries: 0 + SV-COMP result: unknown From 8920200c71df4a855d22ef7f330eadad64aca205 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Mon, 17 Jun 2024 13:34:41 +0200 Subject: [PATCH 043/133] next try --- src/cdomains/apron/sharedFunctions.apron.ml | 53 ++++++++++++++------- 1 file changed, 37 insertions(+), 16 deletions(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 7c69cefda4..1bcc6d7202 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -6,15 +6,8 @@ open GobApron module M = Messages -let frac_of_scalar scalar = - if Scalar.is_infty scalar <> 0 then (* infinity means unbounded *) - None - else match scalar with - | Float f -> if Stdlib.Float.is_integer f then Some (Q.of_float f) else None - | Mpqf f -> Some (Z_mlgmpidl.q_of_mpqf f) - | _ -> failwith "frac_of_scalar: unsupported" -let int_of_scalar ?round (scalar: Scalar.t) = +let int_of_scalar ?(scalewith=Z.one) ?round (scalar: Scalar.t) = if Scalar.is_infty scalar <> 0 then (* infinity means unbounded *) None else @@ -28,18 +21,19 @@ let int_of_scalar ?round (scalar: Scalar.t) = | None when Stdlib.Float.is_integer f -> Some f | None -> None in - Z.of_float f + Z.(of_float f * scalewith) | Mpqf scalar -> (* octMPQ, boxMPQ, polkaMPQ *) let n = Mpqf.get_num scalar in let d = Mpqf.get_den scalar in + let scale = Z_mlgmpidl.mpz_of_z scalewith in let+ z = if Mpzf.cmp_int d 1 = 0 then (* exact integer (denominator 1) *) - Some n + Some (Mpzf.mul scale n) else begin match round with - | Some `Floor -> Some (Mpzf.fdiv_q n d) (* floor division *) - | Some `Ceil -> Some (Mpzf.cdiv_q n d) (* ceiling division *) - | None -> None + | Some `Floor -> Some (Mpzf.mul scale (Mpzf.fdiv_q n d)) (* floor division *) + | Some `Ceil -> Some (Mpzf.mul scale (Mpzf.cdiv_q n d)) (* ceiling division *) + | None -> Some (Mpzf.divexact (Mpzf.mul scale n ) d) (* scale, preferably with common denominator *) end in Z_mlgmpidl.z_of_mpzf z @@ -246,11 +240,11 @@ module CilOfApron (V: SV) = struct exception Unsupported_Linexpr1 - let cil_exp_of_linexpr1 (linexpr1:Linexpr1.t) = + let cil_exp_of_linexpr1 ?(scalewith=Z.one) (linexpr1:Linexpr1.t) = let longlong = TInt(ILongLong,[]) in let coeff_to_const consider_flip (c:Coeff.union_5) = match c with | Scalar c -> - (match int_of_scalar c with + (match int_of_scalar ~scalewith:scalewith c with | Some i -> let ci,truncation = truncateCilint ILongLong i in if truncation = NoTruncation then @@ -286,11 +280,38 @@ struct !expr + let lcm_den linexpr1 = + let exception UnsupportedScalar + in + let frac_of_scalar scalar = + if Scalar.is_infty scalar <> 0 then (* infinity means unbounded *) + None + else match scalar with + | Float f -> if Stdlib.Float.is_integer f then Some (Q.of_float f) else None + | Mpqf f -> Some (Z_mlgmpidl.q_of_mpqf f) + | _ -> raise UnsupportedScalar + in + let extract_den (c:Coeff.union_5) _ = + match c with + | Scalar c -> BatOption.map (fun q -> Q.den q) (frac_of_scalar c) + | _ -> None + in + let lcm_denom = ref (BatOption.default Z.one (extract_den (Linexpr1.get_cst linexpr1) ())) in + let lcm_coeff (c:Coeff.union_5) v = + match (extract_den c v) with + | Some z -> lcm_denom := Z.lcm z !lcm_denom + | _ -> () + in + try + Linexpr1.iter lcm_coeff linexpr1; !lcm_denom + with UnsupportedScalar -> Z.one + let cil_exp_of_lincons1 (lincons1:Lincons1.t) = let zero = Cil.kinteger ILongLong 0 in try let linexpr1 = Lincons1.get_linexpr1 lincons1 in - let cilexp = cil_exp_of_linexpr1 linexpr1 in + let common_denominator = lcm_den linexpr1 in + let cilexp = cil_exp_of_linexpr1 ~scalewith:common_denominator linexpr1 in match Lincons1.get_typ lincons1 with | EQ -> Some (Cil.constFold false @@ BinOp(Eq, cilexp, zero, TInt(IInt,[]))) | SUPEQ -> Some (Cil.constFold false @@ BinOp(Ge, cilexp, zero, TInt(IInt,[]))) From a7e4ff18c7a5f15d0bc03bcf9caa1b402d39b381 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 18 Jun 2024 10:57:24 +0200 Subject: [PATCH 044/133] Update src/cdomains/apron/sharedFunctions.apron.ml Co-authored-by: Simmo Saan --- src/cdomains/apron/sharedFunctions.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index f3cdf6f8ba..17fdb2175c 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -300,7 +300,7 @@ struct in let extract_den (c:Coeff.union_5) _ = match c with - | Scalar c -> BatOption.map (fun q -> Q.den q) (frac_of_scalar c) + | Scalar c -> BatOption.map Q.den (frac_of_scalar c) | _ -> None in let lcm_denom = ref (BatOption.default Z.one (extract_den (Linexpr1.get_cst linexpr1) ())) in From 7876d6b3c38f79c50d1361e62d8ab20f0d2e49fe Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 18 Jun 2024 10:58:06 +0200 Subject: [PATCH 045/133] Update src/cdomains/apron/sharedFunctions.apron.ml Co-authored-by: Simmo Saan --- src/cdomains/apron/sharedFunctions.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 17fdb2175c..656fe0b9bd 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -251,7 +251,7 @@ struct let longlong = TInt(ILongLong,[]) in let coeff_to_const consider_flip (c:Coeff.union_5) = match c with | Scalar c -> - (match int_of_scalar ~scalewith:scalewith c with + (match int_of_scalar ?scalewith c with | Some i -> let ci,truncation = truncateCilint ILongLong i in if truncation = NoTruncation then From e4cd4df9d9f3c6678596060c11efd058466d0f6d Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 18 Jun 2024 10:58:17 +0200 Subject: [PATCH 046/133] Update src/cdomains/apron/sharedFunctions.apron.ml Co-authored-by: Simmo Saan --- src/cdomains/apron/sharedFunctions.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 656fe0b9bd..022e60200d 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -247,7 +247,7 @@ module CilOfApron (V: SV) = struct exception Unsupported_Linexpr1 - let cil_exp_of_linexpr1 ?(scalewith=Z.one) (linexpr1:Linexpr1.t) = + let cil_exp_of_linexpr1 ?scalewith (linexpr1:Linexpr1.t) = let longlong = TInt(ILongLong,[]) in let coeff_to_const consider_flip (c:Coeff.union_5) = match c with | Scalar c -> From 4812b07e58b7c854e2fc4c25763101cb73800e69 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 18 Jun 2024 13:41:00 +0300 Subject: [PATCH 047/133] Avoid unused value warning on LibraryFunctions.all_library_descs --- src/util/library/libraryFunctions.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/util/library/libraryFunctions.ml b/src/util/library/libraryFunctions.ml index 4e678c926e..e7ff2a4d04 100644 --- a/src/util/library/libraryFunctions.ml +++ b/src/util/library/libraryFunctions.ml @@ -1246,7 +1246,7 @@ let libraries = descs_tbl ) libraries -let all_library_descs: (string, LibraryDesc.t) Hashtbl.t = +let _all_library_descs: (string, LibraryDesc.t) Hashtbl.t = Hashtbl.fold (fun _ descs_tbl acc -> Hashtbl.merge (fun name desc1 desc2 -> match desc1, desc2 with From d5f67cb1d1c811a8b207e4095deebc7836d302e9 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 18 Jun 2024 15:49:36 +0300 Subject: [PATCH 048/133] Fix ctx.split and ctx.spawn in non-call transfer functions Since OCaml evaluates arguments right-to-left, !r and !spawns are dereferenced before calling the transfer function, which will populate them (uselessly). By using let, evaluation order is enforced. --- src/framework/constraints.ml | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index e0e36801ed..7df4167acd 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -713,11 +713,13 @@ struct let tf_assign var edge prev_node lv e getl sidel getg sideg d = let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in - common_join ctx (S.assign ctx lv e) !r !spawns + let d = S.assign ctx lv e in (* Force transfer function to be evaluated before dereferencing in common_join argument. *) + common_join ctx d !r !spawns let tf_vdecl var edge prev_node v getl sidel getg sideg d = let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in - common_join ctx (S.vdecl ctx v) !r !spawns + let d = S.vdecl ctx v in (* Force transfer function to be evaluated before dereferencing in common_join argument. *) + common_join ctx d !r !spawns let normal_return r fd ctx sideg = let spawning_return = S.return ctx r fd in @@ -732,7 +734,7 @@ struct let tf_ret var edge prev_node ret fd getl sidel getg sideg d = let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in - let d = + let d = (* Force transfer function to be evaluated before dereferencing in common_join argument. *) if (CilType.Fundec.equal fd MyCFG.dummy_func || List.mem fd.svar.vname (get_string_list "mainfun")) && get_bool "kernel" @@ -747,11 +749,13 @@ struct let c: unit -> S.C.t = snd var |> Obj.obj in side_context sideg fd (c ()); let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in - common_join ctx (S.body ctx fd) !r !spawns + let d = S.body ctx fd in (* Force transfer function to be evaluated before dereferencing in common_join argument. *) + common_join ctx d !r !spawns let tf_test var edge prev_node e tv getl sidel getg sideg d = let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in - common_join ctx (S.branch ctx e tv) !r !spawns + let d = S.branch ctx e tv in (* Force transfer function to be evaluated before dereferencing in common_join argument. *) + common_join ctx d !r !spawns let tf_normal_call ctx lv e (f:fundec) args getl sidel getg sideg = let combine (cd, fc, fd) = @@ -870,11 +874,13 @@ struct let tf_asm var edge prev_node getl sidel getg sideg d = let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in - common_join ctx (S.asm ctx) !r !spawns + let d = S.asm ctx in (* Force transfer function to be evaluated before dereferencing in common_join argument. *) + common_join ctx d !r !spawns let tf_skip var edge prev_node getl sidel getg sideg d = let ctx, r, spawns = common_ctx var edge prev_node d getl sidel getg sideg in - common_join ctx (S.skip ctx) !r !spawns + let d = S.skip ctx in (* Force transfer function to be evaluated before dereferencing in common_join argument. *) + common_join ctx d !r !spawns let tf var getl sidel getg sideg prev_node edge d = begin match edge with From 62f01a9778ccc61b3894a292a522ee397394ab5f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 18 Jun 2024 18:05:57 +0300 Subject: [PATCH 049/133] Add cram test for int witness invariants --- tests/regression/witness/int.t/int.c | 17 ++++++++++ tests/regression/witness/int.t/run.t | 47 ++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+) create mode 100644 tests/regression/witness/int.t/int.c create mode 100644 tests/regression/witness/int.t/run.t diff --git a/tests/regression/witness/int.t/int.c b/tests/regression/witness/int.t/int.c new file mode 100644 index 0000000000..4ad15b09ad --- /dev/null +++ b/tests/regression/witness/int.t/int.c @@ -0,0 +1,17 @@ +#include +extern int __VERIFIER_nondet_int(); + +int main() { + int i; + i = __VERIFIER_nondet_int(); + + if (i < 100) + __goblint_check(1); + + if (50 < i && i < 100) + __goblint_check(1); + + if (i == 42 || i == 5 || i == 101) + __goblint_check(1); + return 0; +} diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t new file mode 100644 index 0000000000..28c670d475 --- /dev/null +++ b/tests/regression/witness/int.t/run.t @@ -0,0 +1,47 @@ + $ goblint --enable ana.sv-comp.functions --enable witness.yaml.enabled --set witness.yaml.entry-types '["location_invariant"]' --enable ana.int.def_exc --enable ana.int.enums --enable ana.int.interval --enable ana.int.congruence --enable ana.int.interval_set --disable witness.invariant.split-conjunction int.c + [Success][Assert] Assertion "1" will succeed (int.c:9:5-9:23) + [Success][Assert] Assertion "1" will succeed (int.c:12:5-12:23) + [Success][Assert] Assertion "1" will succeed (int.c:15:5-15:23) + [Info][Deadcode] Logical lines of code (LLoC) summary: + live: 10 + dead: 0 + total lines: 10 + [Info][Witness] witness generation summary: + total generation entries: 3 + + $ yamlWitnessStrip < witness.yml + - entry_type: location_invariant + location: + file_name: int.c + file_hash: $FILE_HASH + line: 15 + column: 5 + function: main + location_invariant: + string: ((((0 <= i && i <= 127) && i != 0) && (5 <= i && i <= 101)) && ((i == + 5 || i == 42) || i == 101)) && ((i == 5 || i == 42) || i == 101) + type: assertion + format: C + - entry_type: location_invariant + location: + file_name: int.c + file_hash: $FILE_HASH + line: 12 + column: 5 + function: main + location_invariant: + string: (((0 <= i && i != 0) && (51 <= i && i <= 99)) && (0 <= i && i != 0)) && + (51 <= i && i <= 99) + type: assertion + format: C + - entry_type: location_invariant + location: + file_name: int.c + file_hash: $FILE_HASH + line: 9 + column: 5 + function: main + location_invariant: + string: i <= 99 && i <= 99 + type: assertion + format: C From ca5f0646bc18d055d36501b9db5ca72d09854818 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:25:32 +0300 Subject: [PATCH 050/133] Extract inclusion list invariant in IntDomain --- src/cdomain/value/cdomains/intDomain.ml | 30 ++++++++++++++++--------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index c525732d3b..89be71ea92 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -582,6 +582,24 @@ module IntervalArith (Ints_t : IntOps.IntOps) = struct List.exists (Z.equal l) ts end +module IntInvariant = +struct + let of_incl_list e ik ps = + match ps with + | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> + assert (List.mem Z.zero ps); + assert (List.mem Z.one ps); + Invariant.none + | [_] when get_bool "witness.invariant.exact" -> + Invariant.none + | _ :: _ :: _ + | [_] | [] -> + List.fold_left (fun a x -> + let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in + Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) + ) (Invariant.bot ()) ps +end + module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = struct let name () = "intervals" @@ -2731,19 +2749,11 @@ module Enums : S with type int_t = Z.t = struct let ne ik x y = c_lognot ik (eq ik x y) let invariant_ikind e ik x = - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in match x with - | Inc ps when not inexact_type_bounds && ik = IBool && is_top_of ik x -> - Invariant.none | Inc ps -> - if BISet.cardinal ps > 1 || get_bool "witness.invariant.exact" then - BISet.fold (fun x a -> - let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in - Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) ps (Invariant.bot ()) - else - Invariant.top () + IntInvariant.of_incl_list e ik (BISet.elements ps) | Exc (ns, r) -> + let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in (* Emit range invariant if tighter than ikind bounds. This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in From e767f90fdcce9eb4348341129915a515d2539d4e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:26:43 +0300 Subject: [PATCH 051/133] Simplify inclusion list invariants --- src/cdomain/value/cdomains/intDomain.ml | 12 ++++++---- .../56-witness/46-top-bool-invariant.t | 24 +------------------ tests/regression/witness/int.t/run.t | 3 +-- 3 files changed, 10 insertions(+), 29 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 89be71ea92..b9723bdb5b 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3797,10 +3797,14 @@ module IntDomTupleImpl = struct else Invariant.top () | None -> - let is = to_list (mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.invariant_ikind e ik } x) - in List.fold_left (fun a i -> - Invariant.(a && i) - ) (Invariant.top ()) is + match to_incl_list x with + | Some ps -> + IntInvariant.of_incl_list e ik ps + | None -> + let is = to_list (mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.invariant_ikind e ik } x) + in List.fold_left (fun a i -> + Invariant.(a && i) + ) (Invariant.top ()) is let arbitrary ik = QCheck.(set_print show @@ tup5 (option (I1.arbitrary ik)) (option (I2.arbitrary ik)) (option (I3.arbitrary ik)) (option (I4.arbitrary ik)) (option (I5.arbitrary ik))) diff --git a/tests/regression/56-witness/46-top-bool-invariant.t b/tests/regression/56-witness/46-top-bool-invariant.t index b04d33dda8..741b00966f 100644 --- a/tests/regression/56-witness/46-top-bool-invariant.t +++ b/tests/regression/56-witness/46-top-bool-invariant.t @@ -144,7 +144,7 @@ all: dead: 0 total lines: 2 [Info][Witness] witness generation summary: - total generation entries: 3 + total generation entries: 1 $ yamlWitnessStrip < witness.yml - entry_type: location_invariant @@ -158,28 +158,6 @@ all: string: x == (_Bool)0 || x == (_Bool)1 type: assertion format: C - - entry_type: location_invariant - location: - file_name: 46-top-bool-invariant.c - file_hash: $FILE_HASH - line: 5 - column: 3 - function: main - location_invariant: - string: x <= (_Bool)1 - type: assertion - format: C - - entry_type: location_invariant - location: - file_name: 46-top-bool-invariant.c - file_hash: $FILE_HASH - line: 5 - column: 3 - function: main - location_invariant: - string: (_Bool)0 <= x - type: assertion - format: C all without inexact-type-bounds: diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index 28c670d475..6f75a2cd17 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -18,8 +18,7 @@ column: 5 function: main location_invariant: - string: ((((0 <= i && i <= 127) && i != 0) && (5 <= i && i <= 101)) && ((i == - 5 || i == 42) || i == 101)) && ((i == 5 || i == 42) || i == 101) + string: (i == 5 || i == 42) || i == 101 type: assertion format: C - entry_type: location_invariant From 176941d1a1582f45eec20ad5d3f9c1d648bffc7d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:34:09 +0300 Subject: [PATCH 052/133] Extract definite int invariant in IntDomain --- src/cdomain/value/cdomains/intDomain.ml | 29 ++++++++++--------------- 1 file changed, 11 insertions(+), 18 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index b9723bdb5b..f0715c2e57 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -584,6 +584,12 @@ end module IntInvariant = struct + let of_int e ik x = + if get_bool "witness.invariant.exact" then + Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) + else + Invariant.none + let of_incl_list e ik ps = match ps with | [_; _] when ik = IBool && not (get_bool "witness.invariant.inexact-type-bounds") -> @@ -936,11 +942,7 @@ struct let invariant_ikind e ik x = match x with | Some (x1, x2) when Ints_t.compare x1 x2 = 0 -> - if get_bool "witness.invariant.exact" then - let x1 = Ints_t.to_bigint x1 in - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x1, intType)) - else - Invariant.top () + IntInvariant.of_int e ik (Ints_t.to_bigint x1) | Some (x1, x2) -> let (min_ik, max_ik) = range ik in let (x1', x2') = BatTuple.Tuple2.mapn (Ints_t.to_bigint) (x1, x2) in @@ -2315,10 +2317,7 @@ struct let invariant_ikind e ik (x:t) = match x with | `Definite x -> - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) - else - Invariant.top () + IntInvariant.of_int e ik x | `Excluded (s, r) -> (* Emit range invariant if tighter than ikind bounds. This can be more precise than interval, which has been widened. *) @@ -3253,10 +3252,7 @@ struct match x with | x when is_top x -> Invariant.top () | Some (c, m) when m =: Z.zero -> - if get_bool "witness.invariant.exact" then - Invariant.of_exp Cil.(BinOp (Eq, e, Cil.kintegerCilint ik c, intType)) - else - Invariant.top () + IntInvariant.of_int e ik c | Some (c, m) -> let open Cil in let (c, m) = BatTuple.Tuple2.mapn (fun a -> kintegerCilint ik a) (c, m) in @@ -3791,11 +3787,8 @@ module IntDomTupleImpl = struct let invariant_ikind e ik x = match to_int x with | Some v -> - if get_bool "witness.invariant.exact" then - (* If definite, output single equality instead of every subdomain repeating same equality *) - Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik v, intType)) - else - Invariant.top () + (* If definite, output single equality instead of every subdomain repeating same equality *) + IntInvariant.of_int e ik v | None -> match to_incl_list x with | Some ps -> From 250196bfb9ee6f2cd2195cc9b46b1c275452a731 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:44:39 +0300 Subject: [PATCH 053/133] Extract interval invariant in IntDomain --- src/cdomain/value/cdomains/intDomain.ml | 44 ++++++++++--------------- 1 file changed, 18 insertions(+), 26 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index f0715c2e57..bdd403bbce 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -604,6 +604,17 @@ struct let i = Invariant.of_exp Cil.(BinOp (Eq, e, kintegerCilint ik x, intType)) in Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) (Invariant.bot ()) ps + + let of_interval e ik (x1, x2) = + if Z.equal x1 x2 then + of_int e ik x1 + else ( + let (min_ik, max_ik) = Size.range ik in + let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in + let i1 = if inexact_type_bounds || Z.compare min_ik x1 <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) else Invariant.none in + let i2 = if inexact_type_bounds || Z.compare x2 max_ik <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) else Invariant.none in + Invariant.(i1 && i2) + ) end module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = @@ -939,17 +950,10 @@ struct else if Ints_t.compare y2 x1 <= 0 then of_bool ik false else top_bool - let invariant_ikind e ik x = - match x with - | Some (x1, x2) when Ints_t.compare x1 x2 = 0 -> - IntInvariant.of_int e ik (Ints_t.to_bigint x1) + let invariant_ikind e ik = function | Some (x1, x2) -> - let (min_ik, max_ik) = range ik in - let (x1', x2') = BatTuple.Tuple2.mapn (Ints_t.to_bigint) (x1, x2) in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = if inexact_type_bounds || Ints_t.compare min_ik x1 <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1', e, intType)) else Invariant.none in - let i2 = if inexact_type_bounds || Ints_t.compare x2 max_ik <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2', intType)) else Invariant.none in - Invariant.(i1 && i2) + let (x1', x2') = BatTuple.Tuple2.mapn Ints_t.to_bigint (x1, x2) in + IntInvariant.of_interval e ik (x1', x2') | None -> Invariant.none let arbitrary ik = @@ -2322,17 +2326,11 @@ struct (* Emit range invariant if tighter than ikind bounds. This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let (ikmin, ikmax) = - let ikr = size ik in - (Exclusion.min_of_range ikr, Exclusion.max_of_range ikr) - in - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let imin = if inexact_type_bounds || Z.compare ikmin rmin <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik rmin, e, intType)) else Invariant.none in - let imax = if inexact_type_bounds || Z.compare rmax ikmax <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik rmax, intType)) else Invariant.none in + let ri = IntInvariant.of_interval e ik (rmin, rmax) in S.fold (fun x a -> let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in Invariant.(a && i) - ) s Invariant.(imin && imax) + ) s ri | `Bot -> Invariant.none let arbitrary ik = @@ -2752,20 +2750,14 @@ module Enums : S with type int_t = Z.t = struct | Inc ps -> IntInvariant.of_incl_list e ik (BISet.elements ps) | Exc (ns, r) -> - let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in (* Emit range invariant if tighter than ikind bounds. This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in - let (ikmin, ikmax) = - let ikr = size ik in - (Exclusion.min_of_range ikr, Exclusion.max_of_range ikr) - in - let imin = if inexact_type_bounds || Z.compare ikmin rmin <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik rmin, e, intType)) else Invariant.none in - let imax = if inexact_type_bounds || Z.compare rmax ikmax <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik rmax, intType)) else Invariant.none in + let ri = IntInvariant.of_interval e ik (rmin, rmax) in BISet.fold (fun x a -> let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in Invariant.(a && i) - ) ns Invariant.(imin && imax) + ) ns ri let arbitrary ik = From 9a25b4859c45671b416281784e26f8e1781ca7b2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 11:49:15 +0300 Subject: [PATCH 054/133] Extract exclusion list invariant in IntDomain --- src/cdomain/value/cdomains/intDomain.ml | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index bdd403bbce..79c672f689 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -615,6 +615,12 @@ struct let i2 = if inexact_type_bounds || Z.compare x2 max_ik <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) else Invariant.none in Invariant.(i1 && i2) ) + + let of_excl_list e ik ns = + List.fold_left (fun a x -> + let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in + Invariant.(a && i) + ) (Invariant.top ()) ns end module IntervalFunctor (Ints_t : IntOps.IntOps): SOverflow with type int_t = Ints_t.t and type t = (Ints_t.t * Ints_t.t) option = @@ -2327,10 +2333,8 @@ struct This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in let ri = IntInvariant.of_interval e ik (rmin, rmax) in - S.fold (fun x a -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) s ri + let si = IntInvariant.of_excl_list e ik (S.elements s) in + Invariant.(ri && si) | `Bot -> Invariant.none let arbitrary ik = @@ -2754,10 +2758,8 @@ module Enums : S with type int_t = Z.t = struct This can be more precise than interval, which has been widened. *) let (rmin, rmax) = (Exclusion.min_of_range r, Exclusion.max_of_range r) in let ri = IntInvariant.of_interval e ik (rmin, rmax) in - BISet.fold (fun x a -> - let i = Invariant.of_exp Cil.(BinOp (Ne, e, kintegerCilint ik x, intType)) in - Invariant.(a && i) - ) ns ri + let nsi = IntInvariant.of_excl_list e ik (BISet.elements ns) in + Invariant.(ri && nsi) let arbitrary ik = From d1f04bc23150d0b186d52f1ccaf170f54916bd8f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:35:20 +0300 Subject: [PATCH 055/133] Simplify interval and exclusion list invariants --- src/cdomain/value/cdomains/intDomain.ml | 39 ++++++++++++++++++------- tests/regression/cfg/foo.t/run.t | 24 +-------------- tests/regression/witness/int.t/run.t | 3 +- 3 files changed, 30 insertions(+), 36 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 79c672f689..8860a8fbb5 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -605,16 +605,28 @@ struct Invariant.(a || i) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) ) (Invariant.bot ()) ps - let of_interval e ik (x1, x2) = - if Z.equal x1 x2 then + let of_interval_opt e ik = function + | (Some x1, Some x2) when Z.equal x1 x2 -> of_int e ik x1 - else ( + | x1_opt, x2_opt -> let (min_ik, max_ik) = Size.range ik in let inexact_type_bounds = get_bool "witness.invariant.inexact-type-bounds" in - let i1 = if inexact_type_bounds || Z.compare min_ik x1 <> 0 then Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) else Invariant.none in - let i2 = if inexact_type_bounds || Z.compare x2 max_ik <> 0 then Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) else Invariant.none in + let i1 = + match x1_opt, inexact_type_bounds with + | Some x1, false when Z.equal min_ik x1 -> Invariant.none + | Some x1, _ -> Invariant.of_exp Cil.(BinOp (Le, kintegerCilint ik x1, e, intType)) + | None, _ -> Invariant.none + in + let i2 = + match x2_opt, inexact_type_bounds with + | Some x2, false when Z.equal x2 max_ik -> Invariant.none + | Some x2, _ -> Invariant.of_exp Cil.(BinOp (Le, e, kintegerCilint ik x2, intType)) + | None, _ -> Invariant.none + in Invariant.(i1 && i2) - ) + + let of_interval e ik (x1, x2) = + of_interval_opt e ik (Some x1, Some x2) let of_excl_list e ik ns = List.fold_left (fun a x -> @@ -3778,7 +3790,7 @@ module IntDomTupleImpl = struct | Some v when not (GobConfig.get_bool "dbg.full-output") -> BatPrintf.fprintf f "\n\n%s\n\n\n" (Z.to_string v) | _ -> BatPrintf.fprintf f "\n\n%s\n\n\n" (show x) - let invariant_ikind e ik x = + let invariant_ikind e ik ((_, _, _, x_cong, x_intset) as x) = match to_int x with | Some v -> (* If definite, output single equality instead of every subdomain repeating same equality *) @@ -3788,10 +3800,15 @@ module IntDomTupleImpl = struct | Some ps -> IntInvariant.of_incl_list e ik ps | None -> - let is = to_list (mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.invariant_ikind e ik } x) - in List.fold_left (fun a i -> - Invariant.(a && i) - ) (Invariant.top ()) is + let min = minimal x in + let max = maximal x in + let ns = Option.map fst (to_excl_list x) |? [] in + Invariant.( + IntInvariant.of_interval_opt e ik (min, max) && + IntInvariant.of_excl_list e ik ns && + Option.map_default (I4.invariant_ikind e ik) Invariant.none x_cong && + Option.map_default (I5.invariant_ikind e ik) Invariant.none x_intset + ) let arbitrary ik = QCheck.(set_print show @@ tup5 (option (I1.arbitrary ik)) (option (I2.arbitrary ik)) (option (I3.arbitrary ik)) (option (I4.arbitrary ik)) (option (I5.arbitrary ik))) diff --git a/tests/regression/cfg/foo.t/run.t b/tests/regression/cfg/foo.t/run.t index 02f6c1e5e0..705fb8d497 100644 --- a/tests/regression/cfg/foo.t/run.t +++ b/tests/regression/cfg/foo.t/run.t @@ -67,7 +67,7 @@ total lines: 6 [Warning][Deadcode][CWE-571] condition 'a > 0' (possibly inserted by CIL) is always true (foo.c:3:10-3:20) [Info][Witness] witness generation summary: - total generation entries: 15 + total generation entries: 13 $ yamlWitnessStrip < witness.yml - entry_type: loop_invariant @@ -125,17 +125,6 @@ string: 1 <= a type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 7 - column: 3 - function: main - location_invariant: - string: 0 <= a - type: assertion - format: C - entry_type: location_invariant location: file_name: foo.c @@ -224,14 +213,3 @@ string: 1 <= a type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 4 - column: 5 - function: main - location_invariant: - string: 0 <= a - type: assertion - format: C diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index 6f75a2cd17..33316791e7 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -29,8 +29,7 @@ column: 5 function: main location_invariant: - string: (((0 <= i && i != 0) && (51 <= i && i <= 99)) && (0 <= i && i != 0)) && - (51 <= i && i <= 99) + string: (51 <= i && i <= 99) && ((i != 0 && i != 0) && (51 <= i && i <= 99)) type: assertion format: C - entry_type: location_invariant From 39f6c2d8d0d1c4f059263bba840fec4cb5aead34 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:41:09 +0300 Subject: [PATCH 056/133] Deduplicate inclusion list elements in IntDomTuple --- src/cdomain/value/cdomains/intDomain.ml | 2 +- tests/regression/witness/int.t/run.t | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 8860a8fbb5..c2eb2f3aa5 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3536,7 +3536,7 @@ module IntDomTupleImpl = struct let merge ps = let (vs, rs) = List.split ps in let (mins, maxs) = List.split rs in - (List.concat vs, (List.min mins, List.max maxs)) + (List.concat vs |> List.sort_uniq Z.compare, (List.min mins, List.max maxs)) in mapp2 { fp2 = fun (type a) (module I:SOverflow with type t = a and type int_t = int_t) -> I.to_excl_list } x |> flat merge diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index 33316791e7..2bf5bd31c3 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -29,7 +29,7 @@ column: 5 function: main location_invariant: - string: (51 <= i && i <= 99) && ((i != 0 && i != 0) && (51 <= i && i <= 99)) + string: (51 <= i && i <= 99) && (i != 0 && (51 <= i && i <= 99)) type: assertion format: C - entry_type: location_invariant From 2408ab6ae413a4bfcefa149c5a76d086382e3f86 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:44:40 +0300 Subject: [PATCH 057/133] Filter out-of-invariant exclusion list elements in IntDomTuple invariant --- src/cdomain/value/cdomains/intDomain.ml | 2 ++ tests/regression/cfg/foo.t/run.t | 35 +------------------------ tests/regression/witness/int.t/run.t | 2 +- 3 files changed, 4 insertions(+), 35 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index c2eb2f3aa5..a472a5017e 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3803,6 +3803,8 @@ module IntDomTupleImpl = struct let min = minimal x in let max = maximal x in let ns = Option.map fst (to_excl_list x) |? [] in + let ns = Option.map_default (fun min -> List.filter (Z.leq min) ns) ns min in + let ns = Option.map_default (fun max -> List.filter (Z.geq max) ns) ns max in Invariant.( IntInvariant.of_interval_opt e ik (min, max) && IntInvariant.of_excl_list e ik ns && diff --git a/tests/regression/cfg/foo.t/run.t b/tests/regression/cfg/foo.t/run.t index 705fb8d497..cd890b7a19 100644 --- a/tests/regression/cfg/foo.t/run.t +++ b/tests/regression/cfg/foo.t/run.t @@ -67,7 +67,7 @@ total lines: 6 [Warning][Deadcode][CWE-571] condition 'a > 0' (possibly inserted by CIL) is always true (foo.c:3:10-3:20) [Info][Witness] witness generation summary: - total generation entries: 13 + total generation entries: 10 $ yamlWitnessStrip < witness.yml - entry_type: loop_invariant @@ -103,17 +103,6 @@ string: b == 0 type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 7 - column: 3 - function: main - location_invariant: - string: a != 0 - type: assertion - format: C - entry_type: location_invariant location: file_name: foo.c @@ -147,17 +136,6 @@ string: b != 0 type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 5 - column: 5 - function: main - location_invariant: - string: a != 1 - type: assertion - format: C - entry_type: location_invariant location: file_name: foo.c @@ -191,17 +169,6 @@ string: b != 0 type: assertion format: C - - entry_type: location_invariant - location: - file_name: foo.c - file_hash: $FILE_HASH - line: 4 - column: 5 - function: main - location_invariant: - string: a != 0 - type: assertion - format: C - entry_type: location_invariant location: file_name: foo.c diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index 2bf5bd31c3..bc8ad5ac0a 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -29,7 +29,7 @@ column: 5 function: main location_invariant: - string: (51 <= i && i <= 99) && (i != 0 && (51 <= i && i <= 99)) + string: (51 <= i && i <= 99) && (51 <= i && i <= 99) type: assertion format: C - entry_type: location_invariant From 0a27c74d21a66a34abd5ecb6bbfe052d064fa261 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:57:06 +0300 Subject: [PATCH 058/133] Document nicer IntDomTuple invariant --- src/cdomain/value/cdomains/intDomain.ml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index a472a5017e..797c0f46c1 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3793,23 +3793,26 @@ module IntDomTupleImpl = struct let invariant_ikind e ik ((_, _, _, x_cong, x_intset) as x) = match to_int x with | Some v -> - (* If definite, output single equality instead of every subdomain repeating same equality *) + (* If definite, output single equality instead of every subdomain repeating same equality (or something less precise). *) IntInvariant.of_int e ik v | None -> match to_incl_list x with | Some ps -> + (* If inclusion set, output disjunction of equalities because it subsumes interval(s), exclusion set and congruence. *) IntInvariant.of_incl_list e ik ps | None -> + (* Get interval bounds from all domains (intervals and exclusion set ranges). *) let min = minimal x in let max = maximal x in - let ns = Option.map fst (to_excl_list x) |? [] in + let ns = Option.map fst (to_excl_list x) |? [] in (* Ignore exclusion set bit range, known via interval bounds already. *) + (* "Refine" out-of-bounds exclusions for simpler output. *) let ns = Option.map_default (fun min -> List.filter (Z.leq min) ns) ns min in let ns = Option.map_default (fun max -> List.filter (Z.geq max) ns) ns max in Invariant.( - IntInvariant.of_interval_opt e ik (min, max) && + IntInvariant.of_interval_opt e ik (min, max) && (* Output best interval bounds once instead of multiple subdomains repeating them (or less precise ones). *) IntInvariant.of_excl_list e ik ns && - Option.map_default (I4.invariant_ikind e ik) Invariant.none x_cong && - Option.map_default (I5.invariant_ikind e ik) Invariant.none x_intset + Option.map_default (I4.invariant_ikind e ik) Invariant.none x_cong && (* Output congruence as is. *) + Option.map_default (I5.invariant_ikind e ik) Invariant.none x_intset (* Output interval sets as is. *) ) let arbitrary ik = QCheck.(set_print show @@ tup5 (option (I1.arbitrary ik)) (option (I2.arbitrary ik)) (option (I3.arbitrary ik)) (option (I4.arbitrary ik)) (option (I5.arbitrary ik))) From 02ef2f96d96e15bf94231dfdc5ddebe7b6d3606b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 19 Jun 2024 12:59:08 +0300 Subject: [PATCH 059/133] Disable interval set in witness int invariant cram test --- tests/regression/witness/int.t/run.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/regression/witness/int.t/run.t b/tests/regression/witness/int.t/run.t index bc8ad5ac0a..6b4784ce32 100644 --- a/tests/regression/witness/int.t/run.t +++ b/tests/regression/witness/int.t/run.t @@ -1,4 +1,4 @@ - $ goblint --enable ana.sv-comp.functions --enable witness.yaml.enabled --set witness.yaml.entry-types '["location_invariant"]' --enable ana.int.def_exc --enable ana.int.enums --enable ana.int.interval --enable ana.int.congruence --enable ana.int.interval_set --disable witness.invariant.split-conjunction int.c + $ goblint --enable ana.sv-comp.functions --enable witness.yaml.enabled --set witness.yaml.entry-types '["location_invariant"]' --enable ana.int.def_exc --enable ana.int.enums --enable ana.int.interval --enable ana.int.congruence --disable ana.int.interval_set --disable witness.invariant.split-conjunction int.c [Success][Assert] Assertion "1" will succeed (int.c:9:5-9:23) [Success][Assert] Assertion "1" will succeed (int.c:12:5-12:23) [Success][Assert] Assertion "1" will succeed (int.c:15:5-15:23) @@ -29,7 +29,7 @@ column: 5 function: main location_invariant: - string: (51 <= i && i <= 99) && (51 <= i && i <= 99) + string: 51 <= i && i <= 99 type: assertion format: C - entry_type: location_invariant @@ -40,6 +40,6 @@ column: 5 function: main location_invariant: - string: i <= 99 && i <= 99 + string: i <= 99 type: assertion format: C From c9ea4408e20c8968912c7773677b696c6f050222 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Wed, 19 Jun 2024 15:49:17 +0300 Subject: [PATCH 060/133] Binops on offsets should not generate overflow warnings in SV-COMP --- src/cdomain/value/cdomains/offset.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomain/value/cdomains/offset.ml b/src/cdomain/value/cdomains/offset.ml index fa64f71daa..e8cba0afc5 100644 --- a/src/cdomain/value/cdomains/offset.ml +++ b/src/cdomain/value/cdomains/offset.ml @@ -213,7 +213,7 @@ struct 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 + GobRef.wrap AnalysisState.executing_speculative_computations true @@ fun () -> Idx.add bits_offset remaining_offset | `Index (x, o) -> let (item_typ, item_size_in_bits) = match Option.map unrollType typ with From 545206f68a9dee4999860ec4ce6232f214d65516 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Wed, 19 Jun 2024 16:07:19 +0300 Subject: [PATCH 061/133] Add some info about overflows on pointer arithmetics to assumptions --- docs/user-guide/assumptions.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/docs/user-guide/assumptions.md b/docs/user-guide/assumptions.md index f77e3b5097..16386987de 100644 --- a/docs/user-guide/assumptions.md +++ b/docs/user-guide/assumptions.md @@ -17,3 +17,12 @@ _NB! This list is likely incomplete._ See [PR #1414](https://github.com/goblint/analyzer/pull/1414). +2. Goblint's does not give any guarantees about overflows not happening during pointer arithmetics. + + Although the analysis can detect and warn about overflows that might happen during operations with pointer offsets, + the analysis does not warn about overflows from operations with the possible addresses (as integers) of the pointers themselves. + + This affects the `no-overflows` analysis from `ana.int.interval` analysis. + + See further discussion from [PR #1511](https://github.com/goblint/analyzer/pull/1511). + From 06086c646285037bcb242dc70705fbaa690e8ebd Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 20 Jun 2024 17:55:07 +0300 Subject: [PATCH 062/133] Refactor YAML witness validation result passing --- src/framework/control.ml | 14 +++++++++----- src/witness/witness.ml | 25 ++++++++----------------- src/witness/yamlWitness.ml | 16 +++++++++++++++- 3 files changed, 32 insertions(+), 23 deletions(-) diff --git a/src/framework/control.ml b/src/framework/control.ml index 05fad90caf..bb1d7bab58 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -789,15 +789,19 @@ struct ); (* Before SV-COMP, so result can depend on YAML witness validation. *) - if get_string "witness.yaml.validate" <> "" then ( - let module YWitness = YamlWitness.Validator (R) in - YWitness.validate () - ); + let yaml_validate_result = + if get_string "witness.yaml.validate" <> "" then ( + let module YWitness = YamlWitness.Validator (R) in + Some (YWitness.validate ()) + ) + else + None + in if get_bool "ana.sv-comp.enabled" then ( (* SV-COMP and witness generation *) let module WResult = Witness.Result (R) in - WResult.write entrystates + WResult.write yaml_validate_result entrystates ); if get_bool "witness.yaml.enabled" then ( diff --git a/src/witness/witness.ml b/src/witness/witness.ml index fb88c2ce7b..651e7a76d5 100644 --- a/src/witness/witness.ml +++ b/src/witness/witness.ml @@ -690,25 +690,16 @@ struct Timing.wrap "graphml witness" (write_file witness_path (module Task)) (module TaskResult) ) - let write entrystates = + let write yaml_validate_result entrystates = match !AnalysisState.verified with | Some false -> print_svcomp_result "ERROR (verify)" | _ -> - if get_string "witness.yaml.validate" <> "" then ( - match get_bool "witness.yaml.strict" with - | true when !YamlWitness.cnt_error > 0 -> - print_svcomp_result "ERROR (witness error)" - | true when !YamlWitness.cnt_unsupported > 0 -> - print_svcomp_result "ERROR (witness unsupported)" - | true when !YamlWitness.cnt_disabled > 0 -> - print_svcomp_result "ERROR (witness disabled)" - | _ when !YamlWitness.cnt_refuted > 0 -> - print_svcomp_result (Result.to_string (False None)) - | _ when !YamlWitness.cnt_unconfirmed > 0 -> - print_svcomp_result (Result.to_string Unknown) - | _ -> - write entrystates - ) - else + match yaml_validate_result with + | Some (Error msg) -> + print_svcomp_result ("ERROR (" ^ msg ^ ")") + | Some (Ok (Svcomp.Result.False _ | Unknown as result)) -> + print_svcomp_result (Result.to_string result) + | Some (Ok True) + | None -> write entrystates end diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 42254f30de..71bb75afef 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -840,5 +840,19 @@ struct let certificate_path = GobConfig.get_string "witness.yaml.certificate" in if certificate_path <> "" then - yaml_entries_to_file (List.rev yaml_entries') (Fpath.v certificate_path) + yaml_entries_to_file (List.rev yaml_entries') (Fpath.v certificate_path); + + match GobConfig.get_bool "witness.yaml.strict" with + | true when !cnt_error > 0 -> + Error "witness error" + | true when !cnt_unsupported > 0 -> + Error "witness unsupported" + | true when !cnt_disabled > 0 -> + Error "witness disabled" + | _ when !cnt_refuted > 0 -> + Ok (Svcomp.Result.False None) + | _ when !cnt_unconfirmed > 0 -> + Ok Unknown + | _ -> + Ok True end From a74840942fabc3231eb41eb62ce073a35b667971 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 21 Jun 2024 13:20:34 +0300 Subject: [PATCH 063/133] Upgrade locked opam dependencies --- goblint.opam.locked | 91 ++++++++++++++++++++++++--------------------- gobview | 2 +- 2 files changed, 49 insertions(+), 44 deletions(-) diff --git a/goblint.opam.locked b/goblint.opam.locked index d532457ced..410d363ac8 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -21,89 +21,94 @@ homepage: "https://goblint.in.tum.de" doc: "https://goblint.readthedocs.io/en/latest/" bug-reports: "https://github.com/goblint/analyzer/issues" depends: [ - "angstrom" {= "0.15.0"} - "apron" {= "v0.9.14~beta.2"} + "angstrom" {= "0.16.0"} + "apron" {= "v0.9.14"} "arg-complete" {= "0.1.0"} "astring" {= "0.8.5"} "base-bigarray" {= "base"} "base-bytes" {= "base"} "base-threads" {= "base"} "base-unix" {= "base"} - "batteries" {= "3.6.0"} + "batteries" {= "3.8.0"} "benchmark" {= "1.6" & with-test} "bigarray-compat" {= "1.1.0"} - "bigstringaf" {= "0.9.0"} + "bigstringaf" {= "0.9.1"} "bos" {= "0.2.1"} - "camlidl" {= "1.11"} + "camlidl" {= "1.12"} "camlp-streams" {= "5.0.1"} "catapult" {= "0.2"} "catapult-file" {= "0.2"} - "cmdliner" {= "1.1.1" & with-doc} - "conf-autoconf" {= "0.1"} + "cmdliner" {= "1.3.0" & with-doc} + "conf-autoconf" {= "0.2"} + "conf-findutils" {= "1"} "conf-gcc" {= "1.0"} "conf-gmp" {= "4"} - "conf-mpfr" {= "3"} + "conf-gmp-paths" {= "1"} + "conf-mpfr-paths" {= "1"} "conf-perl" {= "2"} - "conf-pkg-config" {= "2"} "conf-ruby" {= "1.0.0" & with-test} - "conf-which" {= "1"} "cppo" {= "1.6.9"} "cpu" {= "2.0.0"} - "csexp" {= "1.5.1"} - "ctypes" {= "0.20.1"} - "dune" {= "3.7.1"} - "dune-build-info" {= "3.7.1"} - "dune-configurator" {= "3.7.1"} - "dune-private-libs" {= "3.7.1"} - "dune-site" {= "3.7.1"} - "dyn" {= "3.7.1"} + "crunch" {= "3.3.1" & with-doc} + "csexp" {= "1.5.2"} + "cstruct" {= "6.2.0"} + "ctypes" {= "0.22.0"} + "dune" {= "3.16.0"} + "dune-build-info" {= "3.16.0"} + "dune-configurator" {= "3.16.0"} + "dune-private-libs" {= "3.16.0"} + "dune-site" {= "3.16.0"} + "dyn" {= "3.16.0"} + "ez-conf-lib" {= "2"} "fileutils" {= "0.6.4"} "fmt" {= "0.9.0"} "fpath" {= "0.7.3"} "goblint-cil" {= "2.0.3"} + "hex" {= "1.5.0"} "integers" {= "0.7.0"} - "json-data-encoding" {= "0.12.1"} - "jsonrpc" {= "1.15.0~5.0preview1"} + "json-data-encoding" {= "1.0.1"} + "jsonrpc" {= "1.17.0"} "logs" {= "0.7.0"} - "mlgmpidl" {= "1.2.15"} - "num" {= "1.4"} + "mlgmpidl" {= "1.3.0"} + "num" {= "1.5"} "ocaml" {= "4.14.0"} "ocaml-compiler-libs" {= "v0.12.4"} "ocaml-config" {= "2"} "ocaml-option-flambda" {= "1"} "ocaml-syntax-shims" {= "1.0.0"} "ocaml-variants" {= "4.14.0+options"} - "ocamlbuild" {= "0.14.2"} - "ocamlfind" {= "1.9.5"} - "odoc" {= "2.2.0" & with-doc} - "odoc-parser" {= "2.0.0" & with-doc} - "ordering" {= "3.7.1"} - "ounit2" {= "2.2.6" & with-test} - "pp" {= "1.1.2"} + "ocamlbuild" {= "0.14.3"} + "ocamlfind" {= "1.9.6"} + "odoc" {= "2.4.2" & with-doc} + "odoc-parser" {= "2.4.2" & with-doc} + "ordering" {= "3.16.0"} + "ounit2" {= "2.2.7" & with-test} + "pp" {= "1.2.0"} "ppx_derivers" {= "1.2.1"} "ppx_deriving" {= "6.0.2"} "ppx_deriving_hash" {= "0.1.2"} - "ppx_deriving_yojson" {= "3.7.0"} + "ppx_deriving_yojson" {= "3.8.0"} "ppxlib" {= "0.32.1"} - "qcheck-core" {= "0.20"} - "qcheck-ounit" {= "0.20" & with-test} - "re" {= "1.10.4" & with-doc} - "result" {= "1.5"} + "ptime" {= "1.1.0" & with-doc} + "qcheck-core" {= "0.21.3"} + "qcheck-ounit" {= "0.21.3" & with-test} + "re" {= "1.11.0" & with-doc} + "result" {= "1.5" & with-doc} "rresult" {= "0.7.0"} "seq" {= "base"} - "sexplib0" {= "v0.15.1"} - "sha" {= "1.15.2"} + "sexplib0" {= "v0.16.0"} + "sha" {= "1.15.4"} "stdlib-shims" {= "0.3.0"} - "stdune" {= "3.7.1"} + "stdune" {= "3.16.0"} "stringext" {= "1.6.0"} - "topkg" {= "1.0.6"} - "tyxml" {= "4.5.0" & with-doc} - "uri" {= "4.2.0"} + "topkg" {= "1.0.7"} + "tyxml" {= "4.6.0" & with-doc} + "uri" {= "4.4.0"} "uuidm" {= "0.9.8"} "uutf" {= "1.0.3" & with-doc} - "yaml" {= "3.1.0"} - "yojson" {= "2.0.2"} - "zarith" {= "1.12"} + "yaml" {= "3.2.0"} + "yojson" {= "2.2.1"} + "zarith" {= "1.13"} ] build: [ ["dune" "subst"] {dev} diff --git a/gobview b/gobview index 195c61cbae..287bf59be9 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 195c61cbae86b8ffb8af4a21f2acd689665c1c0e +Subproject commit 287bf59be9e25ceea704384c65e0d91565bb749d From 702af102571ec98d660b5ec898d62a73dd4d616c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 21 Jun 2024 14:50:45 +0300 Subject: [PATCH 064/133] Use Sys.opaque_identity in build-info to prevent excessive no-changes rebuild in release profile --- src/build-info/dune | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/build-info/dune b/src/build-info/dune index 5a64b399a4..e1a45ef8fc 100644 --- a/src/build-info/dune +++ b/src/build-info/dune @@ -15,7 +15,7 @@ (target configVersion.ml) (mode (promote (until-clean) (only configVersion.ml))) ; replace existing file in source tree, even if releasing (only overrides) (deps (universe)) ; do not cache, always regenerate - (action (pipe-stdout (bash "git describe --all --long --dirty || echo \"n/a\"") (with-stdout-to %{target} (bash "xargs printf '(* Automatically regenerated, changes do not persist! *)\nlet version = \"%s\"'"))))) + (action (pipe-stdout (bash "git describe --all --long --dirty || echo \"n/a\"") (with-stdout-to %{target} (bash "xargs printf '(* Automatically regenerated, changes do not persist! *)\nlet version = Sys.opaque_identity \"%s\"'"))))) (rule (target configProfile.ml) @@ -31,7 +31,7 @@ (target configDatetime.ml) (mode (promote (until-clean) (only configDatetime.ml))) ; replace existing file in source tree, even if releasing (only overrides) (deps (universe)) ; do not cache, always regenerate - (action (pipe-stdout (bash "date +\"%Y-%m-%dT%H:%M:%S\" || echo \"n/a\"") (with-stdout-to %{target} (bash "xargs printf '(* Automatically regenerated, changes do not persist! *)\nlet datetime = \"%s\"'"))))) + (action (pipe-stdout (bash "date +\"%Y-%m-%dT%H:%M:%S\" || echo \"n/a\"") (with-stdout-to %{target} (bash "xargs printf '(* Automatically regenerated, changes do not persist! *)\nlet datetime = Sys.opaque_identity \"%s\"'"))))) (env (_ From 01d275829fa8c532cbf44ab3a439f04bd3886e19 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 21 Jun 2024 15:19:14 +0300 Subject: [PATCH 065/133] Use String.starts_with and ends_with from Stdlib Since OCaml 4.13. --- src/analyses/mutexEventsAnalysis.ml | 5 ++--- src/autoTune.ml | 2 +- src/build-info/dune | 1 - src/build-info/goblint_build_info.ml | 2 +- src/cdomain/value/domains/invariantCil.ml | 4 ++-- src/cdomains/apron/affineEqualityDomain.apron.ml | 5 ++--- src/common/util/cilfacade.ml | 2 +- src/domains/access.ml | 9 ++++----- src/incremental/compareAST.ml | 2 +- src/incremental/makefileUtil.ml | 2 +- src/witness/svcomp.ml | 5 ++--- 11 files changed, 17 insertions(+), 22 deletions(-) diff --git a/src/analyses/mutexEventsAnalysis.ml b/src/analyses/mutexEventsAnalysis.ml index c5339e68cf..5ea0afc809 100644 --- a/src/analyses/mutexEventsAnalysis.ml +++ b/src/analyses/mutexEventsAnalysis.ml @@ -5,7 +5,6 @@ module M = Messages module Addr = ValueDomain.Addr module LF = LibraryFunctions -open Batteries open GoblintCil open Analyses open GobConfig @@ -52,12 +51,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 + if get_bool "ana.sv-comp.functions" && String.starts_with fundec.svar.vname ~prefix:"__VERIFIER_atomic_" then 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 + if get_bool "ana.sv-comp.functions" && String.starts_with f.svar.vname ~prefix:"__VERIFIER_atomic_" then ctx.emit (Events.Lock (LockDomain.Addr.of_var LF.verifier_atomic_var, true)) let special (ctx: (unit, _, _, _) ctx) lv f arglist : D.t = diff --git a/src/autoTune.ml b/src/autoTune.ml index 434b4fb0b2..3871e421c7 100644 --- a/src/autoTune.ml +++ b/src/autoTune.ml @@ -104,7 +104,7 @@ let rec setCongruenceRecursive fd depth neigbourFunction = | exception Not_found -> () (* Happens for __goblint_bounded *) ) (FunctionSet.filter (*for extern and builtin functions there is no function definition in CIL*) - (fun x -> not (isExtern x.vstorage || BatString.starts_with x.vname "__builtin")) + (fun x -> not (isExtern x.vstorage || String.starts_with x.vname ~prefix:"__builtin")) (neigbourFunction fd.svar) ) ; diff --git a/src/build-info/dune b/src/build-info/dune index e1a45ef8fc..1dd74c192c 100644 --- a/src/build-info/dune +++ b/src/build-info/dune @@ -8,7 +8,6 @@ (library (name goblint_build_info) (public_name goblint.build-info) - (libraries batteries.unthreaded) (virtual_modules dune_build_info)) (rule diff --git a/src/build-info/goblint_build_info.ml b/src/build-info/goblint_build_info.ml index 14e30a1b36..d2600c94ad 100644 --- a/src/build-info/goblint_build_info.ml +++ b/src/build-info/goblint_build_info.ml @@ -18,7 +18,7 @@ let release_commit = "%%VCS_COMMIT_ID%%" (** Goblint version. *) let version = let commit = ConfigVersion.version in - if BatString.starts_with release_version "%" then + if String.starts_with release_version ~prefix:"%" then commit else ( let commit = diff --git a/src/cdomain/value/domains/invariantCil.ml b/src/cdomain/value/domains/invariantCil.ml index 813ec25818..f41d48ab61 100644 --- a/src/cdomain/value/domains/invariantCil.ml +++ b/src/cdomain/value/domains/invariantCil.ml @@ -88,7 +88,7 @@ class exp_contains_anon_type_visitor = object inherit nopCilVisitor method! vtype (t: typ) = match t with - | TComp ({cname; _}, _) when BatString.starts_with_stdlib ~prefix:"__anon" cname -> + | TComp ({cname; _}, _) when String.starts_with ~prefix:"__anon" cname -> raise Stdlib.Exit | _ -> DoChildren @@ -102,7 +102,7 @@ let exp_contains_anon_type = (* TODO: synchronize magic constant with BaseDomain *) -let var_is_heap {vname; _} = BatString.starts_with vname "(alloc@" +let var_is_heap {vname; _} = String.starts_with vname ~prefix:"(alloc@" let reset_lazy () = ResettableLazy.reset exclude_vars_regexp diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 7e60cce74b..ab9c1994fb 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -6,7 +6,6 @@ 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. *) -open Batteries open GoblintCil open Pretty module M = Messages @@ -193,7 +192,7 @@ struct in let res = (String.concat "" @@ Array.to_list @@ Array.map dim_to_str vars) ^ (const_to_str arr.(Array.length arr - 1)) ^ "=0" in - if String.starts_with res "+" then + if String.starts_with res ~prefix:"+" then Str.string_after res 1 else res @@ -370,7 +369,7 @@ struct let remove_rels_with_var x var env inplace = timing_wrap "remove_rels_with_var" (remove_rels_with_var x var env) inplace let forget_vars t vars = - if is_bot t || is_top_env t || List.is_empty vars then + if is_bot t || is_top_env t || vars = [] then t else let m = Option.get t.d in diff --git a/src/common/util/cilfacade.ml b/src/common/util/cilfacade.ml index 99430ee8b6..62ce993455 100644 --- a/src/common/util/cilfacade.ml +++ b/src/common/util/cilfacade.ml @@ -734,7 +734,7 @@ let add_function_declarations (file: Cil.file): unit = let functions, non_functions = List.partition (fun g -> match g with GFun _ -> true | _ -> false) globals in let upto_last_type, non_types = GobList.until_last_with (fun g -> match g with GType _ -> true | _ -> false) non_functions in let declaration_from_GFun f = match f with - | GFun (f, _) when BatString.starts_with_stdlib ~prefix:"__builtin" f.svar.vname -> + | GFun (f, _) when String.starts_with ~prefix:"__builtin" f.svar.vname -> (* Builtin functions should not occur in asserts generated, so there is no need to add declarations for them.*) None | GFun (f, _) -> diff --git a/src/domains/access.ml b/src/domains/access.ml index c35fb3a16d..f7ce68a18b 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -1,6 +1,5 @@ (** Memory accesses and their manipulation. *) -open Batteries open GoblintCil open Pretty open GobConfig @@ -12,7 +11,7 @@ module M = Messages let is_ignorable_comp_name = function | "__pthread_mutex_s" | "__pthread_rwlock_arch_t" | "__jmp_buf_tag" | "_pthread_cleanup_buffer" | "__pthread_cleanup_frame" | "__cancel_jmp_buf_tag" | "_IO_FILE" -> true - | cname when String.starts_with_stdlib ~prefix:"__anon" cname -> + | cname when String.starts_with ~prefix:"__anon" cname -> begin match Cilfacade.split_anoncomp_name cname with | (true, Some ("__once_flag" | "__pthread_unwind_buf_t" | "__cancel_jmp_buf"), _) -> true (* anonstruct *) | (false, Some ("pthread_mutexattr_t" | "pthread_condattr_t" | "pthread_barrierattr_t"), _) -> true (* anonunion *) @@ -385,7 +384,7 @@ and distribute_access_exp f = function and distribute_access_type f = function | TArray (et, len, _) -> - Option.may (distribute_access_exp f) len; + Option.iter (distribute_access_exp f) len; distribute_access_type f et | TVoid _ @@ -434,7 +433,7 @@ struct include SetDomain.Make (A) let max_conf accs = - accs |> elements |> List.map (fun {A.conf; _} -> conf) |> (List.max ~cmp:Int.compare) + accs |> elements |> List.map (fun {A.conf; _} -> conf) |> (BatList.max ~cmp:Int.compare) end @@ -583,7 +582,7 @@ let incr_summary ~safe ~vulnerable ~unsafe grouped_accs = |> List.filter_map race_conf |> (function | [] -> None - | confs -> Some (List.max confs) + | confs -> Some (BatList.max confs) ) in match safety with diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index f3de153658..ecd69f1f96 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -73,7 +73,7 @@ let forward_list_equal ?(propF = (&&>>)) f l1 l2 ~(rename_mapping: rename_mappin let compare_name (a: string) (b: string) = let anon_struct = "__anonstruct_" in 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) + if a = b then true else String.(starts_with a ~prefix:anon_struct && starts_with b ~prefix:anon_struct || starts_with a ~prefix:anon_union && starts_with b ~prefix:anon_union) let rec eq_constant ~(rename_mapping: rename_mapping) ~(acc: (typ * typ) list) (a: constant) (b: constant) : bool * rename_mapping = match a, b with diff --git a/src/incremental/makefileUtil.ml b/src/incremental/makefileUtil.ml index 9a17122f5e..33cd8f64c9 100644 --- a/src/incremental/makefileUtil.ml +++ b/src/incremental/makefileUtil.ml @@ -39,7 +39,7 @@ let find_file_by_suffix (dir: Fpath.t) (file_name_suffix: string) = | (h::t) -> let f = Fpath.to_string h in if Sys.file_exists f && Sys.is_directory f then (Queue.add h dirs; search dir t) - else if Batteries.String.ends_with (Fpath.filename h) file_name_suffix then h else search dir t + else if String.ends_with (Fpath.filename h) ~suffix:file_name_suffix then h else search dir t | [] -> if Queue.is_empty dirs then failwith ("find_file_by_suffix found no files with suffix "^file_name_suffix^" in "^ Fpath.to_string dir) else let d = Queue.take dirs in search d (list_files d) diff --git a/src/witness/svcomp.ml b/src/witness/svcomp.ml index bb887e6cb1..c17b5e78f8 100644 --- a/src/witness/svcomp.ml +++ b/src/witness/svcomp.ml @@ -1,7 +1,6 @@ (** SV-COMP tasks and results. *) open GoblintCil -open Batteries module Specification = SvcompSpec @@ -27,9 +26,9 @@ let is_error_function f = (* TODO: unused, but should be used? *) let is_special_function f = let loc = f.vdecl in - let is_svcomp = String.ends_with loc.file "sv-comp.c" in (* only includes/sv-comp.c functions, not __VERIFIER_assert in benchmark *) + let is_svcomp = String.ends_with loc.file ~suffix:"sv-comp.c" in (* only includes/sv-comp.c functions, not __VERIFIER_assert in benchmark *) let is_verifier = match f.vname with - | fname when String.starts_with fname "__VERIFIER" -> true + | fname when String.starts_with fname ~prefix:"__VERIFIER" -> true | fname -> is_error_function f in is_svcomp && is_verifier From ecda3f734f020703b0535e578513abfd9b2d53a4 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 25 Jun 2024 11:24:45 +0300 Subject: [PATCH 066/133] Move comment in MutexTypeAnalysis --- src/analyses/mutexTypeAnalysis.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index e8edddd41e..4a993bbd7d 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -12,17 +12,17 @@ struct let name () = "pthreadMutexType" - (* 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 = Offset.Unit - module V = struct + (* 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 *) include Mval.Unit let is_write_only _ = false end module G = MAttr + module O = Offset.Unit + (* transfer functions *) let assign ctx (lval:lval) (rval:exp) : D.t = match lval with From bc3fac895299e7b96ad8ac216d446bc6751a831c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 25 Jun 2024 11:51:07 +0300 Subject: [PATCH 067/133] Add witness missing verdict to YAML witness validation Better than "EXCEPTION (Failure)" as verdict. --- src/goblint.ml | 5 +++++ src/witness/svcomp.ml | 5 +++++ src/witness/witness.ml | 2 +- src/witness/yamlWitness.ml | 4 +++- 4 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/goblint.ml b/src/goblint.ml index a687badb8e..52b9bbdfc0 100644 --- a/src/goblint.ml +++ b/src/goblint.ml @@ -83,6 +83,11 @@ let main () = Logs.error "%s" (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 (); exit 124 + | Svcomp.Error msg -> + do_stats (); + Witness.print_svcomp_result ("ERROR (" ^ msg ^ ")"); + Goblint_timing.teardown_tef (); + exit 1 (* We do this since the evaluation order of top-level bindings is not defined, but we want `main` to run after all the other side-effects (e.g. registering analyses/solvers) have happened. *) let () = at_exit main diff --git a/src/witness/svcomp.ml b/src/witness/svcomp.ml index bb887e6cb1..59a8f01b40 100644 --- a/src/witness/svcomp.ml +++ b/src/witness/svcomp.ml @@ -60,6 +60,11 @@ struct | Unknown -> "unknown" end +exception Error of string + +let errorwith s = raise (Error s) + + module type TaskResult = sig module Arg: MyARG.S diff --git a/src/witness/witness.ml b/src/witness/witness.ml index 651e7a76d5..7b0213b601 100644 --- a/src/witness/witness.ml +++ b/src/witness/witness.ml @@ -695,7 +695,7 @@ struct | Some false -> print_svcomp_result "ERROR (verify)" | _ -> match yaml_validate_result with - | Some (Error msg) -> + | Some (Stdlib.Error msg) -> print_svcomp_result ("ERROR (" ^ msg ^ ")") | Some (Ok (Svcomp.Result.False _ | Unknown as result)) -> print_svcomp_result (Result.to_string result) diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 71bb75afef..bb91e195ef 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -581,7 +581,9 @@ struct let yaml = match Yaml_unix.of_file (Fpath.v (GobConfig.get_string "witness.yaml.validate")) with | Ok yaml -> yaml - | Error (`Msg m) -> failwith ("Yaml_unix.of_file: " ^ m) + | Error (`Msg m) -> + Logs.error "Yaml_unix.of_file: %s" m; + Svcomp.errorwith "witness missing" in let yaml_entries = yaml |> GobYaml.list |> BatResult.get_ok in From 9fd0fd5bd3dcb7b22d200e4f655535789d846d51 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 25 Jun 2024 11:59:00 +0300 Subject: [PATCH 068/133] Add witness missing verdict to YAML witness unassume Better than "EXCEPTION (Failure)" as verdict. --- src/analyses/unassumeAnalysis.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/analyses/unassumeAnalysis.ml b/src/analyses/unassumeAnalysis.ml index 265e9c6925..85b33edc79 100644 --- a/src/analyses/unassumeAnalysis.ml +++ b/src/analyses/unassumeAnalysis.ml @@ -85,7 +85,9 @@ struct let yaml = match Yaml_unix.of_file (Fpath.v (GobConfig.get_string "witness.yaml.unassume")) with | Ok yaml -> yaml - | Error (`Msg m) -> failwith ("Yaml_unix.of_file: " ^ m) + | Error (`Msg m) -> + Logs.error "Yaml_unix.of_file: %s" m; + Svcomp.errorwith "witness missing" in let yaml_entries = yaml |> GobYaml.list |> BatResult.get_ok in From 85ab1fdc9edddf65a8f1a6c8bae74c1a417859f0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 25 Jun 2024 12:09:46 +0300 Subject: [PATCH 069/133] Check YAML witness existence before analysis --- src/framework/control.ml | 1 + src/witness/yamlWitness.ml | 9 +++++++++ 2 files changed, 10 insertions(+) diff --git a/src/framework/control.ml b/src/framework/control.ml index bb1d7bab58..5e92282210 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -357,6 +357,7 @@ struct (* real beginning of the [analyze] function *) if get_bool "ana.sv-comp.enabled" then Witness.init (module FileCfg); (* TODO: move this out of analyze_loop *) + YamlWitness.init (); AnalysisState.global_initialization := true; GobConfig.earlyglobs := get_bool "exp.earlyglobs"; diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index bb91e195ef..7134211d32 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -514,6 +514,15 @@ struct Timing.wrap "yaml witness" write () end +let init () = + match GobConfig.get_string "witness.yaml.validate" with + | "" -> () + | path -> + (* Check witness existence before doing the analysis. *) + if not (Sys.file_exists path) then ( + Logs.error "witness.yaml.validate: %s not found" path; + Svcomp.errorwith "witness missing" + ) module ValidationResult = struct From 05397c58b551d94dfb3532ed9952ab0d50edfc51 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Tue, 25 Jun 2024 15:22:44 +0300 Subject: [PATCH 070/133] Add Karoliine to authors --- .zenodo.json | 5 +++++ CITATION.cff | 4 ++++ dune-project | 2 +- goblint.opam | 1 + goblint.opam.locked | 1 + 5 files changed, 12 insertions(+), 1 deletion(-) diff --git a/.zenodo.json b/.zenodo.json index 22705c2d9c..1e71573948 100644 --- a/.zenodo.json +++ b/.zenodo.json @@ -23,6 +23,11 @@ "affiliation": "Technische Universität München", "orcid": "0009-0009-9644-7475" }, + { + "name": "Holter, Karoliine", + "affiliation": "University of Tartu", + "orcid": "0009-0008-3725-4131" + }, { "name": "Vogler, Ralf", "affiliation": "Technische Universität München" diff --git a/CITATION.cff b/CITATION.cff index 25d46cf762..7a93859c54 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -21,6 +21,10 @@ authors: # same authors as in .zenodo.json and dune-project family-names: Tilscher affiliation: "Technische Universität München" orcid: "https://orcid.org/0009-0009-9644-7475" + - given-names: Karoliine + family-names: Holter + affiliation: "University of Tartu" + orcid: "https://orcid.org/0009-0008-3725-4131" - given-names: Ralf family-names: Vogler affiliation: "Technische Universität München" diff --git a/dune-project b/dune-project index 878abd3b4f..b85a82b93f 100644 --- a/dune-project +++ b/dune-project @@ -15,7 +15,7 @@ (source (github goblint/analyzer)) (homepage "https://goblint.in.tum.de") (documentation "https://goblint.readthedocs.io/en/latest/") -(authors "Simmo Saan" "Michael Schwarz" "Julian Erhard" "Sarah Tilscher" "Ralf Vogler" "Kalmer Apinis" "Vesal Vojdani" ) ; same authors as in .zenodo.json and CITATION.cff +(authors "Simmo Saan" "Michael Schwarz" "Julian Erhard" "Sarah Tilscher" "Karoliine Holter" "Ralf Vogler" "Kalmer Apinis" "Vesal Vojdani" ) ; same authors as in .zenodo.json and CITATION.cff (maintainers "Simmo Saan " "Michael Schwarz " "Karoliine Holter") (license MIT) diff --git a/goblint.opam b/goblint.opam index 692625c965..03e11d456a 100644 --- a/goblint.opam +++ b/goblint.opam @@ -11,6 +11,7 @@ authors: [ "Michael Schwarz" "Julian Erhard" "Sarah Tilscher" + "Karoliine Holter" "Ralf Vogler" "Kalmer Apinis" "Vesal Vojdani" diff --git a/goblint.opam.locked b/goblint.opam.locked index f8de683948..0cf9a2ff75 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -12,6 +12,7 @@ authors: [ "Michael Schwarz" "Julian Erhard" "Sarah Tilscher" + "Karoliine Holter" "Ralf Vogler" "Kalmer Apinis" "Vesal Vojdani" From 1e705fa4925863dd9a52a7b9e5070c9f7b97fe0a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 25 Jun 2024 21:56:56 +0300 Subject: [PATCH 071/133] Rewrite pointer arithmethic not overflowing assumption --- docs/user-guide/assumptions.md | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/docs/user-guide/assumptions.md b/docs/user-guide/assumptions.md index 16386987de..33284ccc00 100644 --- a/docs/user-guide/assumptions.md +++ b/docs/user-guide/assumptions.md @@ -17,12 +17,22 @@ _NB! This list is likely incomplete._ See [PR #1414](https://github.com/goblint/analyzer/pull/1414). -2. Goblint's does not give any guarantees about overflows not happening during pointer arithmetics. +2. Pointer arithmetic does not overflow. - Although the analysis can detect and warn about overflows that might happen during operations with pointer offsets, - the analysis does not warn about overflows from operations with the possible addresses (as integers) of the pointers themselves. + [C11's N1570][n1570] at 6.5.6.8 states that - This affects the `no-overflows` analysis from `ana.int.interval` analysis. + > When an expression that has integer type is added to or subtracted from a pointer, the result has the type of the pointer operand. + > [...] + > the evaluation shall not produce an overflow; otherwise, the behavior is undefined. - See further discussion from [PR #1511](https://github.com/goblint/analyzer/pull/1511). + after a long list of defined behaviors. + Goblint does not report overflow and out-of-bounds pointer arithmetic (when the pointer _is not dereferenced_). + This affects the overflow analysis (SV-COMP no-overflow property) in the `base` analysis. + + This _does not_ affect the `memOutOfBounds` analysis (SV-COMP valid-memsafety property), which is for undefined behavior from _dereferencing_ such out-of-bounds pointers. + + See [PR #1511](https://github.com/goblint/analyzer/pull/1511). + + +[n1570]: https://www.open-std.org/jtc1/sc22/wg14/www/docs/n1570.pdf From a1bfc416569028f2f03c43d5df9840e2ac9aa3e6 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 26 Jun 2024 11:45:25 +0300 Subject: [PATCH 072/133] Upgrade locked OCaml to 4.14.2 --- .github/workflows/coverage.yml | 2 +- .github/workflows/docs.yml | 2 +- .github/workflows/locked.yml | 6 +++--- .github/workflows/unlocked.yml | 8 ++++---- goblint.opam.locked | 4 ++-- gobview | 2 +- make.sh | 2 +- 7 files changed, 13 insertions(+), 13 deletions(-) diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index d4fc872620..1e1991e2ab 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -18,7 +18,7 @@ jobs: os: - ubuntu-latest ocaml-compiler: - - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file + - ocaml-variants.4.14.2+options,ocaml-option-flambda # matches opam lock file # don't add any other because they won't be used runs-on: ${{ matrix.os }} diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index 242acef3de..bae49437dd 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -18,7 +18,7 @@ jobs: os: - ubuntu-latest ocaml-compiler: - - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file + - ocaml-variants.4.14.2+options,ocaml-option-flambda # matches opam lock file # don't add any other because they won't be used runs-on: ${{ matrix.os }} diff --git a/.github/workflows/locked.yml b/.github/workflows/locked.yml index 18935725ca..a7f8787305 100644 --- a/.github/workflows/locked.yml +++ b/.github/workflows/locked.yml @@ -20,7 +20,7 @@ jobs: - ubuntu-latest - macos-13 ocaml-compiler: - - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file + - ocaml-variants.4.14.2+options,ocaml-option-flambda # matches opam lock file # don't add any other because they won't be used runs-on: ${{ matrix.os }} @@ -73,7 +73,7 @@ jobs: os: - ubuntu-latest ocaml-compiler: - - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file + - ocaml-variants.4.14.2+options,ocaml-option-flambda # matches opam lock file # don't add any other because they won't be used runs-on: ${{ matrix.os }} @@ -116,7 +116,7 @@ jobs: os: - ubuntu-latest ocaml-compiler: - - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file + - ocaml-variants.4.14.2+options,ocaml-option-flambda # matches opam lock file # don't add any other because they won't be used node-version: - 14 diff --git a/.github/workflows/unlocked.yml b/.github/workflows/unlocked.yml index db41ad3007..af32008400 100644 --- a/.github/workflows/unlocked.yml +++ b/.github/workflows/unlocked.yml @@ -21,7 +21,7 @@ jobs: - 5.2.x - 5.1.x - 5.0.x - - ocaml-variants.4.14.0+options,ocaml-option-flambda + - ocaml-variants.4.14.2+options,ocaml-option-flambda - 4.14.x apron: - false @@ -92,7 +92,7 @@ jobs: - ubuntu-latest - macos-13 ocaml-compiler: - - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file, downgrade deps step + - ocaml-variants.4.14.2+options,ocaml-option-flambda # matches opam lock file, downgrade deps step name: lower-bounds (${{ matrix.os }}, ${{ matrix.ocaml-compiler }}, downgrade) @@ -133,7 +133,7 @@ jobs: - name: Downgrade dependencies # must specify ocaml-base-compiler again to prevent it from being downgraded # prevent num downgrade to avoid dune/jbuilder error: https://github.com/ocaml/dune/issues/5280 - run: opam install $(opam exec -- opam-0install --prefer-oldest goblint ocaml-variants.4.14.0+options ocaml-option-flambda num.1.5) + run: opam install $(opam exec -- opam-0install --prefer-oldest goblint ocaml-variants.4.14.2+options ocaml-option-flambda num.1.5) - name: Build run: ./make.sh nat @@ -190,7 +190,7 @@ jobs: - ubuntu-latest - macos-13 ocaml-compiler: - - ocaml-variants.4.14.0+options,ocaml-option-flambda # matches opam lock file + - ocaml-variants.4.14.2+options,ocaml-option-flambda # matches opam lock file runs-on: ${{ matrix.os }} diff --git a/goblint.opam.locked b/goblint.opam.locked index 410d363ac8..26f8bb53e7 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -71,12 +71,12 @@ depends: [ "logs" {= "0.7.0"} "mlgmpidl" {= "1.3.0"} "num" {= "1.5"} - "ocaml" {= "4.14.0"} + "ocaml" {= "4.14.2"} "ocaml-compiler-libs" {= "v0.12.4"} "ocaml-config" {= "2"} "ocaml-option-flambda" {= "1"} "ocaml-syntax-shims" {= "1.0.0"} - "ocaml-variants" {= "4.14.0+options"} + "ocaml-variants" {= "4.14.2+options"} "ocamlbuild" {= "0.14.3"} "ocamlfind" {= "1.9.6"} "odoc" {= "2.4.2" & with-doc} diff --git a/gobview b/gobview index 287bf59be9..4069f32f82 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 287bf59be9e25ceea704384c65e0d91565bb749d +Subproject commit 4069f32f82efdefb43c970fb77ca29671a4b6972 diff --git a/make.sh b/make.sh index 5b55e51beb..0f76759065 100755 --- a/make.sh +++ b/make.sh @@ -8,7 +8,7 @@ opam_setup() { set -x opam init -y -a --bare $SANDBOXING # sandboxing is disabled in travis and docker opam update - opam switch -y create . --deps-only --packages=ocaml-variants.4.14.0+options,ocaml-option-flambda --locked + opam switch -y create . --deps-only --packages=ocaml-variants.4.14.2+options,ocaml-option-flambda --locked } rule() { From 56ed7b5589da639d5ec9028c8558cb75810dada1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 26 Jun 2024 17:05:20 +0300 Subject: [PATCH 073/133] Add option ana.base.invariant.int.simplify --- src/cdomain/value/cdomains/intDomain.ml | 26 ++++++++++++++++++++----- src/config/options.schema.json | 14 +++++++++++++ 2 files changed, 35 insertions(+), 5 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 797c0f46c1..2d40e6a161 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -3791,11 +3791,15 @@ module IntDomTupleImpl = struct | _ -> BatPrintf.fprintf f "\n\n%s\n\n\n" (show x) let invariant_ikind e ik ((_, _, _, x_cong, x_intset) as x) = - match to_int x with - | Some v -> - (* If definite, output single equality instead of every subdomain repeating same equality (or something less precise). *) - IntInvariant.of_int e ik v - | None -> + let simplify_int fallback = + match to_int x with + | Some v -> + (* If definite, output single equality instead of every subdomain repeating same equality (or something less precise). *) + IntInvariant.of_int e ik v + | None -> + fallback () + in + let simplify_all () = match to_incl_list x with | Some ps -> (* If inclusion set, output disjunction of equalities because it subsumes interval(s), exclusion set and congruence. *) @@ -3814,6 +3818,18 @@ module IntDomTupleImpl = struct Option.map_default (I4.invariant_ikind e ik) Invariant.none x_cong && (* Output congruence as is. *) Option.map_default (I5.invariant_ikind e ik) Invariant.none x_intset (* Output interval sets as is. *) ) + in + let simplify_none () = + let is = to_list (mapp { fp = fun (type a) (module I:SOverflow with type t = a) -> I.invariant_ikind e ik } x) in + List.fold_left (fun a i -> + Invariant.(a && i) + ) (Invariant.top ()) is + in + match GobConfig.get_string "ana.base.invariant.int.simplify" with + | "none" -> simplify_none () + | "int" -> simplify_int simplify_none + | "all" -> simplify_int simplify_all + | _ -> assert false let arbitrary ik = QCheck.(set_print show @@ tup5 (option (I1.arbitrary ik)) (option (I2.arbitrary ik)) (option (I3.arbitrary ik)) (option (I4.arbitrary ik)) (option (I5.arbitrary ik))) diff --git a/src/config/options.schema.json b/src/config/options.schema.json index acf85abed9..27cc0c7d93 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -807,6 +807,20 @@ "type": "string", "enum": ["once", "fixpoint"], "default": "once" + }, + "int": { + "title": "ana.base.invariant.int", + "type": "object", + "properties": { + "simplify": { + "title": "ana.base.invariant.int.simplify", + "description": "How much to simplify int domain invariants. Value \"int\" only simplifies definite integers. Without int domain refinement \"all\" might not be maximally precise.", + "type": "string", + "enum": ["none", "int", "all"], + "default": "all" + } + }, + "additionalProperties": false } }, "additionalProperties": false From 14e5523ce2b49eed48ec72837d9a41eff4b0f3e3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 27 Jun 2024 11:40:07 +0300 Subject: [PATCH 074/133] Remove small margin for Apron domain show --- src/cdomains/apron/apronDomain.apron.ml | 2 +- src/common/util/gobFormat.ml | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/cdomains/apron/apronDomain.apron.ml b/src/cdomains/apron/apronDomain.apron.ml index d0ef268ca6..26e954f1b2 100644 --- a/src/cdomains/apron/apronDomain.apron.ml +++ b/src/cdomains/apron/apronDomain.apron.ml @@ -442,7 +442,7 @@ struct let invariant _ = [] let show (x:t) = - Format.asprintf "%a (env: %a)" A.print x (Environment.print: Format.formatter -> Environment.t -> unit) (A.env x) + Format.asprintf "%t%a (env: %a)" GobFormat.pp_set_infinite_geometry A.print x (Environment.print: Format.formatter -> Environment.t -> unit) (A.env x) let pretty () (x:t) = text (show x) let equal x y = diff --git a/src/common/util/gobFormat.ml b/src/common/util/gobFormat.ml index 3cda0a4758..1b4d28a26c 100644 --- a/src/common/util/gobFormat.ml +++ b/src/common/util/gobFormat.ml @@ -19,3 +19,7 @@ let pp_set_ansi_color_tags ppf = Format.pp_set_mark_tags ppf true let pp_print_nothing (ppf: Format.formatter) () = () + +let pp_infinity = 1000000001 (* Exact value not exposed before OCaml 5.2, but use the smallest value permitted by documentation. *) + +let pp_set_infinite_geometry = Format.pp_set_geometry ~max_indent:(pp_infinity - 2) ~margin:(pp_infinity - 1) From d2527b7f757e486cadfd551c712796cc6ee4c1b2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 27 Jun 2024 11:49:10 +0300 Subject: [PATCH 075/133] Add Printable.SimpleFormat --- src/common/domains/printable.ml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/common/domains/printable.ml b/src/common/domains/printable.ml index 1a642c932a..b6b1dc5c3a 100644 --- a/src/common/domains/printable.ml +++ b/src/common/domains/printable.ml @@ -88,6 +88,20 @@ struct let to_yojson x = `String (show x) end +module type Formatable = +sig + type t + val pp: Format.formatter -> t -> unit +end + +module SimpleFormat (P: Formatable) = +struct + let show x = Format.asprintf "%t%a" GobFormat.pp_set_infinite_geometry P.pp x + let pretty () x = text (show x) + let printXml f x = BatPrintf.fprintf f "\n\n%s\n\n\n" (XmlUtil.escape (show x)) + let to_yojson x = `String (show x) +end + module type Name = sig val name: string end module UnitConf (N: Name) = From 6269d1e2942b8567601a30d35657beadeaabecaa Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 27 Jun 2024 12:02:59 +0300 Subject: [PATCH 076/133] Add some Printables to GobApron --- .../apron/affineEqualityDomain.apron.ml | 3 +- src/cdomains/apron/apronDomain.apron.ml | 18 +++--- src/cdomains/apron/gobApron.apron.ml | 56 ++++++++++++++++++- .../apron/linearTwoVarEqualityDomain.apron.ml | 6 +- src/cdomains/apron/sharedFunctions.apron.ml | 2 +- 5 files changed, 68 insertions(+), 17 deletions(-) diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 7e60cce74b..6bef6c329e 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -206,8 +206,7 @@ struct Format.asprintf "%s" ("[|"^ (String.concat "; " constraint_list) ^"|]") let pretty () (x:t) = text (show x) - let printXml f x = BatPrintf.fprintf f "\n\n\nmatrix\n\n\n%s\n\nenv\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show x) )) (XmlUtil.escape (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) (x.env))) - + let printXml f x = BatPrintf.fprintf f "\n\n\nmatrix\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show x) )) Environment.printXml x.env let eval_interval ask = Bounds.bound_texpr let name () = "affeq" diff --git a/src/cdomains/apron/apronDomain.apron.ml b/src/cdomains/apron/apronDomain.apron.ml index 26e954f1b2..826eec0715 100644 --- a/src/cdomains/apron/apronDomain.apron.ml +++ b/src/cdomains/apron/apronDomain.apron.ml @@ -283,7 +283,7 @@ struct let assign_exp_with ask nd v e no_ov = match Convert.texpr1_of_cil_exp ask nd (A.env nd) e no_ov with | texpr1 -> - if M.tracing then M.trace "apron" "assign_exp converted: %s" (Format.asprintf "%a" Texpr1.print texpr1); + if M.tracing then M.trace "apron" "assign_exp converted: %a" Texpr1.pretty texpr1; A.assign_texpr_with Man.mgr nd v texpr1 None | exception Convert.Unsupported_CilExp _ -> if M.tracing then M.trace "apron" "assign_exp unsupported"; @@ -442,7 +442,7 @@ struct let invariant _ = [] let show (x:t) = - Format.asprintf "%t%a (env: %a)" GobFormat.pp_set_infinite_geometry A.print x (Environment.print: Format.formatter -> Environment.t -> unit) (A.env x) + Format.asprintf "%t%a (env: %a)" GobFormat.pp_set_infinite_geometry A.print x Environment.pp (A.env x) let pretty () (x:t) = text (show x) let equal x y = @@ -454,7 +454,7 @@ struct let compare (x:t) y: int = (* there is no A.compare, but polymorphic compare should delegate to Abstract0 and Environment compare's implemented in Apron's C *) Stdlib.compare x y - let printXml f x = BatPrintf.fprintf f "\n\n\nconstraints\n\n\n%s\n\nenv\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%a" A.print x)) (XmlUtil.escape (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) (A.env x))) + let printXml f x = BatPrintf.fprintf f "\n\n\nconstraints\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (Format.asprintf "%a" A.print x)) Environment.printXml (A.env x) let to_yojson (x: t) = let constraints = @@ -463,11 +463,9 @@ struct |> Lincons1Set.elements |> List.map (fun lincons1 -> `String (Lincons1.show lincons1)) in - let env = `String (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) (A.env x)) - in `Assoc [ ("constraints", `List constraints); - ("env", env); + ("env", Environment.to_yojson (A.env x)); ] let unify x y = @@ -533,9 +531,9 @@ struct | _ -> begin match Convert.tcons1_of_cil_exp ask d (A.env d) e negate no_ov with | tcons1 -> - if M.tracing then M.trace "apron" "assert_constraint %a %s" d_exp e (Format.asprintf "%a" Tcons1.print tcons1); + if M.tracing then M.trace "apron" "assert_constraint %a %a" d_exp e Tcons1.pretty tcons1; if M.tracing then M.trace "apron" "assert_constraint st: %a" D.pretty d; - if M.tracing then M.trace "apron" "assert_constraint tcons1: %s" (Format.asprintf "%a" Tcons1.print tcons1); + if M.tracing then M.trace "apron" "assert_constraint tcons1: %a" Tcons1.pretty tcons1; let r = meet_tcons ask d tcons1 e in if M.tracing then M.trace "apron" "assert_constraint r: %a" D.pretty r; r @@ -598,7 +596,7 @@ struct let x_cons = A.to_lincons_array Man.mgr x_j in let y_cons = A.to_lincons_array Man.mgr y_j in let try_add_con j con1 = - if M.tracing then M.tracei "apron" "try_add_con %s" (Format.asprintf "%a" (Lincons1.print: Format.formatter -> Lincons1.t -> unit) con1); + if M.tracing then M.tracei "apron" "try_add_con %a" Lincons1.pretty con1; let t = meet_lincons j con1 in let t_x = A.change_environment Man.mgr t x_env false in let t_y = A.change_environment Man.mgr t y_env false in @@ -637,7 +635,7 @@ struct in let env_exists_mem_con1 env con1 = let r = env_exists_mem_con1 env con1 in - if M.tracing then M.trace "apron" "env_exists_mem_con1 %s %s -> %B" (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) env) (Lincons1.show con1) r; + if M.tracing then M.trace "apron" "env_exists_mem_con1 %a %a -> %B" Environment.pretty env Lincons1.pretty con1 r; r in (* Heuristically reorder constraints to pass 36/12 with singlethreaded->multithreaded mode switching. *) diff --git a/src/cdomains/apron/gobApron.apron.ml b/src/cdomains/apron/gobApron.apron.ml index e202a88c60..f2322c1473 100644 --- a/src/cdomains/apron/gobApron.apron.ml +++ b/src/cdomains/apron/gobApron.apron.ml @@ -18,7 +18,14 @@ module Lincons1 = struct include Lincons1 - let show = Format.asprintf "%a" print + let pp = print + include Printable.SimpleFormat ( + struct + type nonrec t = t + let pp = pp + end + ) + let compare x y = String.compare (show x) (show y) (* HACK *) let num_vars x = @@ -43,12 +50,59 @@ struct |> of_enum end +module Texpr1 = +struct + include Texpr1 + + let pp = print + include Printable.SimpleFormat ( + struct + type nonrec t = t + let pp = pp + end + ) + + module Expr = + struct + type t = expr + + let pp = print_expr + include Printable.SimpleFormat ( + struct + type nonrec t = t + let pp = pp + end + ) + end +end + +module Tcons1 = +struct + include Tcons1 + + let pp = print + include Printable.SimpleFormat ( + struct + type nonrec t = t + let pp = pp + end + ) +end + (** A few code elements for environment changes from functions as remove_vars etc. have been moved to sharedFunctions as they are needed in a similar way inside affineEqualityDomain. A module that includes various methods used by variable handling operations such as add_vars, remove_vars etc. in apronDomain and affineEqualityDomain. *) module Environment = struct include Environment + let pp: Format.formatter -> Environment.t -> unit = Environment.print + include Printable.SimpleFormat ( + struct + type nonrec t = t + let pp = pp + end + ) + let ivars_only env = let ivs, fvs = Environment.vars env in assert (Array.length fvs = 0); (* shouldn't ever contain floats *) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 5558bc2c96..fa71e3d1a5 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -11,7 +11,7 @@ open Batteries open GoblintCil open Pretty module M = Messages -open Apron +open GobApron open VectorMatrix module Mpqf = SharedFunctions.Mpqf @@ -331,7 +331,7 @@ struct let simplified_monomials_from_texp (t: t) texp = let res = simplified_monomials_from_texp t texp in - if M.tracing then M.tracel "from_texp" "%s %s -> %s" (EConj.show @@ snd @@ BatOption.get t.d) (Format.asprintf "%a" Texpr1.print_expr texp) + if M.tracing then M.tracel "from_texp" "%s %a -> %s" (EConj.show @@ snd @@ BatOption.get t.d) Texpr1.Expr.pretty texp (BatOption.map_default (fun (l,(o,d)) -> List.fold_right (fun (a,x,b) acc -> Printf.sprintf "%s*var_%d/%s + %s" (Z.to_string a) x (Z.to_string b) acc) l ((Z.to_string o)^"/"^(Z.to_string d))) "" res); res @@ -424,7 +424,7 @@ struct EConj.show_formatted (show_var varM.env) (snd arr) ^ (to_subscript @@ fst arr) let pretty () (x:t) = text (show x) - let printXml f x = BatPrintf.fprintf f "\n\n\nequalities\n\n\n%s\n\nenv\n\n\n%s\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show x) )) (XmlUtil.escape (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) (x.env))) + let printXml f x = BatPrintf.fprintf f "\n\n\nequalities\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show x) )) Environment.printXml x.env let eval_interval ask = Bounds.bound_texpr let meet_with_one_conj t i (var, o, divi) = diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 8c94c996b0..9627b4762a 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -196,7 +196,7 @@ struct in let exp = Cil.constFold false exp in let res = conv exp in - if M.tracing then M.trace "relation" "texpr1_expr_of_cil_exp: %a -> %s (%b)" d_plainexp exp (Format.asprintf "%a" Texpr1.print_expr res) (Lazy.force no_ov); + if M.tracing then M.trace "relation" "texpr1_expr_of_cil_exp: %a -> %a (%b)" d_plainexp exp Texpr1.Expr.pretty res (Lazy.force no_ov); res let texpr1_of_cil_exp ask d env e no_ov = From e37b7d756ee7f0fcd4a8f56ded7f01adf89d090f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 27 Jun 2024 12:06:04 +0300 Subject: [PATCH 077/133] Remove pointless `Format.asprintf "%s"` --- src/cdomains/apron/affineEqualityDomain.apron.ml | 4 ++-- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 6bef6c329e..8bb99f2264 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -203,10 +203,10 @@ struct | Some m when Matrix.is_empty m -> "⊤" | Some m -> let constraint_list = List.init (Matrix.num_rows m) (fun i -> vec_to_constraint (conv_to_ints @@ Matrix.get_row m i) t.env) in - Format.asprintf "%s" ("[|"^ (String.concat "; " constraint_list) ^"|]") + "[|"^ (String.concat "; " constraint_list) ^"|]" let pretty () (x:t) = text (show x) - let printXml f x = BatPrintf.fprintf f "\n\n\nmatrix\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show x) )) Environment.printXml x.env + let printXml f x = BatPrintf.fprintf f "\n\n\nmatrix\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (show x)) Environment.printXml x.env let eval_interval ask = Bounds.bound_texpr let name () = "affeq" diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index fa71e3d1a5..bd6b81402a 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -424,7 +424,7 @@ struct EConj.show_formatted (show_var varM.env) (snd arr) ^ (to_subscript @@ fst arr) let pretty () (x:t) = text (show x) - let printXml f x = BatPrintf.fprintf f "\n\n\nequalities\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (Format.asprintf "%s" (show x) )) Environment.printXml x.env + let printXml f x = BatPrintf.fprintf f "\n\n\nequalities\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (show x)) Environment.printXml x.env let eval_interval ask = Bounds.bound_texpr let meet_with_one_conj t i (var, o, divi) = From 5ea925eab57750f77acad4081dc6d46d6016814d Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 27 Jun 2024 12:28:09 +0300 Subject: [PATCH 078/133] Extract GobFormat.asprintf --- src/cdomains/apron/apronDomain.apron.ml | 4 ++-- src/common/domains/printable.ml | 2 +- src/common/util/gobFormat.ml | 5 +++++ 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/cdomains/apron/apronDomain.apron.ml b/src/cdomains/apron/apronDomain.apron.ml index 826eec0715..777db5a297 100644 --- a/src/cdomains/apron/apronDomain.apron.ml +++ b/src/cdomains/apron/apronDomain.apron.ml @@ -442,7 +442,7 @@ struct let invariant _ = [] let show (x:t) = - Format.asprintf "%t%a (env: %a)" GobFormat.pp_set_infinite_geometry A.print x Environment.pp (A.env x) + GobFormat.asprintf "%a (env: %a)" A.print x Environment.pp (A.env x) let pretty () (x:t) = text (show x) let equal x y = @@ -454,7 +454,7 @@ struct let compare (x:t) y: int = (* there is no A.compare, but polymorphic compare should delegate to Abstract0 and Environment compare's implemented in Apron's C *) Stdlib.compare x y - let printXml f x = BatPrintf.fprintf f "\n\n\nconstraints\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (Format.asprintf "%a" A.print x)) Environment.printXml (A.env x) + let printXml f x = BatPrintf.fprintf f "\n\n\nconstraints\n\n\n%s\n\nenv\n\n\n%a\n\n\n" (XmlUtil.escape (GobFormat.asprint A.print x)) Environment.printXml (A.env x) let to_yojson (x: t) = let constraints = diff --git a/src/common/domains/printable.ml b/src/common/domains/printable.ml index b6b1dc5c3a..ee0eda0766 100644 --- a/src/common/domains/printable.ml +++ b/src/common/domains/printable.ml @@ -96,7 +96,7 @@ end module SimpleFormat (P: Formatable) = struct - let show x = Format.asprintf "%t%a" GobFormat.pp_set_infinite_geometry P.pp x + let show x = GobFormat.asprint P.pp x let pretty () x = text (show x) let printXml f x = BatPrintf.fprintf f "\n\n%s\n\n\n" (XmlUtil.escape (show x)) let to_yojson x = `String (show x) diff --git a/src/common/util/gobFormat.ml b/src/common/util/gobFormat.ml index 1b4d28a26c..8f26ff0087 100644 --- a/src/common/util/gobFormat.ml +++ b/src/common/util/gobFormat.ml @@ -23,3 +23,8 @@ let pp_print_nothing (ppf: Format.formatter) () = () let pp_infinity = 1000000001 (* Exact value not exposed before OCaml 5.2, but use the smallest value permitted by documentation. *) let pp_set_infinite_geometry = Format.pp_set_geometry ~max_indent:(pp_infinity - 2) ~margin:(pp_infinity - 1) + +let asprintf (fmt: ('a, Format.formatter, unit, string) format4): 'a = + Format.asprintf ("%t" ^^ fmt) pp_set_infinite_geometry + +let asprint pp x = asprintf "%a" pp x (* eta-expanded to bypass value restriction *) From c2db27d9de0bda2d9de7c91d89a7c03496421446 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 27 Jun 2024 12:36:49 +0300 Subject: [PATCH 079/133] Remove some trailing whitespace --- .../apron/linearTwoVarEqualityDomain.apron.ml | 24 +++++++++---------- src/cdomains/apron/sharedFunctions.apron.ml | 2 +- src/common/domains/printable.ml | 10 ++++---- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index 5558bc2c96..3a9e2d3e11 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -158,7 +158,7 @@ module EqualitiesConjunction = struct let (newref,offs,divi) = (get_rhs d head) in let (coeff,y) = BatOption.get newref in let (y,yrhs) = inverse head (coeff,y,offs,divi) in (* reassemble yrhs out of components *) - let shifted_cluster = (List.fold (fun map i -> + let shifted_cluster = (List.fold (fun map i -> let irhs = (get_rhs d i) in (* old entry is i = irhs *) Rhs.subst yrhs y irhs |> (* new entry for i is irhs [yrhs/y] *) set_rhs map i @@ -222,7 +222,7 @@ module EqualitiesConjunction = struct | Some (coeff,j), ((Some (coeff1,h1), o1, divi1) as oldi)-> (match get_rhs ts j with (* ts[x_j]=o2/d2 ========> ... *) - | (None , o2, divi2) -> + | (None , o2, divi2) -> let newxi = Rhs.subst (None,o2,divi2) j (Some (coeff,j),offs,divi) in let newxh1 = snd @@ inverse i (coeff1,h1,o1,divi1) in let newxh1 = Rhs.subst newxi i newxh1 in @@ -251,7 +251,7 @@ module EqualitiesConjunction = struct else (* var_i = var_i, i.e. it may occur on the rhs of other equalities *) (* so now, we transform with the inverse of the transformer: *) let inv = snd (inverse i (coeff,j,offs,divi)) in - IntMap.fold (fun k v acc -> + IntMap.fold (fun k v acc -> match v with | (Some (c,x),o,d) when x=i-> set_rhs acc k (Rhs.subst inv i v) | _ -> acc @@ -281,7 +281,7 @@ struct let multiply a b = (* if one of them is a constant, then multiply. Otherwise, the expression is not linear *) match a, b with - | [(None,coeff, divi)], c + | [(None,coeff, divi)], c | c, [(None,coeff, divi)] -> multiply_with_Q coeff divi c | _ -> raise NotLinearExpr in @@ -314,7 +314,7 @@ struct | x -> Some(x) (** convert and simplify (wrt. reference variables) a texpr into a tuple of a list of monomials (coeff,varidx,divi) and a (constant/divi) *) - let simplified_monomials_from_texp (t: t) texp = + let simplified_monomials_from_texp (t: t) texp = BatOption.bind (monomials_from_texp t texp) (fun monomiallist -> let d = Option.get t.d in @@ -323,7 +323,7 @@ struct | None -> let gcdee = Z.gcd adiv divi in exprcache,(Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi) | Some (coeff,idx) -> let (somevar,someoffs,somedivi)=Rhs.subst (EConj.get_rhs d idx) idx (v,offs,divi) in (* normalize! *) let newcache = Option.map_default (fun (coef,ter) -> IMap.add ter Q.((IMap.find_default zero ter exprcache) + make coef somedivi) exprcache) exprcache somevar in - let gcdee = Z.gcd adiv divi in + let gcdee = Z.gcd adiv divi in (newcache,(Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi)) in let (expr,constant) = List.fold_left accumulate_constants (IMap.empty,(Z.zero,Z.one)) monomiallist in (* abstract simplification of the guard wrt. reference variables *) @@ -339,7 +339,7 @@ struct BatOption.bind (simplified_monomials_from_texp t texp ) (fun (sum_of_terms, (constant,divisor)) -> (match sum_of_terms with - | [] -> Some (None, constant,divisor) + | [] -> Some (None, constant,divisor) | [(coeff,var,divi)] -> Some (Rhs.canonicalize (Some (Z.mul divisor coeff,var), Z.mul constant divi,Z.mul divisor divi)) |_ -> None)) @@ -447,7 +447,7 @@ struct let t1 = change_d t1 sup_env ~add:true ~del:false in let t2 = change_d t2 sup_env ~add:true ~del:false in match t1.d, t2.d with - | Some d1', Some d2' -> + | Some d1', Some d2' -> EConj.IntMap.fold (fun lhs rhs map -> meet_with_one_conj map lhs rhs) (snd d2') t1 (* even on sparse d2, this will chose the relevant conjs to meet with*) | _ -> {d = None; env = sup_env} @@ -489,7 +489,7 @@ struct - lhs itself - criteria A and B that characterize equivalence class, depending on the reference variable and the affine expression parameters wrt. each EConj - rhs1 - - rhs2 + - rhs2 however, we have to account for the sparseity of EConj maps by manually patching holes with default values *) let joinfunction lhs rhs1 rhs2 = ( @@ -516,15 +516,15 @@ struct let varentry ci offi ch offh xh = let (coeff,off,d) = Q.(ci,(offi*ch)-(ci*offh),ch) in (* compute new rhs in Q *) let (coeff,off,d) = Z.(coeff.num*d.den*off.den,off.num*d.den*coeff.den,d. num*coeff.den*off.den) in (* convert that back into Z *) - Rhs.canonicalize (Some(coeff,xh),off,d) + Rhs.canonicalize (Some(coeff,xh),off,d) in (* ci1 = a*ch1+b /\ ci2 = a*ch2+b *) (* ===> a = (ci1-ci2)/(ch1-ch2) b = ci2-a*ch2 *) - let constentry ci1 ci2 ch1 ch2 xh = + let constentry ci1 ci2 ch1 ch2 xh = let a = Q.((ci1-ci2) / (ch1-ch2)) in let b = Q.(ci2 - a*ch2) in Rhs.canonicalize (Some (Z.(a.num*b.den),xh),Z.(b.num*a.den) ,Z.(a.den*b.den) ) in - let iterate map l = + let iterate map l = match l with | (_, _, _, rhs , rhs' ) :: t when Rhs.equal rhs rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> List.fold (fun acc (i,_,_,(monom,oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make (fst@@Option.get monom) di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 8c94c996b0..8167667293 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -136,7 +136,7 @@ struct let expr = (** simplify asks for a constant value of some subexpression e, similar to a constant fold. In particular but not exclusively this query is answered by the 2 var equalities domain itself. This normalizes arbitrary expressions to a point where they - might be able to be represented by means of 2 var equalities + might be able to be represented by means of 2 var equalities This simplification happens during a time, when there are temporary variables a#in and a#out part of the expression, but are not represented in the ctx, thus queries may result in top for these variables. Wrapping this in speculative diff --git a/src/common/domains/printable.ml b/src/common/domains/printable.ml index 1a642c932a..199113a5d8 100644 --- a/src/common/domains/printable.ml +++ b/src/common/domains/printable.ml @@ -588,7 +588,7 @@ module Prod4 (Base1: S) (Base2: S) (Base3: S) (Base4: S) = struct let arbitrary () = QCheck.quad (Base1.arbitrary ()) (Base2.arbitrary ()) (Base3.arbitrary ()) (Base4.arbitrary ()) end -module PQueue (Base: S) = +module PQueue (Base: S) = struct type t = Base.t BatDeque.dq include Std @@ -604,22 +604,22 @@ struct let rec loop n q = match BatDeque.front q with | None -> () - | Some (x, xs) -> (BatPrintf.fprintf f "%d\n%a\n" n Base.printXml x; + | Some (x, xs) -> (BatPrintf.fprintf f "%d\n%a\n" n Base.printXml x; loop (n+1) (xs)) in BatPrintf.fprintf f "\n\n"; - loop 0 xs; + loop 0 xs; BatPrintf.fprintf f "\n\n" let to_yojson q = `List (BatDeque.to_list @@ BatDeque.map (Base.to_yojson) q) let hash q = BatDeque.fold_left (fun acc x -> (acc + 71) * (Base.hash x)) 11 q let equal q1 q2 = BatDeque.eq ~eq:Base.equal q1 q2 - let compare q1 q2 = + let compare q1 q2 = match BatDeque.front q1, BatDeque.front q2 with | None, None -> 0 | None, Some(_, _) -> -1 | Some(_, _), None -> 1 - | Some(a1, q1'), Some(a2, q2') -> + | Some(a1, q1'), Some(a2, q2') -> let c = Base.compare a1 a2 in if c <> 0 then c else compare q1' q2' From 47b9f44d67539fed3fc534a22ea999d47d656417 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 28 Jun 2024 12:09:47 +0300 Subject: [PATCH 080/133] Add package description (closes #1528) --- dune-project | 5 +++++ goblint.opam | 5 +++++ goblint.opam.locked | 4 ++++ 3 files changed, 14 insertions(+) diff --git a/dune-project b/dune-project index b85a82b93f..f07ccf4236 100644 --- a/dune-project +++ b/dune-project @@ -22,6 +22,11 @@ (package (name goblint) (synopsis "Static analysis framework for C") + (description "\ +Goblint is a sound static analysis framework for C programs using abstract interpretation. +It specializes in thread-modular verification of multi-threaded programs, especially regarding data races. +Goblint includes analyses for assertions, overflows, deadlocks, etc and can be extended with new analyses. +") (depends (ocaml (>= 4.14)) (goblint-cil (>= 2.0.3)) ; TODO no way to define as pin-depends? Used goblint.opam.template to add it for now. https://github.com/ocaml/dune/issues/3231. Alternatively, removing this line and adding cil as a git submodule and `(vendored_dirs cil)` as ./dune also works. This way, no more need to reinstall the pinned cil opam package on changes. However, then cil is cleaned and has to be rebuild together with goblint. diff --git a/goblint.opam b/goblint.opam index 03e11d456a..eec74439a0 100644 --- a/goblint.opam +++ b/goblint.opam @@ -1,6 +1,11 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Static analysis framework for C" +description: """ +Goblint is a sound static analysis framework for C programs using abstract interpretation. +It specializes in thread-modular verification of multi-threaded programs, especially regarding data races. +Goblint includes analyses for assertions, overflows, deadlocks, etc and can be extended with new analyses. +""" maintainer: [ "Simmo Saan " "Michael Schwarz " diff --git a/goblint.opam.locked b/goblint.opam.locked index 0cf9a2ff75..90bfba68f0 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -143,3 +143,7 @@ pin-depends: [ ] ] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} +description: """\ +Goblint is a sound static analysis framework for C programs using abstract interpretation. +It specializes in thread-modular verification of multi-threaded programs, especially regarding data races. +Goblint includes analyses for assertions, overflows, deadlocks, etc and can be extended with new analyses.""" From c078eaa015ef54bf70b4d0598dea46ef1675c70e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 28 Jun 2024 12:19:19 +0300 Subject: [PATCH 081/133] Add package tags --- dune-project | 8 ++++++++ goblint.opam | 9 +++++++++ goblint.opam.locked | 9 +++++++++ 3 files changed, 26 insertions(+) diff --git a/dune-project b/dune-project index f07ccf4236..8d9d53623b 100644 --- a/dune-project +++ b/dune-project @@ -27,6 +27,14 @@ Goblint is a sound static analysis framework for C programs using abstract inter It specializes in thread-modular verification of multi-threaded programs, especially regarding data races. Goblint includes analyses for assertions, overflows, deadlocks, etc and can be extended with new analyses. ") + (tags ( + "program analysis" + "program verification" + "static analysis" + "abstract interpretation" + "C" + "data race analysis" + "concurrency")) (depends (ocaml (>= 4.14)) (goblint-cil (>= 2.0.3)) ; TODO no way to define as pin-depends? Used goblint.opam.template to add it for now. https://github.com/ocaml/dune/issues/3231. Alternatively, removing this line and adding cil as a git submodule and `(vendored_dirs cil)` as ./dune also works. This way, no more need to reinstall the pinned cil opam package on changes. However, then cil is cleaned and has to be rebuild together with goblint. diff --git a/goblint.opam b/goblint.opam index eec74439a0..e198bf6f3c 100644 --- a/goblint.opam +++ b/goblint.opam @@ -22,6 +22,15 @@ authors: [ "Vesal Vojdani" ] license: "MIT" +tags: [ + "program analysis" + "program verification" + "static analysis" + "abstract interpretation" + "C" + "data race analysis" + "concurrency" +] homepage: "https://goblint.in.tum.de" doc: "https://goblint.readthedocs.io/en/latest/" bug-reports: "https://github.com/goblint/analyzer/issues" diff --git a/goblint.opam.locked b/goblint.opam.locked index 90bfba68f0..b1d8030c1c 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -147,3 +147,12 @@ description: """\ Goblint is a sound static analysis framework for C programs using abstract interpretation. It specializes in thread-modular verification of multi-threaded programs, especially regarding data races. Goblint includes analyses for assertions, overflows, deadlocks, etc and can be extended with new analyses.""" +tags: [ + "program analysis" + "program verification" + "static analysis" + "abstract interpretation" + "C" + "data race analysis" + "concurrency" +] From 4fe33dcf25c095acd6e2a561ffa779e7d9b87a93 Mon Sep 17 00:00:00 2001 From: "Dr. Michael Petter" Date: Fri, 28 Jun 2024 11:22:34 +0200 Subject: [PATCH 082/133] make sure that exact division is possible --- src/cdomains/apron/sharedFunctions.apron.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 022e60200d..e46f8b2f4b 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -33,7 +33,9 @@ let int_of_scalar ?(scalewith=Z.one) ?round (scalar: Scalar.t) = begin match round with | Some `Floor -> Some (Mpzf.mul scale (Mpzf.fdiv_q n d)) (* floor division *) | Some `Ceil -> Some (Mpzf.mul scale (Mpzf.cdiv_q n d)) (* ceiling division *) - | None -> Some (Mpzf.divexact (Mpzf.mul scale n ) d) (* scale, preferably with common denominator *) + | None -> if Mpz.divisible_p (Mpzf.mul scale n ) d then + Some (Mpzf.divexact (Mpzf.mul scale n ) d) (* scale, preferably with common denominator *) + else None end in Z_mlgmpidl.z_of_mpzf z From 8ddbc43a728260596995cf9ecfb9cbbb6049171f Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Fri, 28 Jun 2024 15:44:24 +0300 Subject: [PATCH 083/133] Update results table in relationalAnalysis only if exp.relation.prec-dump is set --- src/analyses/apron/relationAnalysis.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index a42d78d71a..ad99e26b58 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -756,7 +756,7 @@ struct let sync ctx reason = (* After the solver is finished, store the results (for later comparison) *) - if !AnalysisState.postsolving then begin + if !AnalysisState.postsolving && GobConfig.get_string "exp.relation.prec-dump" <> "" then begin let keep_local = GobConfig.get_bool "ana.relation.invariant.local" in let keep_global = GobConfig.get_bool "ana.relation.invariant.global" in From 4d5a4085c67090a173ffdeb56d20b3cd0a1f5143 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 2 Jul 2024 11:06:30 +0200 Subject: [PATCH 084/133] removed unused parameter --- src/cdomains/apron/sharedFunctions.apron.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index e46f8b2f4b..9652942136 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -300,14 +300,14 @@ struct | Mpqf f -> Some (Z_mlgmpidl.q_of_mpqf f) | _ -> raise UnsupportedScalar in - let extract_den (c:Coeff.union_5) _ = + let extract_den (c:Coeff.union_5) = match c with | Scalar c -> BatOption.map Q.den (frac_of_scalar c) | _ -> None in - let lcm_denom = ref (BatOption.default Z.one (extract_den (Linexpr1.get_cst linexpr1) ())) in - let lcm_coeff (c:Coeff.union_5) v = - match (extract_den c v) with + let lcm_denom = ref (BatOption.default Z.one (extract_den (Linexpr1.get_cst linexpr1))) in + let lcm_coeff (c:Coeff.union_5) _ = + match (extract_den c) with | Some z -> lcm_denom := Z.lcm z !lcm_denom | _ -> () in From 05dfb9fcc0dfb75659767fc6d210db08023eb514 Mon Sep 17 00:00:00 2001 From: Michael Petter Date: Tue, 2 Jul 2024 13:55:47 +0200 Subject: [PATCH 085/133] pulled out product --- src/cdomains/apron/sharedFunctions.apron.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 9652942136..668b6af5d4 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -33,8 +33,8 @@ let int_of_scalar ?(scalewith=Z.one) ?round (scalar: Scalar.t) = begin match round with | Some `Floor -> Some (Mpzf.mul scale (Mpzf.fdiv_q n d)) (* floor division *) | Some `Ceil -> Some (Mpzf.mul scale (Mpzf.cdiv_q n d)) (* ceiling division *) - | None -> if Mpz.divisible_p (Mpzf.mul scale n ) d then - Some (Mpzf.divexact (Mpzf.mul scale n ) d) (* scale, preferably with common denominator *) + | None -> let product = Mpzf.mul scale n in if Mpz.divisible_p product d then + Some (Mpzf.divexact product d) (* scale, preferably with common denominator *) else None end in From dd2932f56bbabc1da077206e7cbae19f69d301d5 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Tue, 2 Jul 2024 20:16:10 +0000 Subject: [PATCH 086/133] Bump ocaml/setup-ocaml from 2 to 3 Bumps [ocaml/setup-ocaml](https://github.com/ocaml/setup-ocaml) from 2 to 3. - [Release notes](https://github.com/ocaml/setup-ocaml/releases) - [Changelog](https://github.com/ocaml/setup-ocaml/blob/master/CHANGELOG.md) - [Commits](https://github.com/ocaml/setup-ocaml/compare/v2...v3) --- updated-dependencies: - dependency-name: ocaml/setup-ocaml dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/coverage.yml | 2 +- .github/workflows/docs.yml | 2 +- .github/workflows/indentation.yml | 2 +- .github/workflows/locked.yml | 6 +++--- .github/workflows/unlocked.yml | 6 +++--- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index d4fc872620..245c7eb23b 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -35,7 +35,7 @@ jobs: # otherwise setup-ocaml pins non-locked dependencies # https://github.com/ocaml/setup-ocaml/issues/166 OPAMLOCKED: locked - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index 242acef3de..253c7514b4 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -35,7 +35,7 @@ jobs: # otherwise setup-ocaml pins non-locked dependencies # https://github.com/ocaml/setup-ocaml/issues/166 OPAMLOCKED: locked - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} diff --git a/.github/workflows/indentation.yml b/.github/workflows/indentation.yml index e22e674301..96ef5ee56a 100644 --- a/.github/workflows/indentation.yml +++ b/.github/workflows/indentation.yml @@ -25,7 +25,7 @@ jobs: fetch-depth: 0 - name: Set up OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} diff --git a/.github/workflows/locked.yml b/.github/workflows/locked.yml index 18935725ca..5f795fcf67 100644 --- a/.github/workflows/locked.yml +++ b/.github/workflows/locked.yml @@ -37,7 +37,7 @@ jobs: # otherwise setup-ocaml pins non-locked dependencies # https://github.com/ocaml/setup-ocaml/issues/166 OPAMLOCKED: locked - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) @@ -87,7 +87,7 @@ jobs: # otherwise setup-ocaml pins non-locked dependencies # https://github.com/ocaml/setup-ocaml/issues/166 OPAMLOCKED: locked - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) @@ -132,7 +132,7 @@ jobs: # otherwise setup-ocaml pins non-locked dependencies # https://github.com/ocaml/setup-ocaml/issues/166 OPAMLOCKED: locked - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} diff --git a/.github/workflows/unlocked.yml b/.github/workflows/unlocked.yml index f1bd399a17..935bcfab25 100644 --- a/.github/workflows/unlocked.yml +++ b/.github/workflows/unlocked.yml @@ -45,7 +45,7 @@ jobs: uses: actions/checkout@v4 - name: Set up OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) @@ -106,7 +106,7 @@ jobs: uses: actions/checkout@v4 - name: Set up OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) @@ -199,7 +199,7 @@ jobs: uses: actions/checkout@v4 - name: Set up OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) From d1663cfc3e073dda53f9f7d328af68cd4b727729 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 3 Jul 2024 11:39:55 +0300 Subject: [PATCH 087/133] Remove opam-depext-flags from ocaml/setup-ocaml@v3 It has been removed now and didn't work anyway. --- .github/workflows/coverage.yml | 1 - .github/workflows/locked.yml | 2 -- .github/workflows/unlocked.yml | 3 --- 3 files changed, 6 deletions(-) diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index 245c7eb23b..47feb77d0b 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -38,7 +38,6 @@ jobs: uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) - name: Install graph-easy # TODO: remove if depext --with-test works if: ${{ matrix.os == 'ubuntu-latest' }} diff --git a/.github/workflows/locked.yml b/.github/workflows/locked.yml index 5f795fcf67..dbcb46635a 100644 --- a/.github/workflows/locked.yml +++ b/.github/workflows/locked.yml @@ -40,7 +40,6 @@ jobs: uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) - name: Install graph-easy # TODO: remove if depext --with-test works if: ${{ matrix.os == 'ubuntu-latest' }} @@ -90,7 +89,6 @@ jobs: uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) - name: Install graph-easy # TODO: remove if depext --with-test works if: ${{ matrix.os == 'ubuntu-latest' }} diff --git a/.github/workflows/unlocked.yml b/.github/workflows/unlocked.yml index 935bcfab25..60a9003c16 100644 --- a/.github/workflows/unlocked.yml +++ b/.github/workflows/unlocked.yml @@ -48,7 +48,6 @@ jobs: uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) - name: Install graph-easy # TODO: remove if depext --with-test works if: ${{ matrix.os == 'ubuntu-latest' }} @@ -109,7 +108,6 @@ jobs: uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) - name: Install graph-easy # TODO: remove if depext --with-test works if: ${{ matrix.os == 'ubuntu-latest' }} @@ -202,7 +200,6 @@ jobs: uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-depext-flags: --with-test # doesn't work (https://github.com/ocaml/opam/issues/5836) - name: Install graph-easy # TODO: remove if depext --with-test works if: ${{ matrix.os == 'ubuntu-latest' }} From 502cf9f7b7ad704025270a6b8a6df1570927783a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 4 Jul 2024 11:45:38 +0300 Subject: [PATCH 088/133] Use setup-ocaml@v2 for lower-bounds CI opam-0install is incompatible with opam 2.2 --- .github/workflows/unlocked.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/unlocked.yml b/.github/workflows/unlocked.yml index 60a9003c16..e4be79e630 100644 --- a/.github/workflows/unlocked.yml +++ b/.github/workflows/unlocked.yml @@ -105,7 +105,7 @@ jobs: uses: actions/checkout@v4 - name: Set up OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@v3 + uses: ocaml/setup-ocaml@v2 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} From 71a1657124fd4f9fb12e954f199189f8ef6e5244 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 5 Jul 2024 13:09:03 +0300 Subject: [PATCH 089/133] Remove apron v0.9.15 pin --- goblint.opam | 1 - goblint.opam.locked | 4 ---- goblint.opam.template | 1 - 3 files changed, 6 deletions(-) diff --git a/goblint.opam b/goblint.opam index ec6a1f8fcb..0cc5eab3a2 100644 --- a/goblint.opam +++ b/goblint.opam @@ -84,7 +84,6 @@ pin-depends: [ [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] # 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" ] - [ "apron.v0.9.15" "git+https://github.com/antoinemine/apron.git#b3172bd51e4bb0135716a300cab424a56970d96f" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.locked b/goblint.opam.locked index 8b184e189d..532b8e1aff 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -140,9 +140,5 @@ pin-depends: [ "ppx_deriving.5.2.1" "git+https://github.com/ocaml-ppx/ppx_deriving.git#0a89b619f94cbbfc3b0fb3255ab4fe5bc77d32d6" ] - [ - "apron.v0.9.15" - "git+https://github.com/antoinemine/apron.git#b3172bd51e4bb0135716a300cab424a56970d96f" - ] ] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.template b/goblint.opam.template index 27be21015f..2d5ef10bc9 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -6,7 +6,6 @@ pin-depends: [ [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] # 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" ] - [ "apron.v0.9.15" "git+https://github.com/antoinemine/apron.git#b3172bd51e4bb0135716a300cab424a56970d96f" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} From a23b728a4023b9c8582c852b7f6d31ceb4f8b328 Mon Sep 17 00:00:00 2001 From: Fabian Stemmler Date: Thu, 11 Jul 2024 11:29:39 +0200 Subject: [PATCH 090/133] propagate bottom through narrowing operator of lifters --- src/domain/lattice.ml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/domain/lattice.ml b/src/domain/lattice.ml index 99322c09d8..d45ddcbfc2 100644 --- a/src/domain/lattice.ml +++ b/src/domain/lattice.ml @@ -277,6 +277,8 @@ struct let narrow x y = match (x,y) with | (`Lifted x, `Lifted y) -> `Lifted (Base.narrow x y) + | (_, `Bot) -> `Bot + | (`Top, y) -> y | _ -> x end @@ -337,6 +339,8 @@ struct | (`Lifted x, `Lifted y) -> (try `Lifted (Base.narrow x y) with Uncomparable -> `Bot) + | (_, `Bot) -> `Bot + | (`Top, y) -> y | _ -> x end @@ -408,6 +412,8 @@ struct match (x,y) with | (`Lifted1 x, `Lifted1 y) -> `Lifted1 (Base1.narrow x y) | (`Lifted2 x, `Lifted2 y) -> `Lifted2 (Base2.narrow x y) + | (_, `Bot) -> `Bot + | (`Top, y) -> y | _ -> x end @@ -539,6 +545,7 @@ struct let narrow x y = match (x,y) with | (`Lifted x, `Lifted y) -> `Lifted (Base.narrow x y) + | (_, `Bot) -> `Bot | _ -> x end @@ -580,6 +587,7 @@ struct let narrow x y = match (x,y) with | (`Lifted x, `Lifted y) -> `Lifted (Base.narrow x y) + | (`Top, y) -> y | _ -> x let pretty_diff () (x,y) = From 11ed4180e3064e4d43fb01751df553e233235a77 Mon Sep 17 00:00:00 2001 From: Jonas August Date: Thu, 29 Jun 2023 08:29:30 +0200 Subject: [PATCH 091/133] Fix depreciated option --- tests/regression/46-apron2/26-autotune.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/regression/46-apron2/26-autotune.c b/tests/regression/46-apron2/26-autotune.c index 96c5c85278..ec8f55fe19 100644 --- a/tests/regression/46-apron2/26-autotune.c +++ b/tests/regression/46-apron2/26-autotune.c @@ -1,4 +1,4 @@ -//SKIP PARAM: --enable ana.int.interval --sets sem.int.signed_overflow assume_none --set ana.activated[+] apron --enable ana.autotune.enabled +//SKIP PARAM: --enable ana.int.interval --set sem.int.signed_overflow assume_none --set ana.activated[+] apron --enable ana.autotune.enabled // Check that autotuner disables context for apron as well for recursive calls #include From 0077e1d78857f238aae4fb87a0d7b0ef5aba5b9c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 16 Jul 2024 15:09:51 +0300 Subject: [PATCH 092/133] Replace --sets with --set in tests --- scripts/creduce/privPrecCompare.sh | 2 +- scripts/privPrecCompare.sh | 2 +- tests/regression/01-cpa/71-widen-sides.c | 2 +- tests/regression/46-apron2/03-other-assume.c | 2 +- tests/regression/46-apron2/04-other-assume-inprec.c | 2 +- tests/regression/46-apron2/30-autotune-stub.c | 2 +- tests/regression/58-base-mm-tid/01-tid-toy1.c | 2 +- tests/regression/58-base-mm-tid/22-other-assume.c | 2 +- tests/regression/58-base-mm-tid/23-other-assume-inprec.c | 2 +- tests/regression/66-interval-set-one/51-widen-sides.c | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) diff --git a/scripts/creduce/privPrecCompare.sh b/scripts/creduce/privPrecCompare.sh index fdc5f9219d..2165112924 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 warn.debug &> $LOG + $GOBLINTDIR/goblint --set exp.privatization $PRIV --set exp.priv-prec-dump $PRIVDUMP $OPTS -v --enable warn.debug &> $LOG grep -F "Function definition missing" $LOG && exit 1 done diff --git a/scripts/privPrecCompare.sh b/scripts/privPrecCompare.sh index c5b9f2c01e..2b09fb80b5 100755 --- a/scripts/privPrecCompare.sh +++ b/scripts/privPrecCompare.sh @@ -10,7 +10,7 @@ mkdir -p $OUTDIR for PRIV in "${PRIVS[@]}"; do echo $PRIV PRIVDUMP="$OUTDIR/$PRIV" - ./goblint --sets exp.privatization $PRIV --sets exp.priv-prec-dump $PRIVDUMP "$@" + ./goblint --set exp.privatization $PRIV --set exp.priv-prec-dump $PRIVDUMP "$@" done PRIVDUMPS=("${PRIVS[*]/#/$OUTDIR/}") # why [*] here? diff --git a/tests/regression/01-cpa/71-widen-sides.c b/tests/regression/01-cpa/71-widen-sides.c index 522f6fae44..a93124c6e5 100644 --- a/tests/regression/01-cpa/71-widen-sides.c +++ b/tests/regression/01-cpa/71-widen-sides.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.ctx_insens "['base', 'mallocWrapper']" --enable ana.int.interval --sets solvers.td3.side_widen sides-local +// PARAM: --set ana.ctx_insens "['base', 'mallocWrapper']" --enable ana.int.interval --set solvers.td3.side_widen sides-local #include int further(int n) { diff --git a/tests/regression/46-apron2/03-other-assume.c b/tests/regression/46-apron2/03-other-assume.c index 635911a197..c136d1bde3 100644 --- a/tests/regression/46-apron2/03-other-assume.c +++ b/tests/regression/46-apron2/03-other-assume.c @@ -1,4 +1,4 @@ -// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --set ana.activated[+] threadJoins --sets ana.relation.privatization mutex-meet-tid +// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --set ana.activated[+] threadJoins --set ana.relation.privatization mutex-meet-tid #include #include diff --git a/tests/regression/46-apron2/04-other-assume-inprec.c b/tests/regression/46-apron2/04-other-assume-inprec.c index 09b8d150a8..ccf8ecefa1 100644 --- a/tests/regression/46-apron2/04-other-assume-inprec.c +++ b/tests/regression/46-apron2/04-other-assume-inprec.c @@ -1,4 +1,4 @@ -// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --set ana.activated[+] threadJoins --sets ana.relation.privatization mutex-meet-tid +// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --set ana.activated[+] threadJoins --set ana.relation.privatization mutex-meet-tid #include #include diff --git a/tests/regression/46-apron2/30-autotune-stub.c b/tests/regression/46-apron2/30-autotune-stub.c index e1b7603c3b..02c80e7d21 100644 --- a/tests/regression/46-apron2/30-autotune-stub.c +++ b/tests/regression/46-apron2/30-autotune-stub.c @@ -1,4 +1,4 @@ -//SKIP PARAM: --enable ana.int.interval --sets sem.int.signed_overflow assume_none --set ana.activated[+] apron --enable ana.autotune.enabled +//SKIP PARAM: --enable ana.int.interval --set sem.int.signed_overflow assume_none --set ana.activated[+] apron --enable ana.autotune.enabled // Check that autotuner respect goblint_stub attributes as hints to not track variables. #include diff --git a/tests/regression/58-base-mm-tid/01-tid-toy1.c b/tests/regression/58-base-mm-tid/01-tid-toy1.c index bc3cd18efa..49e96881d1 100644 --- a/tests/regression/58-base-mm-tid/01-tid-toy1.c +++ b/tests/regression/58-base-mm-tid/01-tid-toy1.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.path_sens[+] threadflag --sets ana.base.privatization mutex-meet-tid +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid // Inspired by 36/71 #include #include diff --git a/tests/regression/58-base-mm-tid/22-other-assume.c b/tests/regression/58-base-mm-tid/22-other-assume.c index 4f5c73b038..301195ac1f 100644 --- a/tests/regression/58-base-mm-tid/22-other-assume.c +++ b/tests/regression/58-base-mm-tid/22-other-assume.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.path_sens[+] threadflag --sets ana.base.privatization mutex-meet-tid +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid // Copy of 46/03 for base #include #include diff --git a/tests/regression/58-base-mm-tid/23-other-assume-inprec.c b/tests/regression/58-base-mm-tid/23-other-assume-inprec.c index 37e59d3edf..a4bac04c59 100644 --- a/tests/regression/58-base-mm-tid/23-other-assume-inprec.c +++ b/tests/regression/58-base-mm-tid/23-other-assume-inprec.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.path_sens[+] threadflag --sets ana.base.privatization mutex-meet-tid --set ana.activated[+] threadJoins +// PARAM: --set ana.path_sens[+] threadflag --set ana.base.privatization mutex-meet-tid --set ana.activated[+] threadJoins // Copy of 46/04 for base #include #include diff --git a/tests/regression/66-interval-set-one/51-widen-sides.c b/tests/regression/66-interval-set-one/51-widen-sides.c index b086baf026..53fe749704 100644 --- a/tests/regression/66-interval-set-one/51-widen-sides.c +++ b/tests/regression/66-interval-set-one/51-widen-sides.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.ctx_insens "['base', 'mallocWrapper']" --enable ana.int.interval_set --sets solvers.td3.side_widen sides-local +// PARAM: --set ana.ctx_insens "['base', 'mallocWrapper']" --enable ana.int.interval_set --set solvers.td3.side_widen sides-local #include int further(int n) { From 67c18668154d79ce5cdd71c887788c8cfa09aab0 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Fri, 8 Dec 2023 14:26:31 +0100 Subject: [PATCH 093/133] change may fail to fail annotation --- tests/regression/36-apron/86-branched-thread-creation.c | 2 +- tests/regression/58-base-mm-tid/15-branched-thread-creation.c | 2 +- .../67-interval-sets-two/16-branched-thread-creation.c | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/regression/36-apron/86-branched-thread-creation.c b/tests/regression/36-apron/86-branched-thread-creation.c index cac0a881a6..91a5411e8f 100644 --- a/tests/regression/36-apron/86-branched-thread-creation.c +++ b/tests/regression/36-apron/86-branched-thread-creation.c @@ -40,7 +40,7 @@ int main(void) { if(!mt) { pthread_mutex_lock(&mutex); - __goblint_check(g==h); //MAYFAIL + __goblint_check(g==h); //FAIL pthread_mutex_unlock(&mutex); } diff --git a/tests/regression/58-base-mm-tid/15-branched-thread-creation.c b/tests/regression/58-base-mm-tid/15-branched-thread-creation.c index 3292182adc..c7bb43519f 100644 --- a/tests/regression/58-base-mm-tid/15-branched-thread-creation.c +++ b/tests/regression/58-base-mm-tid/15-branched-thread-creation.c @@ -41,7 +41,7 @@ int main(void) { if(!mt) { pthread_mutex_lock(&mutex); - __goblint_check(g==h); //MAYFAIL + __goblint_check(g==h); //FAIL pthread_mutex_unlock(&mutex); } diff --git a/tests/regression/67-interval-sets-two/16-branched-thread-creation.c b/tests/regression/67-interval-sets-two/16-branched-thread-creation.c index c309ec8ffd..d97f800621 100644 --- a/tests/regression/67-interval-sets-two/16-branched-thread-creation.c +++ b/tests/regression/67-interval-sets-two/16-branched-thread-creation.c @@ -41,7 +41,7 @@ int main(void) { if(!mt) { pthread_mutex_lock(&mutex); - __goblint_check(g==h); //MAYFAIL + __goblint_check(g==h); //FAIL pthread_mutex_unlock(&mutex); } From f1c6e2c6d4acf94a2137433d34364c8c639c9aec Mon Sep 17 00:00:00 2001 From: J2000A Date: Fri, 5 May 2023 14:41:52 +0200 Subject: [PATCH 094/133] Adjust evalAssert to offer __goblint_check(exp) with the option trans.goblint-check --- src/config/options.schema.json | 6 ++++++ src/transform/evalAssert.ml | 7 +++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/src/config/options.schema.json b/src/config/options.schema.json index d259a6f418..2e2a9212ef 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -1561,6 +1561,12 @@ "description": "Output filename for transformations that output a transformed file.", "type":"string", "default": "transformed.c" + }, + "goblint-check" : { + "title": "trans.goblint-check", + "description": "Write __Goblint_Check(exp) in the file instead of __VERIFIER_assert(exp).", + "type": "boolean", + "default": false } }, "additionalProperties": false diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index eab06222ef..82b92b9040 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -26,8 +26,11 @@ module EvalAssert = struct (* should asserts be surrounded by __VERIFIER_atomic_{begin,end}? *) let surroundByAtomic = true + (* variable for generating __goblint_check(exp) instead of __VERIFIER_assert(exp)*) + let goblintCheck = GobConfig.get_bool "trans.goblint-check" + (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) - let ass = makeVarinfo true "__VERIFIER_assert" (TVoid []) + let ass = if goblintCheck then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) let atomicBegin = makeVarinfo true "__VERIFIER_atomic_begin" (TVoid []) let atomicEnd = makeVarinfo true "__VERIFIER_atomic_end" (TVoid []) @@ -60,7 +63,7 @@ module EvalAssert = struct | `Lifted e -> let es = WitnessUtil.InvariantExp.process_exp e in let asserts = List.map (fun e -> cInstr ("%v:assert (%e:exp);") loc [("assert", Fv ass); ("exp", Fe e)]) es in - if surroundByAtomic then + if surroundByAtomic && not goblintCheck then let abegin = (cInstr ("%v:__VERIFIER_atomic_begin();") loc [("__VERIFIER_atomic_begin", Fv atomicBegin)]) in let aend = (cInstr ("%v:__VERIFIER_atomic_end();") loc [("__VERIFIER_atomic_end", Fv atomicEnd)]) in abegin :: (asserts @ [aend]) From 8db9e1d320de69baf396bab7b56f55149f577a69 Mon Sep 17 00:00:00 2001 From: Jonas August Date: Wed, 10 May 2023 19:24:34 +0200 Subject: [PATCH 095/133] Adopt evalAssert.ml so the option is checked correctly at runtime --- src/transform/evalAssert.ml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index 82b92b9040..fb9cf84d86 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -26,11 +26,6 @@ module EvalAssert = struct (* should asserts be surrounded by __VERIFIER_atomic_{begin,end}? *) let surroundByAtomic = true - (* variable for generating __goblint_check(exp) instead of __VERIFIER_assert(exp)*) - let goblintCheck = GobConfig.get_bool "trans.goblint-check" - - (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) - let ass = if goblintCheck then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) let atomicBegin = makeVarinfo true "__VERIFIER_atomic_begin" (TVoid []) let atomicEnd = makeVarinfo true "__VERIFIER_atomic_end" (TVoid []) @@ -41,6 +36,8 @@ module EvalAssert = struct (* TODO: handle witness.invariant.loop-head *) val emit_after_lock = GobConfig.get_bool "witness.invariant.after-lock" val emit_other = GobConfig.get_bool "witness.invariant.other" + (* variable for generating __goblint_check(exp) instead of __VERIFIER_assert(exp) *) + val goblintCheck = GobConfig.get_bool "trans.goblint-check" method! vstmt s = let is_lock exp args = @@ -53,6 +50,10 @@ module EvalAssert = struct | _ -> false in + (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) + (* Moved in method because Options can not be checked in the module *) + let ass = if goblintCheck then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) in + let make_assert ~node loc lval = let lvals = match lval with | None -> Lval.Set.top () From 21d804a0a1ea9337075be413d30ec02cdfd5e274 Mon Sep 17 00:00:00 2001 From: Jonas August Date: Tue, 16 May 2023 18:00:31 +0200 Subject: [PATCH 096/133] Fix Goblint Option Retrieving by adding Unit to constant --- src/transform/evalAssert.ml | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index fb9cf84d86..7fc70531db 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -26,6 +26,11 @@ module EvalAssert = struct (* should asserts be surrounded by __VERIFIER_atomic_{begin,end}? *) let surroundByAtomic = true + (* variable for generating __goblint_check(exp) instead of __VERIFIER_assert(exp) *) + let goblintCheck () = GobConfig.get_bool "trans.goblint-check" + + (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) + let ass () = if goblintCheck then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) in let atomicBegin = makeVarinfo true "__VERIFIER_atomic_begin" (TVoid []) let atomicEnd = makeVarinfo true "__VERIFIER_atomic_end" (TVoid []) @@ -36,8 +41,6 @@ module EvalAssert = struct (* TODO: handle witness.invariant.loop-head *) val emit_after_lock = GobConfig.get_bool "witness.invariant.after-lock" val emit_other = GobConfig.get_bool "witness.invariant.other" - (* variable for generating __goblint_check(exp) instead of __VERIFIER_assert(exp) *) - val goblintCheck = GobConfig.get_bool "trans.goblint-check" method! vstmt s = let is_lock exp args = @@ -50,10 +53,6 @@ module EvalAssert = struct | _ -> false in - (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) - (* Moved in method because Options can not be checked in the module *) - let ass = if goblintCheck then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) in - let make_assert ~node loc lval = let lvals = match lval with | None -> Lval.Set.top () From 69a33364e018a4aaea787b8aa4bda58441bd5b41 Mon Sep 17 00:00:00 2001 From: Jonas August Date: Tue, 23 May 2023 20:48:36 +0200 Subject: [PATCH 097/133] Bugfix --- src/transform/evalAssert.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index 7fc70531db..56f3d5eb5f 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -30,7 +30,7 @@ module EvalAssert = struct let goblintCheck () = GobConfig.get_bool "trans.goblint-check" (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) - let ass () = if goblintCheck then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) in + let ass () = if goblintCheck () then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) let atomicBegin = makeVarinfo true "__VERIFIER_atomic_begin" (TVoid []) let atomicEnd = makeVarinfo true "__VERIFIER_atomic_end" (TVoid []) @@ -62,8 +62,8 @@ module EvalAssert = struct match (ask ~node loc).f (Queries.Invariant context) with | `Lifted e -> let es = WitnessUtil.InvariantExp.process_exp e in - let asserts = List.map (fun e -> cInstr ("%v:assert (%e:exp);") loc [("assert", Fv ass); ("exp", Fe e)]) es in - if surroundByAtomic && not goblintCheck then + let asserts = List.map (fun e -> cInstr ("%v:assert (%e:exp);") loc [("assert", Fv (ass ())); ("exp", Fe e)]) es in + if surroundByAtomic && not (goblintCheck ()) then let abegin = (cInstr ("%v:__VERIFIER_atomic_begin();") loc [("__VERIFIER_atomic_begin", Fv atomicBegin)]) in let aend = (cInstr ("%v:__VERIFIER_atomic_end();") loc [("__VERIFIER_atomic_end", Fv atomicEnd)]) in abegin :: (asserts @ [aend]) From 3e3c1ebda3871a079fbbe65c4b84828fdbbfc914 Mon Sep 17 00:00:00 2001 From: stilscher <66023521+stilscher@users.noreply.github.com> Date: Fri, 8 Dec 2023 14:37:44 +0100 Subject: [PATCH 098/133] rename option --- src/config/options.schema.json | 18 +++++++++++++----- src/transform/evalAssert.ml | 2 +- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/config/options.schema.json b/src/config/options.schema.json index 2e2a9212ef..d808f121c3 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -1562,11 +1562,19 @@ "type":"string", "default": "transformed.c" }, - "goblint-check" : { - "title": "trans.goblint-check", - "description": "Write __Goblint_Check(exp) in the file instead of __VERIFIER_assert(exp).", - "type": "boolean", - "default": false + "assert" : { + "title": "trans.assert", + "type": "object", + "properties": { + "goblint-check": { + "title": "trans.assert.goblint-check", + "description": + "Write __goblint_check(exp) in the file instead of __VERIFIER_assert(exp).", + "type": "boolean", + "default": false + } + }, + "additionalProperties": false } }, "additionalProperties": false diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index 56f3d5eb5f..94fdfb8602 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -27,7 +27,7 @@ module EvalAssert = struct let surroundByAtomic = true (* variable for generating __goblint_check(exp) instead of __VERIFIER_assert(exp) *) - let goblintCheck () = GobConfig.get_bool "trans.goblint-check" + let goblintCheck () = GobConfig.get_bool "trans.assert.goblint-check" (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) let ass () = if goblintCheck () then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) From cae69f7006fa7c2f481e48d8613bc4f62a40b466 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 16 Jul 2024 15:46:32 +0300 Subject: [PATCH 099/133] Refactor trans.assert options --- src/config/options.schema.json | 16 +++++++++++----- src/transform/evalAssert.ml | 20 +++++++++----------- 2 files changed, 20 insertions(+), 16 deletions(-) diff --git a/src/config/options.schema.json b/src/config/options.schema.json index d808f121c3..0cb1b6ee67 100644 --- a/src/config/options.schema.json +++ b/src/config/options.schema.json @@ -1566,12 +1566,18 @@ "title": "trans.assert", "type": "object", "properties": { - "goblint-check": { - "title": "trans.assert.goblint-check", - "description": - "Write __goblint_check(exp) in the file instead of __VERIFIER_assert(exp).", + "function": { + "title": "trans.assert.function", + "description": "Function to use for assertions in output.", + "type": "string", + "enum": ["assert", "__goblint_check", "__VERIFIER_assert"], + "default": "__VERIFIER_assert" + }, + "wrap-atomic": { + "title": "trans.assert.wrap-atomic", + "description": "Wrap assertions in __VERIFIER_atomic_begin and __VERIFIER_atomic_end.", "type": "boolean", - "default": false + "default": true } }, "additionalProperties": false diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index 94fdfb8602..0fee26355b 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -22,15 +22,8 @@ open Formatcil will be removed and they will fail on the next iteration *) -module EvalAssert = struct - (* should asserts be surrounded by __VERIFIER_atomic_{begin,end}? *) - let surroundByAtomic = true - - (* variable for generating __goblint_check(exp) instead of __VERIFIER_assert(exp) *) - let goblintCheck () = GobConfig.get_bool "trans.assert.goblint-check" - - (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) - let ass () = if goblintCheck () then makeVarinfo true "__goblint_check" (TVoid []) else makeVarinfo true "__VERIFIER_assert" (TVoid []) +module EvalAssert = +struct let atomicBegin = makeVarinfo true "__VERIFIER_atomic_begin" (TVoid []) let atomicEnd = makeVarinfo true "__VERIFIER_atomic_end" (TVoid []) @@ -42,6 +35,11 @@ module EvalAssert = struct val emit_after_lock = GobConfig.get_bool "witness.invariant.after-lock" val emit_other = GobConfig.get_bool "witness.invariant.other" + (* Cannot use Cilfacade.name_fundecs as assert() is external and has no fundec *) + val assert_function = makeVarinfo true (GobConfig.get_string "trans.assert.function") (TVoid []) + (* should asserts be surrounded by __VERIFIER_atomic_{begin,end}? *) + val surroundByAtomic = GobConfig.get_bool "trans.assert.wrap-atomic" + method! vstmt s = let is_lock exp args = match exp with @@ -62,8 +60,8 @@ module EvalAssert = struct match (ask ~node loc).f (Queries.Invariant context) with | `Lifted e -> let es = WitnessUtil.InvariantExp.process_exp e in - let asserts = List.map (fun e -> cInstr ("%v:assert (%e:exp);") loc [("assert", Fv (ass ())); ("exp", Fe e)]) es in - if surroundByAtomic && not (goblintCheck ()) then + let asserts = List.map (fun e -> cInstr ("%v:assert (%e:exp);") loc [("assert", Fv assert_function); ("exp", Fe e)]) es in + if surroundByAtomic then let abegin = (cInstr ("%v:__VERIFIER_atomic_begin();") loc [("__VERIFIER_atomic_begin", Fv atomicBegin)]) in let aend = (cInstr ("%v:__VERIFIER_atomic_end();") loc [("__VERIFIER_atomic_end", Fv atomicEnd)]) in abegin :: (asserts @ [aend]) From 14d51d51fe952f6edad9871350f71cfccaea710d Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 12 Jul 2024 16:58:31 +0200 Subject: [PATCH 100/133] Check overflows when generating witnesses --- src/cdomains/apron/sharedFunctions.apron.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 4809e97917..a9406d48e9 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -274,7 +274,7 @@ struct let expr = ref (fst @@ coeff_to_const false (Linexpr1.get_cst linexpr1)) in let append_summand (c:Coeff.union_5) v = match V.to_cil_varinfo v with - | Some vinfo -> + | Some vinfo when IntDomain.Size.is_cast_injective ~from_type:vinfo.vtype ~to_type:(TInt(ILongLong,[])) -> (* TODO: What to do with variables that have a type that cannot be stored into ILongLong to avoid overflows? *) let var = Cilfacade.mkCast ~e:(Lval(Var vinfo,NoOffset)) ~newt:longlong in let coeff, flip = coeff_to_const true c in @@ -284,6 +284,7 @@ struct else expr := BinOp(PlusA,!expr,prod,longlong) | None -> M.warn ~category:Analyzer "Invariant Apron: cannot convert to cil var: %s" (Var.to_string v); raise Unsupported_Linexpr1 + | _ -> M.warn ~category:Analyzer "Invariant Apron: cannot convert to cil var in overflow preserving manner: %s" (Var.to_string v); raise Unsupported_Linexpr1 in Linexpr1.iter append_summand linexpr1; !expr From 726725b88015547e9aeab38232fe130ab113993f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 17 Jul 2024 11:15:45 +0300 Subject: [PATCH 101/133] Add Printable functions to GobApron.Var --- src/analyses/apron/relationAnalysis.apron.ml | 4 +-- .../apron/affineEqualityDomain.apron.ml | 10 +++--- src/cdomains/apron/gobApron.apron.ml | 9 ++++++ .../apron/linearTwoVarEqualityDomain.apron.ml | 32 +++++++++---------- src/cdomains/apron/sharedFunctions.apron.ml | 4 +-- 5 files changed, 34 insertions(+), 25 deletions(-) diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index a42d78d71a..6dd2a65cee 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -295,7 +295,7 @@ struct (* there should be smarter ways to do this, e.g. by keeping track of which values are written etc. ... *) (* See, e.g, Beckschulze E, Kowalewski S, Brauer J (2012) Access-based localization for octagons. Electron Notes Theor Comput Sci 287:29–40 *) (* Also, a local *) - let vname = Apron.Var.to_string var in + let vname = GobApron.Var.show var in let locals = fundec.sformals @ fundec.slocals in match List.find_opt (fun v -> VM.var_name (Local v) = vname) locals with (* TODO: optimize *) | None -> true @@ -418,7 +418,7 @@ struct in let any_local_reachable = any_local_reachable fundec reachable_from_args in let arg_vars = f.sformals |> List.filter (RD.Tracked.varinfo_tracked) |> List.map RV.arg in - if M.tracing then M.tracel "combine-rel" "relation remove vars: %a" (docList (fun v -> Pretty.text (Apron.Var.to_string v))) arg_vars; + if M.tracing then M.tracel "combine-rel" "relation remove vars: %a" (docList (GobApron.Var.pretty ())) arg_vars; RD.remove_vars_with new_fun_rel arg_vars; (* fine to remove arg vars that also exist in caller because unify from new_rel adds them back with proper constraints *) let tainted = f_ask.f Queries.MayBeTainted in let tainted_vars = TaintPartialContexts.conv_varset tainted in diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 8bb99f2264..ec0bb9b940 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -181,7 +181,7 @@ struct else if Z.lt coeff Z.minus_one then Z.to_string coeff else Format.asprintf "+%s" (Z.to_string coeff) in - coeff_str ^ Var.to_string var + coeff_str ^ Var.show var in let const_to_str vl = if Z.equal vl Z.zero then @@ -429,8 +429,8 @@ struct let assign_exp ask t var exp no_ov = let res = assign_exp ask t var exp no_ov in - if M.tracing then M.tracel "ops" "assign_exp t:\n %s \n var: %s \n exp: %a\n no_ov: %b -> \n %s" - (show t) (Var.to_string var) d_exp exp (Lazy.force no_ov) (show res) ; + if M.tracing then M.tracel "ops" "assign_exp t:\n %s \n var: %a \n exp: %a\n no_ov: %b -> \n %s" + (show t) Var.pretty var d_exp exp (Lazy.force no_ov) (show res); res let assign_var (t: VarManagement(Vc)(Mx).t) v v' = @@ -440,7 +440,7 @@ struct let assign_var t v v' = let res = assign_var t v v' in - if M.tracing then M.tracel "ops" "assign_var t:\n %s \n v: %s \n v': %s\n -> %s" (show t) (Var.to_string v) (Var.to_string v') (show res) ; + if M.tracing then M.tracel "ops" "assign_var t:\n %s \n v: %a \n v': %a\n -> %s" (show t) Var.pretty v Var.pretty v' (show res); res let assign_var_parallel t vv's = @@ -498,7 +498,7 @@ struct let substitute_exp ask t var exp no_ov = let res = substitute_exp ask t var exp no_ov in - if M.tracing then M.tracel "ops" "Substitute_expr t: \n %s \n var: %s \n exp: %a \n -> \n %s" (show t) (Var.to_string var) d_exp exp (show res); + if M.tracing then M.tracel "ops" "Substitute_expr t: \n %s \n var: %a \n exp: %a \n -> \n %s" (show t) Var.pretty var d_exp exp (show res); res let substitute_exp ask t var exp no_ov = timing_wrap "substitution" (substitute_exp ask t var exp) no_ov diff --git a/src/cdomains/apron/gobApron.apron.ml b/src/cdomains/apron/gobApron.apron.ml index f2322c1473..fca28ff8f0 100644 --- a/src/cdomains/apron/gobApron.apron.ml +++ b/src/cdomains/apron/gobApron.apron.ml @@ -11,6 +11,15 @@ end module Var = struct include Var + + let pp = print + include Printable.SimpleFormat ( + struct + type nonrec t = t + let pp = pp + end + ) + let equal x y = Var.compare x y = 0 end diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index bd6b81402a..c13aca60ea 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -158,7 +158,7 @@ module EqualitiesConjunction = struct let (newref,offs,divi) = (get_rhs d head) in let (coeff,y) = BatOption.get newref in let (y,yrhs) = inverse head (coeff,y,offs,divi) in (* reassemble yrhs out of components *) - let shifted_cluster = (List.fold (fun map i -> + let shifted_cluster = (List.fold (fun map i -> let irhs = (get_rhs d i) in (* old entry is i = irhs *) Rhs.subst yrhs y irhs |> (* new entry for i is irhs [yrhs/y] *) set_rhs map i @@ -222,7 +222,7 @@ module EqualitiesConjunction = struct | Some (coeff,j), ((Some (coeff1,h1), o1, divi1) as oldi)-> (match get_rhs ts j with (* ts[x_j]=o2/d2 ========> ... *) - | (None , o2, divi2) -> + | (None , o2, divi2) -> let newxi = Rhs.subst (None,o2,divi2) j (Some (coeff,j),offs,divi) in let newxh1 = snd @@ inverse i (coeff1,h1,o1,divi1) in let newxh1 = Rhs.subst newxi i newxh1 in @@ -251,7 +251,7 @@ module EqualitiesConjunction = struct else (* var_i = var_i, i.e. it may occur on the rhs of other equalities *) (* so now, we transform with the inverse of the transformer: *) let inv = snd (inverse i (coeff,j,offs,divi)) in - IntMap.fold (fun k v acc -> + IntMap.fold (fun k v acc -> match v with | (Some (c,x),o,d) when x=i-> set_rhs acc k (Rhs.subst inv i v) | _ -> acc @@ -281,7 +281,7 @@ struct let multiply a b = (* if one of them is a constant, then multiply. Otherwise, the expression is not linear *) match a, b with - | [(None,coeff, divi)], c + | [(None,coeff, divi)], c | c, [(None,coeff, divi)] -> multiply_with_Q coeff divi c | _ -> raise NotLinearExpr in @@ -314,7 +314,7 @@ struct | x -> Some(x) (** convert and simplify (wrt. reference variables) a texpr into a tuple of a list of monomials (coeff,varidx,divi) and a (constant/divi) *) - let simplified_monomials_from_texp (t: t) texp = + let simplified_monomials_from_texp (t: t) texp = BatOption.bind (monomials_from_texp t texp) (fun monomiallist -> let d = Option.get t.d in @@ -323,7 +323,7 @@ struct | None -> let gcdee = Z.gcd adiv divi in exprcache,(Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi) | Some (coeff,idx) -> let (somevar,someoffs,somedivi)=Rhs.subst (EConj.get_rhs d idx) idx (v,offs,divi) in (* normalize! *) let newcache = Option.map_default (fun (coef,ter) -> IMap.add ter Q.((IMap.find_default zero ter exprcache) + make coef somedivi) exprcache) exprcache somevar in - let gcdee = Z.gcd adiv divi in + let gcdee = Z.gcd adiv divi in (newcache,(Z.(aconst*divi/gcdee + offs*adiv/gcdee),Z.lcm adiv divi)) in let (expr,constant) = List.fold_left accumulate_constants (IMap.empty,(Z.zero,Z.one)) monomiallist in (* abstract simplification of the guard wrt. reference variables *) @@ -339,7 +339,7 @@ struct BatOption.bind (simplified_monomials_from_texp t texp ) (fun (sum_of_terms, (constant,divisor)) -> (match sum_of_terms with - | [] -> Some (None, constant,divisor) + | [] -> Some (None, constant,divisor) | [(coeff,var,divi)] -> Some (Rhs.canonicalize (Some (Z.mul divisor coeff,var), Z.mul constant divi,Z.mul divisor divi)) |_ -> None)) @@ -447,7 +447,7 @@ struct let t1 = change_d t1 sup_env ~add:true ~del:false in let t2 = change_d t2 sup_env ~add:true ~del:false in match t1.d, t2.d with - | Some d1', Some d2' -> + | Some d1', Some d2' -> EConj.IntMap.fold (fun lhs rhs map -> meet_with_one_conj map lhs rhs) (snd d2') t1 (* even on sparse d2, this will chose the relevant conjs to meet with*) | _ -> {d = None; env = sup_env} @@ -489,7 +489,7 @@ struct - lhs itself - criteria A and B that characterize equivalence class, depending on the reference variable and the affine expression parameters wrt. each EConj - rhs1 - - rhs2 + - rhs2 however, we have to account for the sparseity of EConj maps by manually patching holes with default values *) let joinfunction lhs rhs1 rhs2 = ( @@ -516,15 +516,15 @@ struct let varentry ci offi ch offh xh = let (coeff,off,d) = Q.(ci,(offi*ch)-(ci*offh),ch) in (* compute new rhs in Q *) let (coeff,off,d) = Z.(coeff.num*d.den*off.den,off.num*d.den*coeff.den,d. num*coeff.den*off.den) in (* convert that back into Z *) - Rhs.canonicalize (Some(coeff,xh),off,d) + Rhs.canonicalize (Some(coeff,xh),off,d) in (* ci1 = a*ch1+b /\ ci2 = a*ch2+b *) (* ===> a = (ci1-ci2)/(ch1-ch2) b = ci2-a*ch2 *) - let constentry ci1 ci2 ch1 ch2 xh = + let constentry ci1 ci2 ch1 ch2 xh = let a = Q.((ci1-ci2) / (ch1-ch2)) in let b = Q.(ci2 - a*ch2) in Rhs.canonicalize (Some (Z.(a.num*b.den),xh),Z.(b.num*a.den) ,Z.(a.den*b.den) ) in - let iterate map l = + let iterate map l = match l with | (_, _, _, rhs , rhs' ) :: t when Rhs.equal rhs rhs' -> List.fold (fun acc (x,_,_,rh,_) -> EConj.set_rhs acc x rh) map l | (h, _, _, ((Some (ch,_),oh,dh)), ((Some _,_,_) )) :: t -> List.fold (fun acc (i,_,_,(monom,oi,di),_) -> EConj.set_rhs acc i (varentry Q.(make (fst@@Option.get monom) di) Q.(make oi di) Q.(make ch dh) Q.(make oh dh) h)) map t @@ -630,8 +630,8 @@ struct let assign_exp ask t var exp no_ov = let res = assign_exp ask t var exp no_ov in - if M.tracing then M.tracel "ops" "assign_exp t:\n %s \n var: %s \n exp: %a\n no_ov: %b -> \n %s" - (show t) (Var.to_string var) d_exp exp (Lazy.force no_ov) (show res) ; + if M.tracing then M.tracel "ops" "assign_exp t:\n %s \n var: %a \n exp: %a\n no_ov: %b -> \n %s" + (show t) Var.pretty var d_exp exp (Lazy.force no_ov) (show res); res let assign_var (t: VarManagement.t) v v' = @@ -640,7 +640,7 @@ struct let assign_var t v v' = let res = assign_var t v v' in - if M.tracing then M.tracel "ops" "assign_var t:\n %s \n v: %s \n v': %s\n -> %s" (show t) (Var.to_string v) (Var.to_string v') (show res) ; + if M.tracing then M.tracel "ops" "assign_var t:\n %s \n v: %a \n v': %a\n -> %s" (show t) Var.pretty v Var.pretty v' (show res); res (** Parallel assignment of variables. @@ -693,7 +693,7 @@ struct let substitute_exp ask t var exp no_ov = let res = substitute_exp ask t var exp no_ov in - if M.tracing then M.tracel "ops" "Substitute_expr t: \n %s \n var: %s \n exp: %a \n -> \n %s" (show t) (Var.to_string var) d_exp exp (show res); + if M.tracing then M.tracel "ops" "Substitute_expr t: \n %s \n var: %a \n exp: %a \n -> \n %s" (show t) Var.pretty var d_exp exp (show res); res let substitute_exp ask t var exp no_ov = timing_wrap "substitution" (substitute_exp ask t var exp) no_ov diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 9627b4762a..1e0a223571 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -136,7 +136,7 @@ struct let expr = (** simplify asks for a constant value of some subexpression e, similar to a constant fold. In particular but not exclusively this query is answered by the 2 var equalities domain itself. This normalizes arbitrary expressions to a point where they - might be able to be represented by means of 2 var equalities + might be able to be represented by means of 2 var equalities This simplification happens during a time, when there are temporary variables a#in and a#out part of the expression, but are not represented in the ctx, thus queries may result in top for these variables. Wrapping this in speculative @@ -279,7 +279,7 @@ struct expr := BinOp(MinusA,!expr,prod,longlong) else expr := BinOp(PlusA,!expr,prod,longlong) - | None -> M.warn ~category:Analyzer "Invariant Apron: cannot convert to cil var: %s" (Var.to_string v); raise Unsupported_Linexpr1 + | None -> M.warn ~category:Analyzer "Invariant Apron: cannot convert to cil var: %a" Var.pretty v; raise Unsupported_Linexpr1 in Linexpr1.iter append_summand linexpr1; !expr From b735727192db12f77c2778fd2d21d2d1c431e3ce Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 17 Jul 2024 11:24:22 +0300 Subject: [PATCH 102/133] Add Printable functions to GobApron.Scalar --- src/cdomains/apron/gobApron.apron.ml | 13 +++++++++++++ src/cdomains/apron/sharedFunctions.apron.ml | 4 ++-- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/src/cdomains/apron/gobApron.apron.ml b/src/cdomains/apron/gobApron.apron.ml index fca28ff8f0..80d32f1821 100644 --- a/src/cdomains/apron/gobApron.apron.ml +++ b/src/cdomains/apron/gobApron.apron.ml @@ -1,6 +1,19 @@ open Batteries include Apron +module Scalar = +struct + include Scalar + + let pp = print + include Printable.SimpleFormat ( + struct + type nonrec t = t + let pp = pp + end + ) +end + module Coeff = struct include Coeff diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 1e0a223571..dc918be571 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -36,7 +36,7 @@ let int_of_scalar ?round (scalar: Scalar.t) = in Z_mlgmpidl.z_of_mpzf z | _ -> - failwith ("int_of_scalar: unsupported: " ^ Scalar.to_string scalar) + failwith ("int_of_scalar: unsupported: " ^ Scalar.show scalar) module type ConvertArg = @@ -263,7 +263,7 @@ struct else Const (CInt(i,ILongLong,None)), false else - (M.warn ~category:Analyzer "Invariant Apron: coefficient is not int: %s" (Scalar.to_string c); raise Unsupported_Linexpr1) + (M.warn ~category:Analyzer "Invariant Apron: coefficient is not int: %a" Scalar.pretty c; raise Unsupported_Linexpr1) | None -> raise Unsupported_Linexpr1) | _ -> raise Unsupported_Linexpr1 in From 8f0ebc506662946192a96faf75e97af9fdeabf70 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 17 Jul 2024 11:24:43 +0300 Subject: [PATCH 103/133] Use GobZ.pretty in lin2var tracing --- src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml index c13aca60ea..65775d9188 100644 --- a/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml +++ b/src/cdomains/apron/linearTwoVarEqualityDomain.apron.ml @@ -361,7 +361,7 @@ struct else match simplify_to_ref_and_offset t (Texpr1.to_expr texpr) with | Some (None, offset, divisor) when Z.equal (Z.rem offset divisor) Z.zero -> let res = Z.div offset divisor in - (if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string res) (IntOps.BigIntOps.to_string res); + (if M.tracing then M.tracel "bounds" "min: %a max: %a" GobZ.pretty res GobZ.pretty res; Some res, Some res) | _ -> None, None From 06ea5e050df7d03692912bbfc3022a068cf411f4 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Wed, 17 Jul 2024 13:24:46 +0200 Subject: [PATCH 104/133] Rm resolved TODO --- src/cdomains/apron/sharedFunctions.apron.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index a9406d48e9..8121635e89 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -275,7 +275,6 @@ struct let append_summand (c:Coeff.union_5) v = match V.to_cil_varinfo v with | Some vinfo when IntDomain.Size.is_cast_injective ~from_type:vinfo.vtype ~to_type:(TInt(ILongLong,[])) -> - (* TODO: What to do with variables that have a type that cannot be stored into ILongLong to avoid overflows? *) let var = Cilfacade.mkCast ~e:(Lval(Var vinfo,NoOffset)) ~newt:longlong in let coeff, flip = coeff_to_const true c in let prod = BinOp(Mult, coeff, var, longlong) in @@ -291,7 +290,7 @@ struct let lcm_den linexpr1 = - let exception UnsupportedScalar + let exception UnsupportedScalar in let frac_of_scalar scalar = if Scalar.is_infty scalar <> 0 then (* infinity means unbounded *) From 0f99b6652ada5e5c3863e80dcb6c8d746bcd4f3f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 Jul 2024 20:06:08 +0300 Subject: [PATCH 105/133] Vendor ppx_easy_deriving --- dune-project | 2 +- goblint.opam | 3 +- goblint.opam.locked | 6 - goblint.opam.template | 1 - src/ppx/lattice/dune | 1 - src/ppx/printable/dune | 1 - src/vendor/ppx_easy_deriving/README.md | 4 + src/vendor/ppx_easy_deriving/deriver.ml | 100 ++++++++ src/vendor/ppx_easy_deriving/deriver.mli | 3 + src/vendor/ppx_easy_deriving/deriver_intf.ml | 13 + src/vendor/ppx_easy_deriving/dune | 4 + src/vendor/ppx_easy_deriving/intf.ml | 64 +++++ src/vendor/ppx_easy_deriving/pat_exp.ml | 46 ++++ src/vendor/ppx_easy_deriving/pat_exp.mli | 16 ++ .../ppx_easy_deriving/ppx_easy_deriving.ml | 15 ++ src/vendor/ppx_easy_deriving/product.ml | 226 ++++++++++++++++++ src/vendor/ppx_easy_deriving/product.mli | 3 + src/vendor/ppx_easy_deriving/product_intf.ml | 132 ++++++++++ src/vendor/ppx_easy_deriving/util.ml | 12 + src/vendor/ppx_easy_deriving/util.mli | 8 + 20 files changed, 648 insertions(+), 12 deletions(-) create mode 100644 src/vendor/ppx_easy_deriving/README.md create mode 100644 src/vendor/ppx_easy_deriving/deriver.ml create mode 100644 src/vendor/ppx_easy_deriving/deriver.mli create mode 100644 src/vendor/ppx_easy_deriving/deriver_intf.ml create mode 100644 src/vendor/ppx_easy_deriving/dune create mode 100644 src/vendor/ppx_easy_deriving/intf.ml create mode 100644 src/vendor/ppx_easy_deriving/pat_exp.ml create mode 100644 src/vendor/ppx_easy_deriving/pat_exp.mli create mode 100644 src/vendor/ppx_easy_deriving/ppx_easy_deriving.ml create mode 100644 src/vendor/ppx_easy_deriving/product.ml create mode 100644 src/vendor/ppx_easy_deriving/product.mli create mode 100644 src/vendor/ppx_easy_deriving/product_intf.ml create mode 100644 src/vendor/ppx_easy_deriving/util.ml create mode 100644 src/vendor/ppx_easy_deriving/util.mli diff --git a/dune-project b/dune-project index 9071eb989f..97a06a220a 100644 --- a/dune-project +++ b/dune-project @@ -45,7 +45,7 @@ Goblint includes analyses for assertions, overflows, deadlocks, etc and can be e (ppx_deriving (>= 6.0.2)) (ppx_deriving_hash (>= 0.1.2)) (ppx_deriving_yojson (>= 3.7.0)) - ppx_easy_deriving + (ppxlib (>= 0.30.0)) ; ppx_easy_deriving (ounit2 :with-test) (qcheck-ounit :with-test) (odoc :with-doc) diff --git a/goblint.opam b/goblint.opam index c0b0b52960..78a8fb76e7 100644 --- a/goblint.opam +++ b/goblint.opam @@ -45,7 +45,7 @@ depends: [ "ppx_deriving" {>= "6.0.2"} "ppx_deriving_hash" {>= "0.1.2"} "ppx_deriving_yojson" {>= "3.7.0"} - "ppx_easy_deriving" + "ppxlib" {>= "0.30.0"} "ounit2" {with-test} "qcheck-ounit" {with-test} "odoc" {with-doc} @@ -98,7 +98,6 @@ available: os-distribution != "alpine" & arch != "arm64" pin-depends: [ # published goblint-cil 2.0.3 is currently up-to-date, so no pin needed [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] - [ "ppx_easy_deriving.~dev" "git+https://github.com/sim642/ppx_easy_deriving.git#3d599fdfb231e4a1f9bad0e914068210901533a4" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.locked b/goblint.opam.locked index b9540fa629..37f22c3230 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -58,7 +58,6 @@ depends: [ "dune-private-libs" {= "3.7.1"} "dune-site" {= "3.7.1"} "dyn" {= "3.7.1"} - "either" {= "1.0.0"} "fileutils" {= "0.6.4"} "fmt" {= "0.9.0"} "fpath" {= "0.7.3"} @@ -86,7 +85,6 @@ depends: [ "ppx_deriving" {= "6.0.2"} "ppx_deriving_hash" {= "0.1.2"} "ppx_deriving_yojson" {= "3.7.0"} - "ppx_easy_deriving" {= "~dev"} "ppxlib" {= "0.32.1"} "qcheck-core" {= "0.20"} "qcheck-ounit" {= "0.20" & with-test} @@ -139,10 +137,6 @@ pin-depends: [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] - [ - "ppx_easy_deriving.~dev" - "git+https://github.com/sim642/ppx_easy_deriving.git#3d599fdfb231e4a1f9bad0e914068210901533a4" - ] ] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} description: """\ diff --git a/goblint.opam.template b/goblint.opam.template index e9b53c42b4..a730d5c064 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -4,7 +4,6 @@ available: os-distribution != "alpine" & arch != "arm64" pin-depends: [ # published goblint-cil 2.0.3 is currently up-to-date, so no pin needed [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] - [ "ppx_easy_deriving.~dev" "git+https://github.com/sim642/ppx_easy_deriving.git#3d599fdfb231e4a1f9bad0e914068210901533a4" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/src/ppx/lattice/dune b/src/ppx/lattice/dune index 4c057c6fab..1f4dac4b82 100644 --- a/src/ppx/lattice/dune +++ b/src/ppx/lattice/dune @@ -4,5 +4,4 @@ (name ppx_deriving_lattice) (kind ppx_deriver) (libraries ppxlib ppx_easy_deriving) - (ppx_runtime_libraries ppx_easy_deriving.runtime) (preprocess (pps ppxlib.metaquot))) diff --git a/src/ppx/printable/dune b/src/ppx/printable/dune index 2b620d2319..9164e487e0 100644 --- a/src/ppx/printable/dune +++ b/src/ppx/printable/dune @@ -4,5 +4,4 @@ (name ppx_deriving_printable) (kind ppx_deriver) (libraries ppxlib ppx_easy_deriving) - (ppx_runtime_libraries ppx_easy_deriving.runtime) (preprocess (pps ppxlib.metaquot))) diff --git a/src/vendor/ppx_easy_deriving/README.md b/src/vendor/ppx_easy_deriving/README.md new file mode 100644 index 0000000000..99a5e7e140 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/README.md @@ -0,0 +1,4 @@ +# ppx_easy_deriving + +Goblint vendors a subset of the unreleased [ppx_easy_deriving](https://github.com/sim642/ppx_easy_deriving) library. +It only includes products, excluding simples and variants. diff --git a/src/vendor/ppx_easy_deriving/deriver.ml b/src/vendor/ppx_easy_deriving/deriver.ml new file mode 100644 index 0000000000..533a77959c --- /dev/null +++ b/src/vendor/ppx_easy_deriving/deriver.ml @@ -0,0 +1,100 @@ +open Ppxlib +open Ast_builder.Default + +include Deriver_intf + +module Make (Arg: Intf.S): S = +struct + let attr = Attribute.declare (Printf.sprintf "deriving.%s.%s" Arg.name Arg.name) Attribute.Context.core_type Ast_pattern.(single_expr_payload __) (fun expr -> expr) + + let unit ~loc = Arg.tuple ~loc [] + + let rec expr ~loc ~quoter ct = + match Attribute.get attr ct with + | Some expr -> + Expansion_helpers.Quoter.quote quoter expr + | None -> + match ct with + | [%type: unit] -> + unit ~loc + | {ptyp_desc = Ptyp_constr ({txt = lid; loc}, args); _} -> + let ident = pexp_ident ~loc {loc; txt = Expansion_helpers.mangle_lid (Prefix Arg.name) lid} in + let ident = Expansion_helpers.Quoter.quote quoter ident in + let apply_args = List.map (fun ct -> + (Nolabel, expr ~loc ~quoter ct) + ) args + in + pexp_apply ~loc ident apply_args + | {ptyp_desc = Ptyp_tuple elems; _} -> + expr_tuple ~loc ~quoter elems + | {ptyp_desc = Ptyp_var name; _} -> + evar ~loc ("poly_" ^ name) + | _ -> + pexp_extension ~loc (Location.error_extensionf ~loc "unsupported core type") + + and expr_record ~loc ~quoter (lds: label_declaration list) = + let les = List.map (fun {pld_name = {txt = label; _}; pld_type; _} -> + (Lident label, expr ~loc ~quoter pld_type) + ) lds + in + Arg.record ~loc les + + and expr_tuple ~loc ~quoter elems = + let es = List.map (expr ~loc ~quoter) elems in + Arg.tuple ~loc es + + let expr_declaration ~loc ~quoter = function + | {ptype_kind = Ptype_abstract; ptype_manifest = Some ct; _} -> + expr ~loc ~quoter ct + | {ptype_kind = Ptype_abstract; _} -> + pexp_extension ~loc (Location.error_extensionf ~loc "unsupported abstract type") + | {ptype_kind = Ptype_variant constrs; _} -> + pexp_extension ~loc (Location.error_extensionf ~loc "unsupported variant type") + | {ptype_kind = Ptype_open; _} -> + pexp_extension ~loc (Location.error_extensionf ~loc "unsupported open type") + | {ptype_kind = Ptype_record fields; _} -> + expr_record ~loc ~quoter fields + + let typ ~loc td = + let ct = Ppx_deriving.core_type_of_type_decl td in + Ppx_deriving.poly_arrow_of_type_decl + (Arg.typ ~loc) + td + (Arg.typ ~loc ct) + + let generate_impl ~ctxt (_rec_flag, type_declarations) = + let loc = Expansion_context.Deriver.derived_item_loc ctxt in + let vbs = List.map (fun td -> + let quoter = Expansion_helpers.Quoter.create () in + let expr = expr_declaration ~loc ~quoter td in + let expr = Expansion_helpers.Quoter.sanitize quoter expr in + let expr = Ppx_deriving.poly_fun_of_type_decl td expr in + let ct = typ ~loc td in + let pat = ppat_var ~loc {loc; txt = Expansion_helpers.mangle_type_decl (Prefix Arg.name) td} in + let pat = ppat_constraint ~loc pat ct in + Ast_helper.Vb.mk ~loc ~attrs:[Ppx_deriving.attr_warning [%expr "-39"]] pat expr + ) type_declarations + in + [Ast_helper.Str.value ~loc Recursive vbs] + + let generate_intf ~ctxt (_rec_flag, type_declarations) = + let loc = Expansion_context.Deriver.derived_item_loc ctxt in + List.map (fun td -> + let ct = typ ~loc td in + let val_ = Ast_helper.Val.mk ~loc {loc; txt = Expansion_helpers.mangle_type_decl (Prefix Arg.name) td} ct in + Ast_helper.Sig.value ~loc val_ + ) type_declarations + + let impl_generator = Deriving.Generator.V2.make_noarg generate_impl + let intf_generator = Deriving.Generator.V2.make_noarg generate_intf + let extension ~loc ~path:_ ct = + let quoter = Expansion_helpers.Quoter.create () in + let expr = expr ~loc ~quoter ct in + Expansion_helpers.Quoter.sanitize quoter expr + + let register () = + Deriving.add Arg.name + ~sig_type_decl:intf_generator + ~str_type_decl:impl_generator + ~extension +end diff --git a/src/vendor/ppx_easy_deriving/deriver.mli b/src/vendor/ppx_easy_deriving/deriver.mli new file mode 100644 index 0000000000..a8238f6f6f --- /dev/null +++ b/src/vendor/ppx_easy_deriving/deriver.mli @@ -0,0 +1,3 @@ +(** Registerable deriver. *) + +include Deriver_intf.Deriver (** @inline *) diff --git a/src/vendor/ppx_easy_deriving/deriver_intf.ml b/src/vendor/ppx_easy_deriving/deriver_intf.ml new file mode 100644 index 0000000000..565a6aef38 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/deriver_intf.ml @@ -0,0 +1,13 @@ +module type S = +sig + val register: unit -> Ppxlib.Deriving.t + (** Register deriver with ppxlb. *) +end + +module type Deriver = +sig + module type S = S + + module Make (_: Intf.S): S + (** Make registerable deriver. *) +end diff --git a/src/vendor/ppx_easy_deriving/dune b/src/vendor/ppx_easy_deriving/dune new file mode 100644 index 0000000000..7d50a56e43 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/dune @@ -0,0 +1,4 @@ +(library + (name ppx_easy_deriving) + (libraries ppxlib ppx_deriving.api) + (preprocess (pps ppxlib.metaquot))) diff --git a/src/vendor/ppx_easy_deriving/intf.ml b/src/vendor/ppx_easy_deriving/intf.ml new file mode 100644 index 0000000000..b30c7c36a0 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/intf.ml @@ -0,0 +1,64 @@ +(** Main interfaces. *) + +open Ppxlib + +(** Deriver name interface. *) +module type Name = +sig + val name: string + (** Deriver name. + + For example, with the name "equal": + + Use [[@@deriving equal]] after a type definition. + + The derived value/function is [val equal: ...] (if the type is named [t]) or [val equal_ty: ...] (otherwise if the type is named [ty]). + + Use [[@equal ...]] after a type expression to override the underlying value/function used for it. + + Use [[%equal: ty]] as an expression for the value/function of type [ty]. *) +end + +(** Deriver base interface. *) +module type Base = +sig + include Name + val typ: loc:location -> core_type -> core_type + (** Derived value/function type for a given type. + + For example, "equal" deriver would map [t] to [t -> t -> bool]. *) +end + +module Tuple = +struct + + (** Tuple deriver interface. *) + module type S = + sig + include Base + val tuple: loc:location -> expression list -> expression + (** Compose derived values/functions for tuple elements into derived value/function for the tuple. *) + end +end + +module Record = +struct + + (** Record deriver interface. *) + module type S = + sig + include Base + val record: loc:location -> (longident * expression) list -> expression + (** Compose derived values/functions for record fields into derived value/function for the record. *) + end +end + +module Full = +struct + + (** Full deriver interface. *) + module type S = + sig + include Tuple.S + include Record.S + end +end + +module type S = Full.S +(** Deriver interface. *) diff --git a/src/vendor/ppx_easy_deriving/pat_exp.ml b/src/vendor/ppx_easy_deriving/pat_exp.ml new file mode 100644 index 0000000000..a9d43d07e6 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/pat_exp.ml @@ -0,0 +1,46 @@ +open Ppxlib +open Ast_builder.Default + +type t = + | Record of (longident * t) list + | Tuple of t list + | Unit + | Base of string +let create_record ~prefix ls = + Record (List.mapi (fun i l -> (l, Base (prefix ^ string_of_int (i + 1)))) ls) +let create_tuple ~prefix n = + match n with + | 0 -> Unit + | 1 -> Base (prefix ^ "1") + | n -> Tuple (List.init n (fun i -> Base (prefix ^ string_of_int (i + 1)))) +let rec to_pat ~loc = function + | Record xs -> + ppat_record ~loc (List.map (fun (l, x) -> + (Located.mk ~loc l, to_pat ~loc x) + ) xs) Closed + | Tuple xs -> + ppat_tuple ~loc (List.map (to_pat ~loc) xs) + | Unit -> + [%pat? ()] + | Base s -> + ppat_var ~loc (Located.mk ~loc s) +let rec to_exps ~loc = function + | Record xs -> + List.flatten (List.map (fun (_, x) -> to_exps ~loc x) xs) + | Tuple xs -> + List.flatten (List.map (to_exps ~loc) xs) + | Unit -> + [] + | Base s -> + [pexp_ident ~loc {loc; txt = Lident s}] +let rec to_exp ~loc = function + | Record xs -> + pexp_record ~loc (List.map (fun (l, x) -> + (Located.mk ~loc l, to_exp ~loc x) + ) xs) None + | Tuple xs -> + pexp_tuple ~loc (List.map (to_exp ~loc) xs) + | Unit -> + [%expr ()] + | Base s -> + pexp_ident ~loc {loc; txt = Lident s} diff --git a/src/vendor/ppx_easy_deriving/pat_exp.mli b/src/vendor/ppx_easy_deriving/pat_exp.mli new file mode 100644 index 0000000000..a4878afa81 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/pat_exp.mli @@ -0,0 +1,16 @@ +(** Common representation of patterns and expressions. *) + +open Ppxlib + +type t = + | Record of (longident * t) list + | Tuple of t list + | Unit + | Base of string + +val create_record: prefix:string -> longident list -> t +val create_tuple: prefix:string -> int -> t + +val to_pat: loc:location -> t -> pattern +val to_exps: loc:location -> t -> expression list +val to_exp: loc:location -> t -> expression diff --git a/src/vendor/ppx_easy_deriving/ppx_easy_deriving.ml b/src/vendor/ppx_easy_deriving/ppx_easy_deriving.ml new file mode 100644 index 0000000000..a490f33557 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/ppx_easy_deriving.ml @@ -0,0 +1,15 @@ +(** Library for easily defining PPX derivers without boilerplate and runtime overhead. *) + +(** {1 Interfaces} *) + +include Intf (** @inline *) + + +(** {1 Deriver} *) + +module Deriver = Deriver + + +(** {1 Easier constructs} *) + +module Product = Product diff --git a/src/vendor/ppx_easy_deriving/product.ml b/src/vendor/ppx_easy_deriving/product.ml new file mode 100644 index 0000000000..2135552b63 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/product.ml @@ -0,0 +1,226 @@ +open Ppxlib +open Ast_builder.Default + +include Product_intf + +module type Product_S = S + +module Make (P: S): Intf.S = +struct + include P + + let tuple ~loc es = + let n = List.length es in + let pe_create = Pat_exp.create_tuple n in + P.product ~loc ~pe_create es + + let record ~loc les = + let ls = List.map fst les in + let pe_create = Pat_exp.create_record ls in + let es = List.map snd les in + P.product ~loc ~pe_create es +end + +module Reduce = +struct + include Reduce + + module Conjunctive = + struct + include Conjunctive + + module Make (C: S): Reduce.S = + struct + let name = C.name + let typ ~loc _ = [%type: bool] + let unit ~loc = [%expr true] + let both ~loc e1 e2 = [%expr [%e e1] && [%e e2]] + end + end +end + +module Reduce1 = +struct + include Reduce1 + + module Make (R1: S): Intf.S = + struct + module P: Product_S = + struct + let name = R1.name + let typ ~loc t = [%type: [%t t] -> [%t R1.typ ~loc t]] + + let product ~loc ~pe_create es = + let pe = pe_create ~prefix:"x" in + let body = + let es = List.map2 (fun e x -> + [%expr [%e e] [%e x]] + ) es (Pat_exp.to_exps ~loc pe) + in + Util.reduce ~unit:(R1.unit ~loc) ~both:(R1.both ~loc) es + in + [%expr fun [%p Pat_exp.to_pat ~loc pe] -> [%e body]] + end + + include Make (P) + end +end + +module Reduce2 = +struct + include Reduce2 + + module Make (R2: S): Intf.S = + struct + module P: Product_S = + struct + let name = R2.name + let typ ~loc t = [%type: [%t t] -> [%t t] -> [%t R2.typ ~loc t]] + + let product ~loc ~pe_create es = + let pel = pe_create ~prefix:"l" in + let per = pe_create ~prefix:"r" in + let body = + let esl = Pat_exp.to_exps ~loc pel in + let esr = Pat_exp.to_exps ~loc per in + let es = Util.map3 (fun e l r -> + [%expr [%e e] [%e l] [%e r]] + ) es esl esr + in + Util.reduce ~unit:(R2.unit ~loc) ~both:(R2.both ~loc) es + in + let pl = Pat_exp.to_pat ~loc pel in + let pr = Pat_exp.to_pat ~loc per in + [%expr fun [%p pl] [%p pr] -> [%e body]] + end + + include Make (P) + end +end + +module Create = +struct + include Create + + module Make (C: S): Intf.S = + struct + let name = C.name + let typ ~loc t = [%type: [%t C.typ ~loc t] -> [%t t]] + + let tuple ~loc es = + match es with + | [] -> [%expr fun _ -> ()] + | [e] -> e + | _ :: _ -> + let elems = List.map (fun e -> + [%expr [%e e] x] + ) es + in + let body = pexp_tuple ~loc elems in + [%expr fun x -> [%e body]] + + let record ~loc les = + let fields = List.map (fun (l, e) -> + (Located.mk ~loc l, [%expr [%e e] x]) + ) les + in + let body = pexp_record ~loc fields None in + [%expr fun x -> [%e body]] + end +end + +module Map1 = +struct + include Map1 + + module Make (M1: S): Intf.S = + struct + let name = M1.name + let typ ~loc t = [%type: [%t t] -> [%t t]] + + let tuple ~loc es = + let n = List.length es in + let pe = Pat_exp.create_tuple ~prefix:"x" n in + let elems = + List.map2 (fun e x -> + [%expr [%e e] [%e x]] + ) es (Pat_exp.to_exps ~loc pe) + in + let body = + match elems with + | [] -> [%expr ()] + | [elem] -> elem + | _ :: _ -> pexp_tuple ~loc elems + in + [%expr fun [%p Pat_exp.to_pat ~loc pe] -> [%e body]] + + let record ~loc les = + let ls = List.map fst les in + let pe = Pat_exp.create_record ~prefix:"x" ls in + let es = List.map snd les in + let elems = + List.map2 (fun e x -> + [%expr [%e e] [%e x]] + ) es (Pat_exp.to_exps ~loc pe) + in + let fields = List.map2 (fun l elem -> + (Located.mk ~loc l, elem) + ) ls elems + in + let body = pexp_record ~loc fields None in + [%expr fun [%p Pat_exp.to_pat ~loc pe] -> [%e body]] + end +end + +module Map2 = +struct + include Map2 + + module Make (M2: S): Intf.S = + struct + let name = M2.name + let typ ~loc t = [%type: [%t t] -> [%t t] -> [%t t]] + + let tuple ~loc es = + let n = List.length es in + let pel = Pat_exp.create_tuple ~prefix:"l" n in + let per = Pat_exp.create_tuple ~prefix:"r" n in + let elems = + let esl = Pat_exp.to_exps ~loc pel in + let esr = Pat_exp.to_exps ~loc per in + Util.map3 (fun e l r -> + [%expr [%e e] [%e l] [%e r]] + ) es esl esr + in + let body = + match elems with + | [] -> [%expr ()] + | [elem] -> elem + | _ :: _ -> pexp_tuple ~loc elems + in + let pl = Pat_exp.to_pat ~loc pel in + let pr = Pat_exp.to_pat ~loc per in + [%expr fun [%p pl] [%p pr] -> [%e body]] + + let record ~loc les = + let ls = List.map fst les in + let pel = Pat_exp.create_record ~prefix:"l" ls in + let per = Pat_exp.create_record ~prefix:"r" ls in + let es = List.map snd les in + let elems = + let esl = Pat_exp.to_exps ~loc pel in + let esr = Pat_exp.to_exps ~loc per in + Util.map3 (fun e l r -> + [%expr [%e e] [%e l] [%e r]] + ) es esl esr + in + let fields = List.map2 (fun l elem -> + (Located.mk ~loc l, elem) + ) ls elems + in + let body = pexp_record ~loc fields None in + let pl = Pat_exp.to_pat ~loc pel in + let pr = Pat_exp.to_pat ~loc per in + [%expr fun [%p pl] [%p pr] -> [%e body]] + end +end diff --git a/src/vendor/ppx_easy_deriving/product.mli b/src/vendor/ppx_easy_deriving/product.mli new file mode 100644 index 0000000000..d0b45f106c --- /dev/null +++ b/src/vendor/ppx_easy_deriving/product.mli @@ -0,0 +1,3 @@ +(** Product derivers which unify tuple and record derivers. *) + +include Product_intf.Product (** @inline *) diff --git a/src/vendor/ppx_easy_deriving/product_intf.ml b/src/vendor/ppx_easy_deriving/product_intf.ml new file mode 100644 index 0000000000..14964bbee7 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/product_intf.ml @@ -0,0 +1,132 @@ +open Ppxlib + +module type S = +sig + include Intf.Base + val product: loc:location -> pe_create:(prefix:string -> Pat_exp.t) -> expression list -> expression + (** Compose derived values/functions for product elements into derived value/function for the product. + + @param pe_create factory for patterns/expressions of the actual type. *) +end + +module Reduce = +struct + module type S = + sig + include Intf.Base + val unit: loc:location -> expression + (** Derived value/function for [unit] type. *) + + val both: loc:location -> expression -> expression -> expression + (** Compose derived values/functions in a product into derived value/function for the pair. *) + end + + module Conjunctive = + struct + module type S = Intf.Name + end +end + +module Reduce1 = +struct + module type S = Reduce.S +end + +module Reduce2 = +struct + module type S = Reduce.S +end + +module Create = +struct + module type S = + sig + include Intf.Base + end +end + +module Map1 = +struct + module type S = Intf.Name +end + +module Map2 = +struct + module type S = Intf.Name +end + +module type Product = +sig + module type S = S + (** Product deriver interface. *) + + module Make (P: S): Intf.S + (** Make deriver from product deriver. *) + + (** Reductions for reducing derivers. *) + module Reduce : + sig + module type S = Reduce.S + (** Reduction interface. *) + + (** Conjunctive reduction. *) + module Conjunctive : + sig + module type S = Reduce.Conjunctive.S + (** Conjunctive reduction interface. *) + + module Make (C: S): Reduce.S + (** Make reduction from conjunctive reduction. *) + end + end + + (** Unary reducing deriver. *) + module Reduce1 : + sig + module type S = Reduce1.S + (** Unary reducing deriver interface. *) + + module Make (R1: S): Intf.S + (** Make deriver from unary reducing deriver. *) + end + + (** Binary reducing deriver. *) + module Reduce2 : + sig + module type S = Reduce2.S + (** Binary reducing deriver interface. *) + + module Make (R2: S): Intf.S + (** Make deriver from binary reducing deriver. *) + end + + (** Unary creating deriver. *) + module Create : + sig + module type S = Create.S + (** Unary creating deriver interface. *) + + module Make (C: S): Intf.S + (** Make deriver from unary creating deriver. *) + end + + (** Unary mapping deriver. *) + module Map1 : + sig + module type S = Map1.S + (** Unary mapping deriver interface. *) + + module Make (M1: S): Intf.S + (** Make deriver from unary mapping deriver. *) + end + + (** Binary mapping deriver. *) + module Map2 : + sig + module type S = Map2.S + (** Binary mapping deriver interface. *) + + module Make (M2: S): Intf.S + (** Make deriver from binary mapping deriver. *) + end +end diff --git a/src/vendor/ppx_easy_deriving/util.ml b/src/vendor/ppx_easy_deriving/util.ml new file mode 100644 index 0000000000..fbb9d3f642 --- /dev/null +++ b/src/vendor/ppx_easy_deriving/util.ml @@ -0,0 +1,12 @@ +let reduce ~unit ~both = function + | [] -> unit + | [x] -> x + | xs -> + let xs = List.rev xs in + match xs with + | x :: xs -> + List.fold_right both (List.rev xs) x (* omits hash_empty *) + | [] -> assert false + +let map3 f l1 l2 l3 = + List.map2 (fun x1 (x2, x3) -> f x1 x2 x3) l1 (List.combine l2 l3) (* TODO: optimize *) diff --git a/src/vendor/ppx_easy_deriving/util.mli b/src/vendor/ppx_easy_deriving/util.mli new file mode 100644 index 0000000000..0f896e7efc --- /dev/null +++ b/src/vendor/ppx_easy_deriving/util.mli @@ -0,0 +1,8 @@ +(** Utility functions. *) + +val reduce: unit:'a -> both:('a -> 'a -> 'a) -> 'a list -> 'a +(** Reduce a list of values "optimally", + i.e. without unnecessary [~unit] and [~both]. *) + +val map3: ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list +(** Map three lists into one. *) From a39ab19882e9fc27fc1ba2e9e75ca290bda07e49 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 Jul 2024 20:12:24 +0300 Subject: [PATCH 106/133] Deduplicate (include_subdirs no) in src/ppx --- src/ppx/dune | 1 + src/ppx/lattice/dune | 2 -- src/ppx/printable/dune | 2 -- 3 files changed, 1 insertion(+), 4 deletions(-) create mode 100644 src/ppx/dune diff --git a/src/ppx/dune b/src/ppx/dune new file mode 100644 index 0000000000..ff757cb8ca --- /dev/null +++ b/src/ppx/dune @@ -0,0 +1 @@ +(include_subdirs no) diff --git a/src/ppx/lattice/dune b/src/ppx/lattice/dune index 1f4dac4b82..862298be13 100644 --- a/src/ppx/lattice/dune +++ b/src/ppx/lattice/dune @@ -1,5 +1,3 @@ -(include_subdirs no) - (library (name ppx_deriving_lattice) (kind ppx_deriver) diff --git a/src/ppx/printable/dune b/src/ppx/printable/dune index 9164e487e0..8e08232de6 100644 --- a/src/ppx/printable/dune +++ b/src/ppx/printable/dune @@ -1,5 +1,3 @@ -(include_subdirs no) - (library (name ppx_deriving_printable) (kind ppx_deriver) From cd793b9e7293bd94920a09b7388e5cc19bf8518c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 Jul 2024 20:17:00 +0300 Subject: [PATCH 107/133] Exclude PPX-s from Goblint_lib documentation check --- scripts/goblint-lib-modules.py | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/scripts/goblint-lib-modules.py b/scripts/goblint-lib-modules.py index 017530f838..ba25a1403c 100755 --- a/scripts/goblint-lib-modules.py +++ b/scripts/goblint-lib-modules.py @@ -42,6 +42,10 @@ "Goblint_build_info", "Dune_build_info", + # ppx-s + "Ppx_deriving_printable", + "Ppx_deriving_lattice", + "MessageCategory", # included in Messages "PreValueDomain", # included in ValueDomain From 2e1d5fec8e9a8c955b0a86fdd22a63a2d0b05ec3 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Thu, 18 Jul 2024 20:58:27 +0300 Subject: [PATCH 108/133] Add LICENSE for vendored ppx_easy_deriving --- src/vendor/ppx_easy_deriving/LICENSE.md | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 src/vendor/ppx_easy_deriving/LICENSE.md diff --git a/src/vendor/ppx_easy_deriving/LICENSE.md b/src/vendor/ppx_easy_deriving/LICENSE.md new file mode 100644 index 0000000000..ae6337b11b --- /dev/null +++ b/src/vendor/ppx_easy_deriving/LICENSE.md @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2023 Simmo Saan + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. From 62f1e2e0de72df4b09ffcd7d34a86c1616c740af Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 26 Jun 2024 17:43:07 +0300 Subject: [PATCH 109/133] Try to print selenium logs for Gobview test --- scripts/test-gobview.py | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/scripts/test-gobview.py b/scripts/test-gobview.py index f5961108d7..10808a9b62 100644 --- a/scripts/test-gobview.py +++ b/scripts/test-gobview.py @@ -6,6 +6,7 @@ from webdriver_manager.chrome import ChromeDriverManager from selenium.webdriver.common.by import By from selenium.webdriver.chrome.options import Options +from selenium.webdriver.common.desired_capabilities import DesiredCapabilities from threading import Thread import subprocess @@ -17,6 +18,11 @@ # cleanup def cleanup(browser, thread): print("cleanup") + + # print messages + for entry in browser.get_log('browser'): + print(entry) + browser.close() p.kill() thread.join() @@ -35,6 +41,8 @@ def serve(): print("starting installation of browser\n") options = Options() options.add_argument('headless') +# options.set_capability("loggingPrefs", { 'browser':'ALL' }) +options.set_capability("goog:loggingPrefs", { 'browser':'ALL' }) browser = webdriver.Chrome(service=Service(ChromeDriverManager().install()),options=options) print("finished webdriver installation \n") browser.maximize_window() From 23643df9f573ab88296247fe17a07dc3205db249 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 Jul 2024 10:46:11 +0300 Subject: [PATCH 110/133] Add js_of_ocaml upper bound for Gobview --- gobview | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gobview b/gobview index 4069f32f82..03b0682f97 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 4069f32f82efdefb43c970fb77ca29671a4b6972 +Subproject commit 03b0682f973eab0d26cf8aea74c63a9e869c9716 From 72713a62ad3a3e09f57ec6b8a70e16cfa09ff76a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 24 Jul 2024 13:31:06 +0300 Subject: [PATCH 111/133] Add initial CHANGELOG for v2.4.0 --- CHANGELOG.md | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index d285480259..73b235883f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,22 @@ +## v2.4.0 (unreleased) +* Remove unmaintained analyses: spec, file (#1281). +* Add linear two-variable equalities analysis (#1297, #1412, #1466). +* Add callstring, loopfree callstring and context gas analyses (#1038, #1340, #1379, #1427, #1439). +* Add non-relational thread-modular value analyses with thread IDs (#1366, #1398, #1399). +* Add NULL byte array domain (#1076). +* Fix spurious overflow warnings from internal evaluations (#1406, #1411, #1511). +* Refactor non-definite mutex handling to fix unsoundness (#1430, #1500, #1409). +* Fix non-relational thread-modular value analysis unsoundness with ambiguous points-to sets (#1457, #1458). +* Fix mutex type analysis unsoundness and enable it by default (#1414, #1416, #1510). +* Add points-to set refinement on mutex path splitting (#1287, #1343, #1374, #1396, #1407). +* Improve narrowing operators (#1502, #1540, #1543). +* Extract automatic configuration tuning for soundness (#1369). +* Fix many locations in witnesses (#1355, #1372, #1400, #1403). +* Improve output readability (#1294, #1312, #1405, #1497). +* Refactor logging (#1117). +* Modernize all library function specifications (#1029, #688, #1174, #1289, #1447, #1487). +* Remove OCaml 4.10, 4.11, 4.12 and 4.13 support (#1448). + ## v2.3.0 Functionally equivalent to Goblint in SV-COMP 2024. From 40b34346ff77e078a29dbaef2d195fe552402e86 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 Jul 2024 11:04:28 +0300 Subject: [PATCH 112/133] Add TODOs about IntDomain refinement --- src/cdomain/value/cdomains/intDomain.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomain/value/cdomains/intDomain.ml index 2d40e6a161..c983e543fa 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomain/value/cdomains/intDomain.ml @@ -2794,7 +2794,7 @@ module Enums : S with type int_t = Z.t = struct | Inc e, Some (c, m) -> Inc (BISet.filter (contains c m) e) | _ -> a - let refine_with_interval ik a b = a + let refine_with_interval ik a b = a (* TODO: refine inclusion (exclusion?) set *) let refine_with_excl_list ik a b = match b with @@ -3577,7 +3577,7 @@ module IntDomTupleImpl = struct in [(fun (a, b, c, d, e) -> refine_with_excl_list ik (a, b, c, d, e) (to_excl_list (a, b, c, d, e))); (fun (a, b, c, d, e) -> refine_with_incl_list ik (a, b, c, d, e) (to_incl_list (a, b, c, d, e))); - (fun (a, b, c, d, e) -> maybe refine_with_interval ik (a, b, c, d, e) b); + (fun (a, b, c, d, e) -> maybe refine_with_interval ik (a, b, c, d, e) b); (* TODO: get interval across all domains with minimal and maximal *) (fun (a, b, c, d, e) -> maybe refine_with_congruence ik (a, b, c, d, e) d)] let refine ik ((a, b, c, d, e) : t ) : t = @@ -3791,6 +3791,7 @@ module IntDomTupleImpl = struct | _ -> BatPrintf.fprintf f "\n\n%s\n\n\n" (show x) let invariant_ikind e ik ((_, _, _, x_cong, x_intset) as x) = + (* TODO: do refinement before to ensure incl_list being more precise than intervals, etc (https://github.com/goblint/analyzer/pull/1517#discussion_r1693998515), requires refine functions to actually refine that *) let simplify_int fallback = match to_int x with | Some v -> From e5f097c4eea6214c71aee679fcf6c6374cdb1152 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 26 Jan 2024 12:53:35 +0200 Subject: [PATCH 113/133] Enable ana.sv-comp.functions in some Apron tests using __VERIFIER_nondet_int --- tests/regression/36-apron/45-context.c | 2 +- tests/regression/36-apron/46-no-context.c | 2 +- tests/regression/36-apron/47-no-context-attribute.c | 2 +- tests/regression/36-apron/48-context-attribute.c | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/regression/36-apron/45-context.c b/tests/regression/36-apron/45-context.c index 94328af97f..eda945abd5 100644 --- a/tests/regression/36-apron/45-context.c +++ b/tests/regression/36-apron/45-context.c @@ -1,4 +1,4 @@ -// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.int.interval --enable ana.relation.context +// SKIP PARAM: --enable ana.sv-comp.functions --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.int.interval --enable ana.relation.context extern int __VERIFIER_nondet_int(); #include diff --git a/tests/regression/36-apron/46-no-context.c b/tests/regression/36-apron/46-no-context.c index bf115cee24..640784b913 100644 --- a/tests/regression/36-apron/46-no-context.c +++ b/tests/regression/36-apron/46-no-context.c @@ -1,4 +1,4 @@ -// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.int.interval --disable ana.relation.context +// SKIP PARAM: --enable ana.sv-comp.functions --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.int.interval --disable ana.relation.context extern int __VERIFIER_nondet_int(); #include diff --git a/tests/regression/36-apron/47-no-context-attribute.c b/tests/regression/36-apron/47-no-context-attribute.c index 90b58cdc28..cf111f5ffc 100644 --- a/tests/regression/36-apron/47-no-context-attribute.c +++ b/tests/regression/36-apron/47-no-context-attribute.c @@ -1,4 +1,4 @@ -// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.int.interval --enable ana.relation.context +// SKIP PARAM: --enable ana.sv-comp.functions --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.int.interval --enable ana.relation.context extern int __VERIFIER_nondet_int(); #include diff --git a/tests/regression/36-apron/48-context-attribute.c b/tests/regression/36-apron/48-context-attribute.c index 5e5ecf01fe..3304c20388 100644 --- a/tests/regression/36-apron/48-context-attribute.c +++ b/tests/regression/36-apron/48-context-attribute.c @@ -1,4 +1,4 @@ -// SKIP PARAM: --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.int.interval --disable ana.relation.context +// SKIP PARAM: --enable ana.sv-comp.functions --set ana.activated[+] apron --set ana.path_sens[+] threadflag --enable ana.int.interval --disable ana.relation.context extern int __VERIFIER_nondet_int(); #include From bc85d30c340457c8599360981c90a0768693b7dc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 26 Jan 2024 18:37:24 +0200 Subject: [PATCH 114/133] Make SetDomain hash non-commutative --- src/domain/setDomain.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/domain/setDomain.ml b/src/domain/setDomain.ml index 9b545a78ee..c552363f3d 100644 --- a/src/domain/setDomain.ml +++ b/src/domain/setDomain.ml @@ -184,7 +184,7 @@ struct end ) - let hash x = fold (fun x y -> y + Base.hash x) x 0 + let hash x = fold (fun x y -> 13 * y + Base.hash x) x 0 let relift x = map Base.relift x From 2a714b81804eb1bb4c06ba36aee34aa18bc9de10 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 30 Jul 2024 15:53:17 +0300 Subject: [PATCH 115/133] Simplify and generalize malloc fix in relational mutex-meet --- src/analyses/apron/relationPriv.apron.ml | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index 78a06dc227..ad4d26dfbf 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -479,25 +479,19 @@ struct let get_mutex_inits' = keep_only_protected_globals ask m get_mutex_inits in RD.join get_m get_mutex_inits' - let get_mutex_global_g_with_mutex_inits (ask:Q.ask) getg g = + let get_mutex_global_g_with_mutex_inits ask getg g = let g_var = AV.global g in let get_mutex_global_g = - let r = - if Param.handle_atomic then - (* Unprotected invariant is one big relation. *) - RD.keep_vars (getg (V.mutex atomic_mutex)) [g_var] - else - getg (V.global g) - in - if RD.is_bot r && (ask.f (Queries.IsAllocVar g)) then - (* malloc'ed blobs may not have a value here yet *) - RD.top () + if Param.handle_atomic then ( + (* Unprotected invariant is one big relation. *) + RD.keep_vars (getg (V.mutex atomic_mutex)) [g_var] + ) else - r + getg (V.global g) in let get_mutex_inits = getg V.mutex_inits in let get_mutex_inits' = RD.keep_vars get_mutex_inits [g_var] in - if not (RD.mem_var get_mutex_inits' g_var) then (* TODO: is this just a workaround for an escape bug? https://github.com/goblint/analyzer/pull/1354/files#r1498882657 *) + if RD.mem_var get_mutex_global_g g_var && not (RD.mem_var get_mutex_inits' g_var) then (* TODO: is this just a workaround for an escape bug? https://github.com/goblint/analyzer/pull/1354/files#r1498882657 *) (* This is an escaped variable whose value was never side-effected to get_mutex_inits' *) get_mutex_global_g else From 10a63d0acc1248d1399eb2ed397b3253db185002 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 31 Jul 2024 12:41:00 +0300 Subject: [PATCH 116/133] Make unavailable on BSD On FreeBSD gcc package installs cpp13 (not cpp-13), not cpp (which is clang's). Also, tcsh has no compgen to look up existing cpp-s. --- 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 7fe108f682..f342a85069 100644 --- a/goblint.opam +++ b/goblint.opam @@ -93,7 +93,7 @@ build: [ dev-repo: "git+https://github.com/goblint/analyzer.git" # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! -available: os-distribution != "alpine" & arch != "arm64" +available: os-family != "bsd" & os-distribution != "alpine" & arch != "arm64" pin-depends: [ # published goblint-cil 2.0.3 is currently up-to-date, so no pin needed [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] diff --git a/goblint.opam.locked b/goblint.opam.locked index 252459d517..9d1b688e14 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -128,7 +128,7 @@ build: [ ["dune" "install" "-p" name "--create-install-files" name] ] dev-repo: "git+https://github.com/goblint/analyzer.git" -available: os-distribution != "alpine" & arch != "arm64" +available: os-family != "bsd" & os-distribution != "alpine" & arch != "arm64" conflicts: [ "result" {< "1.5"} "ez-conf-lib" {= "1"} diff --git a/goblint.opam.template b/goblint.opam.template index a730d5c064..fc8f1d419b 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -1,6 +1,6 @@ # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! -available: os-distribution != "alpine" & arch != "arm64" +available: os-family != "bsd" & os-distribution != "alpine" & arch != "arm64" pin-depends: [ # published goblint-cil 2.0.3 is currently up-to-date, so no pin needed [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] From bc8811c8034ec1600823923e4cdc625bfe949d1c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Aug 2024 10:06:18 +0300 Subject: [PATCH 117/133] Finalize CHANGELOG for v2.4.0 --- CHANGELOG.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 73b235883f..420cc7145e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,11 +1,11 @@ -## v2.4.0 (unreleased) +## v2.4.0 * Remove unmaintained analyses: spec, file (#1281). * Add linear two-variable equalities analysis (#1297, #1412, #1466). * Add callstring, loopfree callstring and context gas analyses (#1038, #1340, #1379, #1427, #1439). * Add non-relational thread-modular value analyses with thread IDs (#1366, #1398, #1399). * Add NULL byte array domain (#1076). * Fix spurious overflow warnings from internal evaluations (#1406, #1411, #1511). -* Refactor non-definite mutex handling to fix unsoundness (#1430, #1500, #1409). +* Refactor non-definite mutex handling to fix unsoundness (#1430, #1500, #1503, #1409). * Fix non-relational thread-modular value analysis unsoundness with ambiguous points-to sets (#1457, #1458). * Fix mutex type analysis unsoundness and enable it by default (#1414, #1416, #1510). * Add points-to set refinement on mutex path splitting (#1287, #1343, #1374, #1396, #1407). From cffe5c2e35fd1912a5c927bd1a5377035a4bee7e Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Aug 2024 10:22:28 +0300 Subject: [PATCH 118/133] Replace goblint-cil pin with published 2.0.4, remove pins for v2.4.0 release --- dune-project | 2 +- goblint.opam | 10 +++++----- goblint.opam.locked | 9 +-------- goblint.opam.template | 8 ++++---- gobview | 2 +- src/common/util/cilType.ml | 1 + src/incremental/compareAST.ml | 1 + 7 files changed, 14 insertions(+), 19 deletions(-) diff --git a/dune-project b/dune-project index 3927e77bdd..f854518419 100644 --- a/dune-project +++ b/dune-project @@ -37,7 +37,7 @@ Goblint includes analyses for assertions, overflows, deadlocks, etc and can be e "concurrency")) (depends (ocaml (>= 4.14)) - (goblint-cil (>= 2.0.3)) ; TODO no way to define as pin-depends? Used goblint.opam.template to add it for now. https://github.com/ocaml/dune/issues/3231. Alternatively, removing this line and adding cil as a git submodule and `(vendored_dirs cil)` as ./dune also works. This way, no more need to reinstall the pinned cil opam package on changes. However, then cil is cleaned and has to be rebuild together with goblint. + (goblint-cil (>= 2.0.4)) ; TODO no way to define as pin-depends? Used goblint.opam.template to add it for now. https://github.com/ocaml/dune/issues/3231. Alternatively, removing this line and adding cil as a git submodule and `(vendored_dirs cil)` as ./dune also works. This way, no more need to reinstall the pinned cil opam package on changes. However, then cil is cleaned and has to be rebuild together with goblint. (batteries (>= 3.5.1)) (zarith (>= 1.10)) (yojson (>= 2.0.0)) diff --git a/goblint.opam b/goblint.opam index f342a85069..6809044a7e 100644 --- a/goblint.opam +++ b/goblint.opam @@ -37,7 +37,7 @@ bug-reports: "https://github.com/goblint/analyzer/issues" depends: [ "dune" {>= "3.7"} "ocaml" {>= "4.14"} - "goblint-cil" {>= "2.0.3"} + "goblint-cil" {>= "2.0.4"} "batteries" {>= "3.5.1"} "zarith" {>= "1.10"} "yojson" {>= "2.0.0"} @@ -94,10 +94,10 @@ dev-repo: "git+https://github.com/goblint/analyzer.git" # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" & arch != "arm64" -pin-depends: [ - # published goblint-cil 2.0.3 is currently up-to-date, so no pin needed - [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] -] +# pin-depends: [ + # published goblint-cil 2.0.4 is currently up-to-date, so no pin needed + # [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] +# ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} ] diff --git a/goblint.opam.locked b/goblint.opam.locked index 9d1b688e14..5c1eb95709 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -64,7 +64,7 @@ depends: [ "fileutils" {= "0.6.4"} "fmt" {= "0.9.0"} "fpath" {= "0.7.3"} - "goblint-cil" {= "2.0.3"} + "goblint-cil" {= "2.0.4"} "hex" {= "1.5.0"} "integers" {= "0.7.0"} "json-data-encoding" {= "1.0.1"} @@ -136,13 +136,6 @@ conflicts: [ post-messages: [ "Do not benchmark Goblint on OCaml 5 (https://goblint.readthedocs.io/en/latest/user-guide/benchmarking/)." {ocaml:version >= "5.0.0"} ] -# TODO: manually reordered to avoid opam pin crash: https://github.com/ocaml/opam/issues/4936 -pin-depends: [ - [ - "goblint-cil.2.0.3" - "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" - ] -] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} description: """\ Goblint is a sound static analysis framework for C programs using abstract interpretation. diff --git a/goblint.opam.template b/goblint.opam.template index fc8f1d419b..53260fb576 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -1,10 +1,10 @@ # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" & arch != "arm64" -pin-depends: [ - # published goblint-cil 2.0.3 is currently up-to-date, so no pin needed - [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] -] +# pin-depends: [ + # published goblint-cil 2.0.4 is currently up-to-date, so no pin needed + # [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] +# ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} ] diff --git a/gobview b/gobview index 03b0682f97..76e42c34d3 160000 --- a/gobview +++ b/gobview @@ -1 +1 @@ -Subproject commit 03b0682f973eab0d26cf8aea74c63a9e869c9716 +Subproject commit 76e42c34d36bd2ab6900efd661a972ba4824f065 diff --git a/src/common/util/cilType.ml b/src/common/util/cilType.ml index a484a228bd..5a473b7d60 100644 --- a/src/common/util/cilType.ml +++ b/src/common/util/cilType.ml @@ -698,6 +698,7 @@ struct | AAddrOf of t | AIndex of t * t | AQuestion of t * t * t + | AAssign of t * t [@@deriving eq, ord, hash] let name () = "attrparam" diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index f3de153658..2449cdac47 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -210,6 +210,7 @@ and eq_attrparam (a: attrparam) (b: attrparam) ~(rename_mapping: rename_mapping) | AAddrOf attrparam1, AAddrOf attrparam2 -> eq_attrparam attrparam1 attrparam2 ~rename_mapping ~acc | AIndex (left1, right1), AIndex (left2, right2) -> eq_attrparam left1 left2 ~rename_mapping ~acc &&>> eq_attrparam right1 right2 ~acc | AQuestion (left1, middle1, right1), AQuestion (left2, middle2, right2) -> eq_attrparam left1 left2 ~rename_mapping ~acc &&>> eq_attrparam middle1 middle2 ~acc &&>> eq_attrparam right1 right2 ~acc + | AAssign (left1, right1), AAssign (left2, right2) -> eq_attrparam left1 left2 ~rename_mapping ~acc &&>> eq_attrparam right1 right2 ~acc | a, b -> a = b, rename_mapping and eq_attribute (a: attribute) (b: attribute) ~(acc: (typ * typ) list) ~(rename_mapping: rename_mapping) = match a, b with From 8dd27a167601b98d79f58747060464bd06122289 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Aug 2024 10:24:11 +0300 Subject: [PATCH 119/133] Fix unused parameter error in BenchSet --- bench/basic/benchSet.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bench/basic/benchSet.ml b/bench/basic/benchSet.ml index 14eb03be82..ae38c156da 100644 --- a/bench/basic/benchSet.ml +++ b/bench/basic/benchSet.ml @@ -73,7 +73,7 @@ let () = ] ); "const" @> lazy ( - let args = ((fun x -> 42), set1) in + let args = ((fun _ -> 42), set1) in throughputN 1 [ ("map1", map1, args); ("map2", map2, args); From e09d31b3002d1e9f87d85d8a31a52c56a759486f Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Aug 2024 10:28:33 +0300 Subject: [PATCH 120/133] Make available on arm64 --- 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 6809044a7e..85068b4114 100644 --- a/goblint.opam +++ b/goblint.opam @@ -93,7 +93,7 @@ build: [ dev-repo: "git+https://github.com/goblint/analyzer.git" # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! -available: os-family != "bsd" & os-distribution != "alpine" & arch != "arm64" +available: os-family != "bsd" & os-distribution != "alpine" # pin-depends: [ # published goblint-cil 2.0.4 is currently up-to-date, so no pin needed # [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] diff --git a/goblint.opam.locked b/goblint.opam.locked index 5c1eb95709..ca03f318b4 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -128,7 +128,7 @@ build: [ ["dune" "install" "-p" name "--create-install-files" name] ] dev-repo: "git+https://github.com/goblint/analyzer.git" -available: os-family != "bsd" & os-distribution != "alpine" & arch != "arm64" +available: os-family != "bsd" & os-distribution != "alpine" conflicts: [ "result" {< "1.5"} "ez-conf-lib" {= "1"} diff --git a/goblint.opam.template b/goblint.opam.template index 53260fb576..605f07751c 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -1,6 +1,6 @@ # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! -available: os-family != "bsd" & os-distribution != "alpine" & arch != "arm64" +available: os-family != "bsd" & os-distribution != "alpine" # pin-depends: [ # published goblint-cil 2.0.4 is currently up-to-date, so no pin needed # [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] From 0ad776f1ab4204878813c02b04b709cfdc3928a1 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Aug 2024 10:28:42 +0300 Subject: [PATCH 121/133] Add M1 OSX to unlocked CI --- .github/workflows/unlocked.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/unlocked.yml b/.github/workflows/unlocked.yml index 6a9eced42c..0c4433d0af 100644 --- a/.github/workflows/unlocked.yml +++ b/.github/workflows/unlocked.yml @@ -33,6 +33,8 @@ jobs: - os: ubuntu-latest ocaml-compiler: 4.14.x z3: true + - os: macos-latest + ocaml-compiler: 4.14.x # customize name to use readable string for apron instead of just a boolean # workaround for missing ternary operator: https://github.com/actions/runner/issues/409 From ad95965788dcd2accb884df584966fd77fa48569 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Aug 2024 14:53:49 +0300 Subject: [PATCH 122/133] Update releasing documentation --- docs/developer-guide/releasing.md | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/docs/developer-guide/releasing.md b/docs/developer-guide/releasing.md index d875c0d3bf..7530d9ad20 100644 --- a/docs/developer-guide/releasing.md +++ b/docs/developer-guide/releasing.md @@ -24,6 +24,8 @@ All changes must be committed because the working tree is not checked. + The warning `[FAIL] opam field doc cannot be parsed by dune-release` is fine and can be ignored (see ). + 8. Check that "unlocked" workflow passes on GitHub Actions. It can be run manually on the release branch for checking. @@ -36,12 +38,13 @@ 1. Pull Docker image: `docker pull ocaml/opam:ubuntu-22.04-ocaml-4.14` (or newer). 2. Extract distribution archive. 3. Run Docker container in extracted directory: `docker run -it --rm -v $(pwd):/goblint ocaml/opam:ubuntu-22.04-ocaml-4.14` (or newer). - 4. Navigate to distribution archive inside Docker container: `cd /goblint`. - 5. Install and test package from distribution archive: `opam-2.1 install --with-test .`. - 6. Activate opam environment: `eval $(opam env)`. - 7. Check version: `goblint --version`. - 8. Check that analysis works: `goblint -v tests/regression/04-mutex/01-simple_rc.c`. - 9. Exit Docker container. + 4. Update opam-repository from git: `opam-2.1 repository add git git+https://github.com/ocaml/opam-repository.git && opam-2.1 update`. + 5. Navigate to distribution archive inside Docker container: `cd /goblint`. + 6. Install and test package from distribution archive: `opam-2.1 install --with-test .`. + 7. Activate opam environment: `eval $(opam env)`. + 8. Check version: `goblint --version`. + 9. Check that analysis works: `goblint -v tests/regression/04-mutex/01-simple_rc.c`. + 10. Exit Docker container. 12. Temporarily enable Zenodo GitHub webhook. From d46438a3c6b8b643db0d3a1edfe8894ac72fd7f0 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 2 Aug 2024 14:57:22 +0300 Subject: [PATCH 123/133] Partially revert "Replace goblint-cil pin with published 2.0.4, remove pins for v2.4.0 release" This reverts commit cffe5c2e35fd1912a5c927bd1a5377035a4bee7e. --- goblint.opam | 7 +++---- goblint.opam.locked | 6 ++++++ goblint.opam.template | 7 +++---- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/goblint.opam b/goblint.opam index 85068b4114..37cd36bf6e 100644 --- a/goblint.opam +++ b/goblint.opam @@ -94,10 +94,9 @@ dev-repo: "git+https://github.com/goblint/analyzer.git" # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" -# pin-depends: [ - # published goblint-cil 2.0.4 is currently up-to-date, so no pin needed - # [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] -# ] +pin-depends: [ + [ "goblint-cil.2.0.4" "git+https://github.com/goblint/cil.git#317e26d48b06d5cdc4acff3df1a6824587052b53" ] +] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} ] diff --git a/goblint.opam.locked b/goblint.opam.locked index ca03f318b4..7b23cc8a18 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -136,6 +136,12 @@ conflicts: [ post-messages: [ "Do not benchmark Goblint on OCaml 5 (https://goblint.readthedocs.io/en/latest/user-guide/benchmarking/)." {ocaml:version >= "5.0.0"} ] +pin-depends: [ + [ + "goblint-cil.2.0.4" + "git+https://github.com/goblint/cil.git#317e26d48b06d5cdc4acff3df1a6824587052b53" + ] +] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} description: """\ Goblint is a sound static analysis framework for C programs using abstract interpretation. diff --git a/goblint.opam.template b/goblint.opam.template index 605f07751c..3adc8e05c0 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -1,10 +1,9 @@ # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" -# pin-depends: [ - # published goblint-cil 2.0.4 is currently up-to-date, so no pin needed - # [ "goblint-cil.2.0.3" "git+https://github.com/goblint/cil.git#ae3a4949d478fad77e004c6fe15a7c83427df59f" ] -# ] +pin-depends: [ + [ "goblint-cil.2.0.4" "git+https://github.com/goblint/cil.git#317e26d48b06d5cdc4acff3df1a6824587052b53" ] +] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} ] From 3ad6b396681e0cb936eba09c4d7b6ebed882a0a2 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Sun, 4 Aug 2024 14:02:53 +0200 Subject: [PATCH 124/133] Typo --- src/analyses/base.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 29fa74c5a9..4e523fe1ee 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2168,7 +2168,7 @@ struct end | _, _ when get_bool "sem.unknown_function.spawn" -> (* TODO: Remove sem.unknown_function.spawn check because it is (and should be) really done in LibraryFunctions. - But here we consider all non-ThreadCrate functions also unknown, so old-style LibraryFunctions access + But here we consider all non-ThreadCreate functions also unknown, so old-style LibraryFunctions access definitions using `Write would still spawn because they are not truly unknown functions (missing from LibraryFunctions). Need this to not have memmove spawn in SV-COMP. *) let shallow_args = LibraryDesc.Accesses.find desc.accs { kind = Spawn; deep = false } args in From 64d392de0ce64e2fee2b43ad42c0788856a7310b Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 5 Aug 2024 11:13:43 +0300 Subject: [PATCH 125/133] Unvendor ppx_blob Version 0.8.0 includes the previously vendored fix for `(lang dune 3.0)`. --- dune-project | 1 + goblint.opam | 1 + goblint.opam.locked | 1 + src/vendor/ppx_blob/LICENSE.txt | 24 -------------------- src/vendor/ppx_blob/README.md | 1 - src/vendor/ppx_blob/src/dune | 5 ----- src/vendor/ppx_blob/src/ppx_blob.ml | 35 ----------------------------- 7 files changed, 3 insertions(+), 65 deletions(-) delete mode 100644 src/vendor/ppx_blob/LICENSE.txt delete mode 100644 src/vendor/ppx_blob/README.md delete mode 100644 src/vendor/ppx_blob/src/dune delete mode 100644 src/vendor/ppx_blob/src/ppx_blob.ml diff --git a/dune-project b/dune-project index f854518419..6ea0734887 100644 --- a/dune-project +++ b/dune-project @@ -45,6 +45,7 @@ Goblint includes analyses for assertions, overflows, deadlocks, etc and can be e (ppx_deriving (>= 6.0.2)) (ppx_deriving_hash (>= 0.1.2)) (ppx_deriving_yojson (>= 3.7.0)) + (ppx_blob (>= 0.8.0)) (ounit2 :with-test) (qcheck-ounit :with-test) (odoc :with-doc) diff --git a/goblint.opam b/goblint.opam index 37cd36bf6e..6ea4183992 100644 --- a/goblint.opam +++ b/goblint.opam @@ -45,6 +45,7 @@ depends: [ "ppx_deriving" {>= "6.0.2"} "ppx_deriving_hash" {>= "0.1.2"} "ppx_deriving_yojson" {>= "3.7.0"} + "ppx_blob" {>= "0.8.0"} "ounit2" {with-test} "qcheck-ounit" {with-test} "odoc" {with-doc} diff --git a/goblint.opam.locked b/goblint.opam.locked index 7b23cc8a18..ed6424dbd3 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -85,6 +85,7 @@ depends: [ "ordering" {= "3.16.0"} "ounit2" {= "2.2.7" & with-test} "pp" {= "1.2.0"} + "ppx_blob" {= "0.9.0"} "ppx_derivers" {= "1.2.1"} "ppx_deriving" {= "6.0.2"} "ppx_deriving_hash" {= "0.1.2"} diff --git a/src/vendor/ppx_blob/LICENSE.txt b/src/vendor/ppx_blob/LICENSE.txt deleted file mode 100644 index 00d2e135a7..0000000000 --- a/src/vendor/ppx_blob/LICENSE.txt +++ /dev/null @@ -1,24 +0,0 @@ -This is free and unencumbered software released into the public domain. - -Anyone is free to copy, modify, publish, use, compile, sell, or -distribute this software, either in source code form or as a compiled -binary, for any purpose, commercial or non-commercial, and by any -means. - -In jurisdictions that recognize copyright laws, the author or authors -of this software dedicate any and all copyright interest in the -software to the public domain. We make this dedication for the benefit -of the public at large and to the detriment of our heirs and -successors. We intend this dedication to be an overt act of -relinquishment in perpetuity of all present and future rights to this -software under copyright law. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR -OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -OTHER DEALINGS IN THE SOFTWARE. - -For more information, please refer to \ No newline at end of file diff --git a/src/vendor/ppx_blob/README.md b/src/vendor/ppx_blob/README.md deleted file mode 100644 index fdd7448a32..0000000000 --- a/src/vendor/ppx_blob/README.md +++ /dev/null @@ -1 +0,0 @@ -ppx_blob fix for `(lang dune 3.0)` vendored from . diff --git a/src/vendor/ppx_blob/src/dune b/src/vendor/ppx_blob/src/dune deleted file mode 100644 index 112b1d07c0..0000000000 --- a/src/vendor/ppx_blob/src/dune +++ /dev/null @@ -1,5 +0,0 @@ -(library - (name ppx_blob) - ; (public_name ppx_blob) - (kind ppx_rewriter) - (libraries ppxlib)) \ No newline at end of file diff --git a/src/vendor/ppx_blob/src/ppx_blob.ml b/src/vendor/ppx_blob/src/ppx_blob.ml deleted file mode 100644 index 622a99f8f6..0000000000 --- a/src/vendor/ppx_blob/src/ppx_blob.ml +++ /dev/null @@ -1,35 +0,0 @@ -open Ppxlib - -let location_errorf ~loc = - Format.ksprintf (fun err -> - raise (Ocaml_common.Location.Error (Ocaml_common.Location.error ~loc err)) - ) - -let find_file_path ~loc file_name = - let dirname = loc.Ocaml_common.Location.loc_start.pos_fname |> Filename.dirname in - let relative_path = Filename.concat dirname file_name in - List.find Sys.file_exists [relative_path; file_name] - -let get_blob ~loc file_name = - try - let file_path = find_file_path ~loc file_name in - let c = open_in_bin file_path in - let s = String.init (in_channel_length c) (fun _ -> input_char c) in - close_in c; - s - with _ -> - location_errorf ~loc "[%%blob] could not find or load file %s" file_name - -let expand ~ctxt file_name = - let loc = Expansion_context.Extension.extension_point_loc ctxt in - Ast_builder.Default.estring ~loc (get_blob ~loc file_name) - -let extension = - Extension.V3.declare "blob" Extension.Context.expression - Ast_pattern.(single_expr_payload (estring __)) - expand - -let rule = Ppxlib.Context_free.Rule.extension extension - -;; -Driver.register_transformation ~rules:[rule] "ppx_blob" \ No newline at end of file From 636e8ff1e1b8e9653f83704a3e0e2785ff5eabdc Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Aug 2024 11:11:41 +0300 Subject: [PATCH 126/133] Upstream opam file from opam-repository for 2.4.0 --- goblint.opam | 6 +++++- goblint.opam.locked | 2 +- goblint.opam.template | 6 +++++- 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/goblint.opam b/goblint.opam index 37cd36bf6e..24845583f5 100644 --- a/goblint.opam +++ b/goblint.opam @@ -93,7 +93,7 @@ build: [ dev-repo: "git+https://github.com/goblint/analyzer.git" # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! -available: os-family != "bsd" & os-distribution != "alpine" +available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") pin-depends: [ [ "goblint-cil.2.0.4" "git+https://github.com/goblint/cil.git#317e26d48b06d5cdc4acff3df1a6824587052b53" ] ] @@ -103,3 +103,7 @@ depexts: [ post-messages: [ "Do not benchmark Goblint on OCaml 5 (https://goblint.readthedocs.io/en/latest/user-guide/benchmarking/)." {ocaml:version >= "5.0.0"} ] +x-ci-accept-failures: [ + "macos-homebrew" # newer MacOS headers cannot be parsed (https://github.com/ocaml/opam-repository/pull/26307#issuecomment-2258080206) + "opensuse-tumbleweed" # not GNU diff, so some cram tests fail (https://discuss.ocaml.org/t/opensuse-and-opam-tests/14641/2) +] diff --git a/goblint.opam.locked b/goblint.opam.locked index 7b23cc8a18..c629aa6755 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -128,7 +128,7 @@ build: [ ["dune" "install" "-p" name "--create-install-files" name] ] dev-repo: "git+https://github.com/goblint/analyzer.git" -available: os-family != "bsd" & os-distribution != "alpine" +available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") conflicts: [ "result" {< "1.5"} "ez-conf-lib" {= "1"} diff --git a/goblint.opam.template b/goblint.opam.template index 3adc8e05c0..bb70aa29e7 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -1,6 +1,6 @@ # on `dune build` goblint.opam will be generated from goblint.opam.template and dune-project # also remember to generate/adjust goblint.opam.locked! -available: os-family != "bsd" & os-distribution != "alpine" +available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") pin-depends: [ [ "goblint-cil.2.0.4" "git+https://github.com/goblint/cil.git#317e26d48b06d5cdc4acff3df1a6824587052b53" ] ] @@ -10,3 +10,7 @@ depexts: [ post-messages: [ "Do not benchmark Goblint on OCaml 5 (https://goblint.readthedocs.io/en/latest/user-guide/benchmarking/)." {ocaml:version >= "5.0.0"} ] +x-ci-accept-failures: [ + "macos-homebrew" # newer MacOS headers cannot be parsed (https://github.com/ocaml/opam-repository/pull/26307#issuecomment-2258080206) + "opensuse-tumbleweed" # not GNU diff, so some cram tests fail (https://discuss.ocaml.org/t/opensuse-and-opam-tests/14641/2) +] From b9caf634f7fcbe006b60d5dc4c5d7e28ca8f74a2 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Wed, 7 Aug 2024 11:31:12 +0300 Subject: [PATCH 127/133] Fix Ppx_deriving_printable comment indentation --- src/ppx/printable/ppx_deriving_printable.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ppx/printable/ppx_deriving_printable.ml b/src/ppx/printable/ppx_deriving_printable.ml index b8b80d6730..75fd5044fe 100644 --- a/src/ppx/printable/ppx_deriving_printable.ml +++ b/src/ppx/printable/ppx_deriving_printable.ml @@ -12,5 +12,5 @@ let relift_deriving = ReliftDeriver.register () (* TODO: needs https://github.com/ocaml-ppx/ppxlib/pull/124 to include eq, ord, hash *) (* let _ = Ppxlib.Deriving.add_alias "printable" [ - relift_deriving; - ] *) + relift_deriving; + ] *) From e630b744c71f370a746ef1b9955f11efa654523a Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 12 Aug 2024 14:20:48 +0300 Subject: [PATCH 128/133] Add backtrace markers around LibraryFunctions special calls (issue #1541) --- src/autoTune.ml | 3 +++ src/cdomain/value/util/wideningThresholds.ml | 1 + src/common/dune | 1 + src/common/util/cilfacade.ml | 8 ++++++++ src/transform/evalAssert.ml | 1 + src/util/loopUnrolling.ml | 1 + src/witness/witnessUtil.ml | 1 + 7 files changed, 16 insertions(+) diff --git a/src/autoTune.ml b/src/autoTune.ml index 8ec77739e7..43067b8bbc 100644 --- a/src/autoTune.ml +++ b/src/autoTune.ml @@ -68,6 +68,7 @@ let functionArgs fd = (ResettableLazy.force functionCallMaps).argLists |> Functi let findMallocWrappers () = let isMalloc f = + Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo f) ~finally:Fun.id @@ fun () -> if LibraryFunctions.is_special f then ( let desc = LibraryFunctions.find f in match functionArgs f with @@ -153,6 +154,7 @@ let disableIntervalContextsInRecursiveFunctions () = let hasFunction pred = let relevant_static var = + Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo var) ~finally:Fun.id @@ fun () -> if LibraryFunctions.is_special var then let desc = LibraryFunctions.find var in GobOption.exists (fun args -> pred (desc.special args)) (functionArgs var) @@ -160,6 +162,7 @@ let hasFunction pred = false in let relevant_dynamic var = + Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo var) ~finally:Fun.id @@ fun () -> if LibraryFunctions.is_special var then let desc = LibraryFunctions.find var in (* We don't really have arguments at hand, so we cheat and just feed it a list of MyCFG.unknown_exp of appropriate length *) diff --git a/src/cdomain/value/util/wideningThresholds.ml b/src/cdomain/value/util/wideningThresholds.ml index 0d93be76ff..42dff238ef 100644 --- a/src/cdomain/value/util/wideningThresholds.ml +++ b/src/cdomain/value/util/wideningThresholds.ml @@ -121,6 +121,7 @@ class extractInvariantsVisitor (exps) = object method! vinst (i: instr) = match i with | Call (_, Lval (Var f, NoOffset), args, _, _) when LibraryFunctions.is_special f -> + Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo f) ~finally:Fun.id @@ fun () -> let desc = LibraryFunctions.find f in begin match desc.special args with | Assert { exp; _ } -> diff --git a/src/common/dune b/src/common/dune index 2d6816a00f..e5aeddde7f 100644 --- a/src/common/dune +++ b/src/common/dune @@ -11,6 +11,7 @@ goblint_logs goblint_config goblint_tracing + goblint_backtrace goblint-cil fpath yojson diff --git a/src/common/util/cilfacade.ml b/src/common/util/cilfacade.ml index 99430ee8b6..8cd8c2c53f 100644 --- a/src/common/util/cilfacade.ml +++ b/src/common/util/cilfacade.ml @@ -6,6 +6,14 @@ module E = Errormsg include Cilfacade0 +type Goblint_backtrace.mark += FunVarinfo of varinfo + +let () = Goblint_backtrace.register_mark_printer (function + | FunVarinfo var -> + Some ("function " ^ CilType.Varinfo.show var) + | _ -> None (* for other marks *) + ) + (** 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) = (* Hack: using negative integers should preempt conflicts with ids generated by CIL *) diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index 0fee26355b..90da794a93 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -44,6 +44,7 @@ struct let is_lock exp args = match exp with | Lval(Var v,_) when LibraryFunctions.is_special v -> + Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo v) ~finally:Fun.id @@ fun () -> let desc = LibraryFunctions.find v in (match desc.special args with | Lock _ -> true diff --git a/src/util/loopUnrolling.ml b/src/util/loopUnrolling.ml index e433c34b4a..42518708e9 100644 --- a/src/util/loopUnrolling.ml +++ b/src/util/loopUnrolling.ml @@ -311,6 +311,7 @@ class loopUnrollingCallVisitor = object method! vinst = function | Call (_,Lval ((Var info), NoOffset),args,_,_) when LibraryFunctions.is_special info -> ( + Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo info) ~finally:Fun.id @@ fun () -> let desc = LibraryFunctions.find info in match desc.special args with | Malloc _ diff --git a/src/witness/witnessUtil.ml b/src/witness/witnessUtil.ml index 5d22fd1e83..c585b21abc 100644 --- a/src/witness/witnessUtil.ml +++ b/src/witness/witnessUtil.ml @@ -63,6 +63,7 @@ struct List.exists (fun (_, edge) -> match edge with | Proc (_, Lval (Var fv, NoOffset), args) when LibraryFunctions.is_special fv -> + Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo fv) ~finally:Fun.id @@ fun () -> let desc = LibraryFunctions.find fv in begin match desc.special args with | Lock _ -> true From 476f20be1ad83c0857cd975741683d8e66e2608c Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 12 Aug 2024 14:23:59 +0300 Subject: [PATCH 129/133] Fix __printf_chk library function specification (closes #1541) --- src/util/library/libraryFunctions.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/util/library/libraryFunctions.ml b/src/util/library/libraryFunctions.ml index e7ff2a4d04..25a90da2d3 100644 --- a/src/util/library/libraryFunctions.ml +++ b/src/util/library/libraryFunctions.ml @@ -712,7 +712,7 @@ let linux_userspace_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__errno", unknown []); ("__errno_location", unknown []); ("__h_errno_location", unknown []); - ("__printf_chk", unknown [drop "flag" []; drop "format" [r]]); + ("__printf_chk", unknown (drop "flag" [] :: drop "format" [r] :: VarArgs (drop' [r]))); ("__fprintf_chk", unknown (drop "stream" [r_deep; w_deep] :: drop "flag" [] :: drop "format" [r] :: VarArgs (drop' [r]))); ("__vfprintf_chk", unknown [drop "stream" [r_deep; w_deep]; drop "flag" []; drop "format" [r]; drop "ap" [r_deep]]); ("sysinfo", unknown [drop "info" [w_deep]]); From 4eb58d6be1462f75b113cf87fe63beddb4cce770 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Mon, 12 Aug 2024 14:30:38 +0300 Subject: [PATCH 130/133] Add Goblint_backtrace.wrap_val --- src/autoTune.ml | 6 +++--- src/cdomain/value/util/wideningThresholds.ml | 2 +- src/transform/evalAssert.ml | 2 +- src/util/backtrace/goblint_backtrace.ml | 9 +++++++++ src/util/backtrace/goblint_backtrace.mli | 3 +++ src/util/loopUnrolling.ml | 2 +- src/witness/witnessUtil.ml | 2 +- 7 files changed, 19 insertions(+), 7 deletions(-) diff --git a/src/autoTune.ml b/src/autoTune.ml index 43067b8bbc..a0b57c34e4 100644 --- a/src/autoTune.ml +++ b/src/autoTune.ml @@ -68,7 +68,7 @@ let functionArgs fd = (ResettableLazy.force functionCallMaps).argLists |> Functi let findMallocWrappers () = let isMalloc f = - Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo f) ~finally:Fun.id @@ fun () -> + Goblint_backtrace.wrap_val ~mark:(Cilfacade.FunVarinfo f) @@ fun () -> if LibraryFunctions.is_special f then ( let desc = LibraryFunctions.find f in match functionArgs f with @@ -154,7 +154,7 @@ let disableIntervalContextsInRecursiveFunctions () = let hasFunction pred = let relevant_static var = - Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo var) ~finally:Fun.id @@ fun () -> + Goblint_backtrace.wrap_val ~mark:(Cilfacade.FunVarinfo var) @@ fun () -> if LibraryFunctions.is_special var then let desc = LibraryFunctions.find var in GobOption.exists (fun args -> pred (desc.special args)) (functionArgs var) @@ -162,7 +162,7 @@ let hasFunction pred = false in let relevant_dynamic var = - Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo var) ~finally:Fun.id @@ fun () -> + Goblint_backtrace.wrap_val ~mark:(Cilfacade.FunVarinfo var) @@ fun () -> if LibraryFunctions.is_special var then let desc = LibraryFunctions.find var in (* We don't really have arguments at hand, so we cheat and just feed it a list of MyCFG.unknown_exp of appropriate length *) diff --git a/src/cdomain/value/util/wideningThresholds.ml b/src/cdomain/value/util/wideningThresholds.ml index 42dff238ef..939ed9482f 100644 --- a/src/cdomain/value/util/wideningThresholds.ml +++ b/src/cdomain/value/util/wideningThresholds.ml @@ -121,7 +121,7 @@ class extractInvariantsVisitor (exps) = object method! vinst (i: instr) = match i with | Call (_, Lval (Var f, NoOffset), args, _, _) when LibraryFunctions.is_special f -> - Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo f) ~finally:Fun.id @@ fun () -> + Goblint_backtrace.wrap_val ~mark:(Cilfacade.FunVarinfo f) @@ fun () -> let desc = LibraryFunctions.find f in begin match desc.special args with | Assert { exp; _ } -> diff --git a/src/transform/evalAssert.ml b/src/transform/evalAssert.ml index 90da794a93..8f858d09df 100644 --- a/src/transform/evalAssert.ml +++ b/src/transform/evalAssert.ml @@ -44,7 +44,7 @@ struct let is_lock exp args = match exp with | Lval(Var v,_) when LibraryFunctions.is_special v -> - Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo v) ~finally:Fun.id @@ fun () -> + Goblint_backtrace.wrap_val ~mark:(Cilfacade.FunVarinfo v) @@ fun () -> let desc = LibraryFunctions.find v in (match desc.special args with | Lock _ -> true diff --git a/src/util/backtrace/goblint_backtrace.ml b/src/util/backtrace/goblint_backtrace.ml index 29198c27ea..513753bddb 100644 --- a/src/util/backtrace/goblint_backtrace.ml +++ b/src/util/backtrace/goblint_backtrace.ml @@ -36,6 +36,15 @@ let protect ~(mark: unit -> mark) ~(finally: unit -> unit) work = add_mark work_exn (mark ()); Printexc.raise_with_backtrace work_exn work_bt +(* Copied & modified from protect. *) +let wrap_val ~(mark:mark) work = + try + work () + with work_exn -> + let work_bt = Printexc.get_raw_backtrace () in + add_mark work_exn mark; + Printexc.raise_with_backtrace work_exn work_bt + let mark_printers: (mark -> string option) list ref = ref [] diff --git a/src/util/backtrace/goblint_backtrace.mli b/src/util/backtrace/goblint_backtrace.mli index e2b6ed2913..e53bfd826a 100644 --- a/src/util/backtrace/goblint_backtrace.mli +++ b/src/util/backtrace/goblint_backtrace.mli @@ -24,6 +24,9 @@ val add_mark: exn -> mark -> unit val protect: mark:(unit -> mark) -> finally:(unit -> unit) -> (unit -> 'a) -> 'a (** {!Fun.protect} with additional [~mark] addition to all exceptions. *) +val wrap_val: mark:mark -> (unit -> 'a) -> 'a +(** {!protect} with [~mark] value and without [~finally]. *) + val print_marktrace: out_channel -> exn -> unit (** Print trace of marks of an exception. diff --git a/src/util/loopUnrolling.ml b/src/util/loopUnrolling.ml index 42518708e9..07c20cb574 100644 --- a/src/util/loopUnrolling.ml +++ b/src/util/loopUnrolling.ml @@ -311,7 +311,7 @@ class loopUnrollingCallVisitor = object method! vinst = function | Call (_,Lval ((Var info), NoOffset),args,_,_) when LibraryFunctions.is_special info -> ( - Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo info) ~finally:Fun.id @@ fun () -> + Goblint_backtrace.wrap_val ~mark:(Cilfacade.FunVarinfo info) @@ fun () -> let desc = LibraryFunctions.find info in match desc.special args with | Malloc _ diff --git a/src/witness/witnessUtil.ml b/src/witness/witnessUtil.ml index c585b21abc..1526b6f95c 100644 --- a/src/witness/witnessUtil.ml +++ b/src/witness/witnessUtil.ml @@ -63,7 +63,7 @@ struct List.exists (fun (_, edge) -> match edge with | Proc (_, Lval (Var fv, NoOffset), args) when LibraryFunctions.is_special fv -> - Goblint_backtrace.protect ~mark:(fun () -> Cilfacade.FunVarinfo fv) ~finally:Fun.id @@ fun () -> + Goblint_backtrace.wrap_val ~mark:(Cilfacade.FunVarinfo fv) @@ fun () -> let desc = LibraryFunctions.find fv in begin match desc.special args with | Lock _ -> true From 0d6d3a8e5911476875464b7b6c402908453d8323 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 16 Aug 2024 10:19:51 +0300 Subject: [PATCH 131/133] Pin CIL with attr-enumerator fix for MacOS --- goblint.opam | 2 +- goblint.opam.locked | 2 +- goblint.opam.template | 2 +- src/cdomain/value/cdomains/mutexAttrDomain.ml | 2 +- src/incremental/compareAST.ml | 4 ++-- src/witness/witnessUtil.ml | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) diff --git a/goblint.opam b/goblint.opam index b73d2c0329..2ed13448f5 100644 --- a/goblint.opam +++ b/goblint.opam @@ -96,7 +96,7 @@ dev-repo: "git+https://github.com/goblint/analyzer.git" # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") pin-depends: [ - [ "goblint-cil.2.0.4" "git+https://github.com/goblint/cil.git#317e26d48b06d5cdc4acff3df1a6824587052b53" ] + [ "goblint-cil.2.0.4" "git+https://github.com/goblint/cil.git#04b8a45a7d20425c7b6c8abe1ad094abc063922b" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.locked b/goblint.opam.locked index c629aa6755..a4b9cf6677 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -139,7 +139,7 @@ post-messages: [ pin-depends: [ [ "goblint-cil.2.0.4" - "git+https://github.com/goblint/cil.git#317e26d48b06d5cdc4acff3df1a6824587052b53" + "git+https://github.com/goblint/cil.git#04b8a45a7d20425c7b6c8abe1ad094abc063922b" ] ] depexts: ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/goblint.opam.template b/goblint.opam.template index bb70aa29e7..9f29ceb7a5 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -2,7 +2,7 @@ # also remember to generate/adjust goblint.opam.locked! available: os-family != "bsd" & os-distribution != "alpine" & (arch != "arm64" | os = "macos") pin-depends: [ - [ "goblint-cil.2.0.4" "git+https://github.com/goblint/cil.git#317e26d48b06d5cdc4acff3df1a6824587052b53" ] + [ "goblint-cil.2.0.4" "git+https://github.com/goblint/cil.git#04b8a45a7d20425c7b6c8abe1ad094abc063922b" ] ] depexts: [ ["libgraph-easy-perl"] {os-distribution = "ubuntu" & with-test} diff --git a/src/cdomain/value/cdomains/mutexAttrDomain.ml b/src/cdomain/value/cdomains/mutexAttrDomain.ml index ea9696d26f..e12818c2c1 100644 --- a/src/cdomain/value/cdomains/mutexAttrDomain.ml +++ b/src/cdomain/value/cdomains/mutexAttrDomain.ml @@ -25,7 +25,7 @@ let recursive_int = lazy ( 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, _) -> + List.iter (fun (name, _, exp, _) -> if name = "PTHREAD_MUTEX_RECURSIVE" then res := Option.get @@ GoblintCil.getInteger exp ) einfo.eitems diff --git a/src/incremental/compareAST.ml b/src/incremental/compareAST.ml index 2449cdac47..b62cf28f2f 100644 --- a/src/incremental/compareAST.ml +++ b/src/incremental/compareAST.ml @@ -178,8 +178,8 @@ and eq_typ_acc ?(fun_parameter_name_comparison_enabled: bool = true) (a: typ) (b if Messages.tracing then Messages.traceu "compareast" "eq_typ_acc %a vs %a" d_type a d_type b; (r, updated_rename_mapping) -and eq_eitems (a: string * exp * location) (b: string * exp * location) ~(rename_mapping: rename_mapping) ~(acc: (typ * typ) list) = match a, b with - (name1, exp1, _l1), (name2, exp2, _l2) -> (name1 = name2, rename_mapping) &&>> eq_exp exp1 exp2 ~acc +and eq_eitems (a: string * attributes * exp * location) (b: string * attributes * exp * location) ~(rename_mapping: rename_mapping) ~(acc: (typ * typ) list) = match a, b with + (name1, attr1, exp1, _l1), (name2, attr2, exp2, _l2) -> (name1 = name2, rename_mapping) &&>> forward_list_equal (eq_attribute ~acc) attr1 attr2 &&>> eq_exp exp1 exp2 ~acc (* Ignore location *) and eq_enuminfo (a: enuminfo) (b: enuminfo) ~(rename_mapping: rename_mapping) ~(acc: (typ * typ) list) = diff --git a/src/witness/witnessUtil.ml b/src/witness/witnessUtil.ml index 5d22fd1e83..ffadaf14e5 100644 --- a/src/witness/witnessUtil.ml +++ b/src/witness/witnessUtil.ml @@ -209,7 +209,7 @@ struct let typ = TEnum (e, []) in let name = "enum " ^ ename in Hashtbl.replace genv name (Cabs2cil.EnvTyp typ, loc); - List.iter (fun (name, exp, loc) -> + List.iter (fun (name, _, exp, loc) -> Hashtbl.replace genv name (Cabs2cil.EnvEnum (exp, typ), loc) ) eitems | Cil.GVar (v, _, loc) From cf9d190c78d9ebac984ca068cc2c5acbb0ce75cd Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Fri, 16 Aug 2024 15:44:10 +0300 Subject: [PATCH 132/133] Fix base must-writing all invalidated variables set_many writes one after another, so they all end up in protection privatization's P set for example (although it cannot be observed by precision). Nevertheless, this is the morally correct thing to do: an unknown function may or may not write each argument. --- src/analyses/base.ml | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 4e523fe1ee..a69b3a2b23 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -2045,7 +2045,7 @@ struct List.map mpt exps ) - let invalidate ?(deep=true) ~ctx (st:store) (exps: exp list): store = + let invalidate ~(must: bool) ?(deep=true) ~ctx (st:store) (exps: exp list): store = if M.tracing && exps <> [] then M.tracel "invalidate" "Will invalidate expressions [%a]" (d_list ", " d_plainexp) exps; if exps <> [] then M.info ~category:Imprecise "Invalidating expressions: %a" (d_list ", " d_exp) exps; (* To invalidate a single address, we create a pair with its corresponding @@ -2072,7 +2072,15 @@ struct let vs = List.map (Tuple3.third) invalids' in M.tracel "invalidate" "Setting addresses [%a] to values [%a]" (d_list ", " AD.pretty) addrs (d_list ", " VD.pretty) vs ); - set_many ~ctx st invalids' + (* copied from set_many *) + let f (acc: store) ((lval:AD.t),(typ:Cil.typ),(value:value)): store = + let acc' = set ~ctx acc lval typ value in + if must then + acc' + else + D.join acc acc' + in + List.fold_left f st invalids' let make_entry ?(thread=false) (ctx:(D.t, G.t, C.t, V.t) Analyses.ctx) fundec args: D.t = @@ -2211,8 +2219,8 @@ struct in (* TODO: what about escaped local variables? *) (* invalidate arguments and non-static globals for unknown functions *) - let st' = invalidate ~deep:false ~ctx ctx.local shallow_addrs in - invalidate ~deep:true ~ctx st' deep_addrs + let st' = invalidate ~must:false ~deep:false ~ctx ctx.local shallow_addrs in + invalidate ~must:false ~deep:true ~ctx st' deep_addrs let check_invalid_mem_dealloc ctx special_fn ptr = let has_non_heap_var = AD.exists (function @@ -2302,7 +2310,7 @@ struct let invalidate_ret_lv st = match lv with | Some lv -> if M.tracing then M.tracel "invalidate" "Invalidating lhs %a for function call %s" d_plainlval lv f.vname; - invalidate ~deep:false ~ctx st [Cil.mkAddrOrStartOf lv] + invalidate ~must:true ~deep:false ~ctx st [Cil.mkAddrOrStartOf lv] | None -> st in let addr_type_of_exp exp = @@ -2636,14 +2644,14 @@ struct | Int n when GobOption.exists (Z.equal Z.zero) (ID.to_int n) -> st | Address ret_a -> begin match eval_rv ~ctx st id with - | Thread a when ValueDomain.Threads.is_top a -> invalidate ~ctx st [ret_var] + | Thread a when ValueDomain.Threads.is_top a -> invalidate ~must:true ~ctx st [ret_var] | 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 st ret_a (Cilfacade.typeOf ret_var) v - | _ -> invalidate ~ctx st [ret_var] + | _ -> invalidate ~must:true ~ctx st [ret_var] end - | _ -> invalidate ~ctx st [ret_var] + | _ -> invalidate ~must:true ~ctx st [ret_var] in let st' = invalidate_ret_lv st' in Priv.thread_join (Analyses.ask_of_ctx ctx) (priv_getg ctx.global) id st' From 3c54188f07c43816d016e95da96255a57e135e39 Mon Sep 17 00:00:00 2001 From: Karoliine Holter Date: Thu, 22 Aug 2024 16:15:29 +0300 Subject: [PATCH 133/133] Default location.byte to -1 if missing in JSON --- src/common/util/cilType.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/util/cilType.ml b/src/common/util/cilType.ml index 5a473b7d60..91368052b3 100644 --- a/src/common/util/cilType.ml +++ b/src/common/util/cilType.ml @@ -79,8 +79,8 @@ struct let of_yojson = function | `Assoc l -> - begin match List.assoc_opt "file" l, List.assoc_opt "line" l, List.assoc_opt "column" l, List.assoc_opt "byte" l with - | Some (`String file), Some (`Int line), Some (`Int column), Some (`Int byte) -> + begin match List.assoc_opt "file" l, List.assoc_opt "line" l, List.assoc_opt "column" l, Option.value ~default:(`Int (-1)) (List.assoc_opt "byte" l) with + | Some (`String file), Some (`Int line), Some (`Int column), `Int byte -> let loc = {file; line; column; byte; endLine = -1; endColumn = -1; endByte = -1; synthetic = false} in begin match List.assoc_opt "endLine" l, List.assoc_opt "endColumn" l, List.assoc_opt "endByte" l with | Some (`Int endLine), Some (`Int endColumn), Some (`Int endByte) ->