diff --git a/.github/workflows/coverage.yml b/.github/workflows/coverage.yml index 4b47a66e15c..5635ebbeea0 100644 --- a/.github/workflows/coverage.yml +++ b/.github/workflows/coverage.yml @@ -65,9 +65,6 @@ jobs: - name: Test apron regression (Mukherjee et. al SAS '17 paper') # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) run: ruby scripts/update_suite.rb group apron-mukherjee -s - - name: Test apron termination regression # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) - run: ruby scripts/update_suite.rb group termination -s - - name: Test regression cram run: opam exec -- dune runtest tests/regression @@ -88,7 +85,7 @@ jobs: COVERALLS_REPO_TOKEN: ${{ secrets.COVERALLS_REPO_TOKEN }} PULL_REQUEST_NUMBER: ${{ github.event.number }} - - uses: actions/upload-artifact@v4 + - uses: actions/upload-artifact@v3 if: always() with: name: suite_result diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml index 1d73e037f46..e1648904c3a 100644 --- a/.github/workflows/docs.yml +++ b/.github/workflows/docs.yml @@ -46,7 +46,7 @@ jobs: - name: Setup Pages id: pages - uses: actions/configure-pages@v4 + uses: actions/configure-pages@v3 - name: Install dependencies run: opam install . --deps-only --locked --with-doc @@ -68,4 +68,4 @@ jobs: steps: - name: Deploy to GitHub Pages id: deployment - uses: actions/deploy-pages@v3 + uses: actions/deploy-pages@v2 diff --git a/.github/workflows/locked.yml b/.github/workflows/locked.yml index e25ccfcea1a..007ea346192 100644 --- a/.github/workflows/locked.yml +++ b/.github/workflows/locked.yml @@ -64,9 +64,6 @@ jobs: - name: Test apron regression (Mukherjee et. al SAS '17 paper') # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) run: ruby scripts/update_suite.rb group apron-mukherjee -s - - name: Test apron termination regression # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) - run: ruby scripts/update_suite.rb group termination -s - - name: Test regression cram run: opam exec -- dune runtest tests/regression @@ -82,10 +79,10 @@ jobs: - name: Test incremental regression with cfg comparison run: ruby scripts/update_suite.rb -c - - uses: actions/upload-artifact@v4 + - uses: actions/upload-artifact@v3 if: always() with: - name: suite_result-${{ matrix.os }} + name: suite_result path: tests/suite_result/ extraction: @@ -156,7 +153,7 @@ jobs: ocaml-compiler: ${{ matrix.ocaml-compiler }} - name: Set up Node.js ${{ matrix.node-version }} - uses: actions/setup-node@v4 + uses: actions/setup-node@v3 with: node-version: ${{ matrix.node-version }} diff --git a/.github/workflows/metadata.yml b/.github/workflows/metadata.yml index 3a48d52fa00..1092606bc62 100644 --- a/.github/workflows/metadata.yml +++ b/.github/workflows/metadata.yml @@ -27,9 +27,6 @@ jobs: args: --validate zenodo-validate: - # Zenodo schema URL is dead - if: ${{ false }} - strategy: matrix: node-version: @@ -42,7 +39,7 @@ jobs: uses: actions/checkout@v4 - name: Set up Node.js ${{ matrix.node-version }} - uses: actions/setup-node@v4 + uses: actions/setup-node@v3 with: node-version: ${{ matrix.node-version }} diff --git a/.github/workflows/options.yml b/.github/workflows/options.yml index 7ef8b6929ee..40652791fa4 100644 --- a/.github/workflows/options.yml +++ b/.github/workflows/options.yml @@ -18,7 +18,7 @@ jobs: uses: actions/checkout@v4 - name: Set up Node.js ${{ matrix.node-version }} - uses: actions/setup-node@v4 + uses: actions/setup-node@v3 with: node-version: ${{ matrix.node-version }} @@ -26,10 +26,10 @@ jobs: run: npm install -g ajv-cli - name: Migrate schema # https://github.com/ajv-validator/ajv-cli/issues/199 - run: ajv migrate -s src/config/options.schema.json + run: ajv migrate -s src/common/util/options.schema.json - name: Validate conf - run: ajv validate -s src/config/options.schema.json -d "conf/**/*.json" + run: ajv validate -s src/common/util/options.schema.json -d "conf/**/*.json" - name: Validate incremental tests - run: ajv validate -s src/config/options.schema.json -d "tests/incremental/*/*.json" + run: ajv validate -s src/common/util/options.schema.json -d "tests/incremental/*/*.json" diff --git a/.github/workflows/semgrep.yml b/.github/workflows/semgrep.yml index c22eee51819..bd2dfd285cf 100644 --- a/.github/workflows/semgrep.yml +++ b/.github/workflows/semgrep.yml @@ -22,7 +22,7 @@ jobs: run: semgrep scan --config .semgrep/ --sarif > semgrep.sarif - name: Upload SARIF file to GitHub Advanced Security Dashboard - uses: github/codeql-action/upload-sarif@v3 + uses: github/codeql-action/upload-sarif@v2 with: sarif_file: semgrep.sarif if: always() diff --git a/.github/workflows/unlocked.yml b/.github/workflows/unlocked.yml index 57fa0cb6b53..6c23c7cdd49 100644 --- a/.github/workflows/unlocked.yml +++ b/.github/workflows/unlocked.yml @@ -92,10 +92,6 @@ jobs: if: ${{ matrix.apron }} run: ruby scripts/update_suite.rb group apron-mukherjee -s - - name: Test apron termination regression # skipped by default but CI has apron, so explicitly test group (which ignores skipping -- it's now a feature!) - if: ${{ matrix.apron }} - run: ruby scripts/update_suite.rb group termination -s - - name: Test regression cram run: opam exec -- dune runtest tests/regression @@ -160,8 +156,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.4) + run: opam install $(opam exec -- opam-0install --prefer-oldest goblint ocaml-variants.4.14.0+options ocaml-option-flambda) - name: Build run: ./make.sh nat diff --git a/.gitignore b/.gitignore index faf15136536..75bd23d36b6 100644 --- a/.gitignore +++ b/.gitignore @@ -29,6 +29,7 @@ linux-headers .goblint*/ goblint_temp_*/ +src/spec/graph .vagrant g2html.jar diff --git a/.gitmodules b/.gitmodules index 48504b54fd7..1efa6d2b553 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,3 +4,6 @@ [submodule "g2html"] path = g2html url = https://github.com/goblint/g2html.git +[submodule "gobview"] + path = gobview + url = https://github.com/goblint/gobview.git diff --git a/.mailmap b/.mailmap index 9aa2d0cc027..9153d557657 100644 --- a/.mailmap +++ b/.mailmap @@ -23,7 +23,6 @@ Kerem Çakırer Sarah Tilscher <66023521+stilscher@users.noreply.github.com> Karoliine Holter <44437975+karoliineh@users.noreply.github.com> - Elias Brandstetter <15275491+superbr4in@users.noreply.github.com> wherekonshade <80516286+Wherekonshade@users.noreply.github.com> @@ -38,6 +37,3 @@ Mireia Cano Pujol Felix Krayer Felix Krayer <91671586+FelixKrayer@users.noreply.github.com> Manuel Pietsch -Tim Ortel <100865202+TimOrtel@users.noreply.github.com> -Tomáš Dacík - <43824605+TDacik@users.noreply.github.com> diff --git a/.readthedocs.yaml b/.readthedocs.yaml index 22f9c861211..08044d195c9 100644 --- a/.readthedocs.yaml +++ b/.readthedocs.yaml @@ -20,4 +20,4 @@ build: - pip install json-schema-for-humans post_build: - mkdir _readthedocs/html/jsfh/ - - generate-schema-doc --config-file jsfh.yml src/config/options.schema.json _readthedocs/html/jsfh/ + - generate-schema-doc --config-file jsfh.yml src/common/util/options.schema.json _readthedocs/html/jsfh/ diff --git a/.zenodo.json b/.zenodo.json index 22705c2d9ce..5557622f9e5 100644 --- a/.zenodo.json +++ b/.zenodo.json @@ -10,18 +10,15 @@ }, { "name": "Schwarz, Michael", - "affiliation": "Technische Universität München", - "orcid": "0000-0002-9828-0308" + "affiliation": "Technische Universität München" }, { "name": "Erhard, Julian", - "affiliation": "Technische Universität München", - "orcid": "0000-0002-1729-3925" + "affiliation": "Technische Universität München" }, { "name": "Tilscher, Sarah", - "affiliation": "Technische Universität München", - "orcid": "0009-0009-9644-7475" + "affiliation": "Technische Universität München" }, { "name": "Vogler, Ralf", @@ -33,16 +30,14 @@ }, { "name": "Vojdani, Vesal", - "affiliation": "University of Tartu", - "orcid": "0000-0003-4336-7980" + "affiliation": "University of Tartu" } ], "contributors": [ { "name": "Seidl, Helmut", "type": "ProjectLeader", - "affiliation": "Technische Universität München", - "orcid": "0000-0002-2135-1593" + "affiliation": "Technische Universität München" }, { "name": "Schwarz, Martin D.", diff --git a/CHANGELOG.md b/CHANGELOG.md index d285480259c..97cc3991333 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,15 +1,3 @@ -## v2.3.0 -Functionally equivalent to Goblint in SV-COMP 2024. - -* Add termination analysis for loops (#1093). -* Add memory out-of-bounds analysis (#1094, #1197). -* Add memory leak analysis (#1127, #1241, #1246). -* Add SV-COMP `termination`, `valid-memsafety` and `valid-memcleanup` properties support (#1220, #1228, #1201, #1199, #1259, #1262). -* Add YAML witness version 2.0 support (#1238, #1240, #1217, #1226, #1225, #1248). -* Add final warnings about unsound results (#1190, #1191). -* Add many library function specifications (#1167, #1174, #1203, #1205, #1212, #1220, #1239, #1242, #1244, #1254, #1269). -* Adapt automatic configuration tuning (#912, #921, #987, #1168, #1214, #1234). - ## v2.2.1 * Bump batteries lower bound to 3.5.0. * Fix flaky dead code elimination transformation test. diff --git a/CITATION.cff b/CITATION.cff index 25d46cf7622..7a2dcf188d9 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -12,15 +12,12 @@ authors: # same authors as in .zenodo.json and dune-project - given-names: Michael family-names: Schwarz affiliation: "Technische Universität München" - orcid: "https://orcid.org/0000-0002-9828-0308" - given-names: Julian family-names: Erhard affiliation: "Technische Universität München" - orcid: "https://orcid.org/0000-0002-1729-3925" - given-names: Sarah family-names: Tilscher affiliation: "Technische Universität München" - orcid: "https://orcid.org/0009-0009-9644-7475" - given-names: Ralf family-names: Vogler affiliation: "Technische Universität München" @@ -30,7 +27,6 @@ authors: # same authors as in .zenodo.json and dune-project - given-names: Vesal family-names: Vojdani affiliation: "University of Tartu" - orcid: "https://orcid.org/0000-0003-4336-7980" license: MIT repository-code: "https://github.com/goblint/analyzer" diff --git a/conf/examples/very-precise.json b/conf/examples/very-precise.json index 2197335eaf4..84cbf53585f 100644 --- a/conf/examples/very-precise.json +++ b/conf/examples/very-precise.json @@ -61,9 +61,7 @@ "structs" : { "domain" : "combined-sk" }, - "strings": { - "domain": "disjoint" - } + "limit-string-addresses": false } }, "exp": { diff --git a/conf/ldv-races.json b/conf/ldv-races.json index a06a6da610a..01c60efc8d5 100644 --- a/conf/ldv-races.json +++ b/conf/ldv-races.json @@ -29,9 +29,7 @@ "escape", "expRelation", "mhp", - "assert", - "var_eq", - "symb_locks" + "assert" ], "malloc": { "wrappers": [ @@ -54,25 +52,9 @@ ] } }, - "lib": { - "activated": [ - "c", - "posix", - "pthread", - "gcc", - "glibc", - "linux-userspace", - "goblint", - "ncurses", - "klever" - ] - }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - } + "id": "enumerate", + "unknown": false }, "solver": "td3", "sem": { diff --git a/conf/min-unsound.json b/conf/min-unsound.json deleted file mode 100644 index 5195909ffb4..00000000000 --- a/conf/min-unsound.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "ana": { - "activated": [ - ] - } -} \ No newline at end of file diff --git a/conf/svcomp-yaml.json b/conf/svcomp-yaml.json index 10a977ff475..e09d1c80d7f 100644 --- a/conf/svcomp-yaml.json +++ b/conf/svcomp-yaml.json @@ -76,9 +76,7 @@ "region-offsets": true }, "witness": { - "graphml": { - "enabled": false - }, + "enabled": false, "yaml": { "enabled": true }, diff --git a/conf/svcomp.json b/conf/svcomp.json index 7e30554cebe..913d43784b2 100644 --- a/conf/svcomp.json +++ b/conf/svcomp.json @@ -32,15 +32,6 @@ "thread", "threadJoins" ], - "path_sens": [ - "mutex", - "malloc_null", - "uninit", - "expsplit", - "activeSetjmp", - "memLeak", - "threadflag" - ], "context": { "widen": false }, @@ -61,8 +52,7 @@ "ldv_xmalloc", "ldv_xzalloc", - "ldv_calloc", - "ldv_kzalloc" + "ldv_calloc" ] }, "base": { @@ -70,10 +60,6 @@ "domain": "partitioned" } }, - "race": { - "free": false, - "call": false - }, "autotune": { "enabled": true, "activated": [ @@ -84,10 +70,7 @@ "congruence", "octagon", "wideningThresholds", - "loopUnrollHeuristic", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" + "loopUnrollHeuristic" ] } }, @@ -107,38 +90,8 @@ } }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } + "id": "enumerate", + "unknown": false }, "pre": { "enabled": false diff --git a/conf/svcomp21.json b/conf/svcomp21.json index 2e36e61d0ce..a19bfdb9d00 100644 --- a/conf/svcomp21.json +++ b/conf/svcomp21.json @@ -64,9 +64,6 @@ } }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate" - } + "id": "enumerate" } } diff --git a/conf/svcomp22-intervals-novareq-affeq-apron.json b/conf/svcomp22-intervals-novareq-affeq-apron.json index f7f7662b6a1..7f72f5d0d81 100644 --- a/conf/svcomp22-intervals-novareq-affeq-apron.json +++ b/conf/svcomp22-intervals-novareq-affeq-apron.json @@ -68,10 +68,7 @@ } }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - } + "id": "enumerate", + "unknown": false } } \ No newline at end of file diff --git a/conf/svcomp22-intervals-novareq-affeq-native.json b/conf/svcomp22-intervals-novareq-affeq-native.json index 00db00f30fd..3ae1b197889 100644 --- a/conf/svcomp22-intervals-novareq-affeq-native.json +++ b/conf/svcomp22-intervals-novareq-affeq-native.json @@ -65,10 +65,7 @@ } }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - } + "id": "enumerate", + "unknown": false } } diff --git a/conf/svcomp22-intervals-novareq-octagon-apron.json b/conf/svcomp22-intervals-novareq-octagon-apron.json index a0c09e8937e..3bf149800e6 100644 --- a/conf/svcomp22-intervals-novareq-octagon-apron.json +++ b/conf/svcomp22-intervals-novareq-octagon-apron.json @@ -68,10 +68,7 @@ } }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - } + "id": "enumerate", + "unknown": false } } diff --git a/conf/svcomp22-intervals-novareq-polyhedra-apron.json b/conf/svcomp22-intervals-novareq-polyhedra-apron.json index 3a478bf687f..e4e513415ab 100644 --- a/conf/svcomp22-intervals-novareq-polyhedra-apron.json +++ b/conf/svcomp22-intervals-novareq-polyhedra-apron.json @@ -68,10 +68,7 @@ } }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - } + "id": "enumerate", + "unknown": false } } diff --git a/conf/svcomp22.json b/conf/svcomp22.json index 316c3c5534f..85ea6933757 100644 --- a/conf/svcomp22.json +++ b/conf/svcomp22.json @@ -67,10 +67,7 @@ } }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - } + "id": "enumerate", + "unknown": false } } diff --git a/conf/svcomp23.json b/conf/svcomp23.json index af584f1593a..56474fbe2b3 100644 --- a/conf/svcomp23.json +++ b/conf/svcomp23.json @@ -90,10 +90,7 @@ } }, "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - } + "id": "enumerate", + "unknown": false } } diff --git a/conf/svcomp24-validate.json b/conf/svcomp24-validate.json deleted file mode 100644 index 7832ffa6af7..00000000000 --- a/conf/svcomp24-validate.json +++ /dev/null @@ -1,140 +0,0 @@ -{ - "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", - "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" - ], - "invariant-types": [ - "location_invariant", - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": true, - "other": true - } - }, - "pre": { - "enabled": false - } -} diff --git a/conf/svcomp24.json b/conf/svcomp24.json deleted file mode 100644 index 7e30554cebe..00000000000 --- a/conf/svcomp24.json +++ /dev/null @@ -1,146 +0,0 @@ -{ - "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" - ], - "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" - ] - } - }, - "exp": { - "region-offsets": true - }, - "solver": "td3", - "sem": { - "unknown_function": { - "spawn": false - }, - "int": { - "signed_overflow": "assume_none" - }, - "null-pointer": { - "dereference": "assume_none" - } - }, - "witness": { - "graphml": { - "enabled": true, - "id": "enumerate", - "unknown": false - }, - "yaml": { - "enabled": true, - "format-version": "2.0", - "entry-types": [ - "invariant_set" - ], - "invariant-types": [ - "loop_invariant" - ] - }, - "invariant": { - "loop-head": true, - "after-lock": false, - "other": false, - "accessed": false, - "exact": true, - "exclude-vars": [ - "tmp\\(___[0-9]+\\)?", - "cond", - "RETURN", - "__\\(cil_\\)?tmp_?[0-9]*\\(_[0-9]+\\)?", - ".*____CPAchecker_TMP_[0-9]+", - "__VERIFIER_assert__cond", - "__ksymtab_.*", - "\\(ldv_state_variable\\|ldv_timer_state\\|ldv_timer_list\\|ldv_irq_\\(line_\\|data_\\)?[0-9]+\\|ldv_retval\\)_[0-9]+" - ] - } - }, - "pre": { - "enabled": false - } -} diff --git a/docs/developer-guide/debugging.md b/docs/developer-guide/debugging.md index d218e1a8b8d..7875a9b01ed 100644 --- a/docs/developer-guide/debugging.md +++ b/docs/developer-guide/debugging.md @@ -60,14 +60,14 @@ This will create a file called `goblint.byte`. ### Debugging Goblint with VS Code To debug OCaml programs, you can use the command line interface of `ocamldebug` or make use of the Visual Studio Code -integration provided by `ocamllabs.ocaml-platform`. +integration provided by `hackwaly.ocamlearlybird`. In the following, we describe the steps necessary to set up this VS Code extension to debug Goblint. ### Setting-up Earlybird -Install the [`ocamllabs.ocaml-platform` extension](https://marketplace.visualstudio.com/items?itemName=ocamllabs.ocaml-platform) in your installation of Visual Studio Code. -To be able to use this extension, you additionally need to install `earlybird` on the opam switch you use for Goblint. +Install the [`hackwaly.ocamlearlybird` extension](https://marketplace.visualstudio.com/items?itemName=hackwaly.ocamlearlybird) in your installation of Visual Studio Code. +To be able to use this extension, you additionally need to install `ocamlearlybird` on the opam switch you use for Goblint. To do so, run the following command in the `analyzer` directory: ```console @@ -76,7 +76,7 @@ opam install earlybird ### Providing a Launch Configuration -To let the `ocamllabs.ocaml-platform` extension know which executable it should debug, and which arguments it should pass, we have to provide a configuration file. +To let the `hackwaly.ocamlearlybird` extension know which executable it should debug, and which arguments it should pass, we have to provide a configuration file. The configuration file has to be named `launch.json` and must reside in the `./.vscode` directory. Here is an example `launch.json`: ```JSON @@ -85,23 +85,19 @@ The configuration file has to be named `launch.json` and must reside in the `./. "configurations": [ { "name": "Goblint", - "type": "ocaml.earlybird", + "type": "ocamlearlybird", "request": "launch", "program": "${workspaceFolder}/goblint.byte", "arguments": [ "tests/regression/00-sanity/01-assert.c", "--enable", "ana.int.interval", ], - "env": { - "LD_LIBRARY_PATH": "$LD_LIBRARY_PATH:_build/default/src/common" - }, "stopOnEntry": false, } ] } ``` -Note that the individual arguments to Goblint should be passed here as separate strings that do not contain spaces. Finally, to enable breakpoints uncomment `(map_workspace_root false)` in the dune-project file. - +Note that the individual arguments to Goblint should be passed here as separate strings that do not contain spaces. ### Running Goblint in the VS Code Debugger diff --git a/docs/developer-guide/firstanalysis.md b/docs/developer-guide/firstanalysis.md index 4eb35e7f5d6..0923e792cd5 100644 --- a/docs/developer-guide/firstanalysis.md +++ b/docs/developer-guide/firstanalysis.md @@ -67,7 +67,7 @@ The key part now is to define transfer functions for assignment. We only handle There is no need to implement the transfer functions for branching for this example; it only relies on lattice join operations to correctly take both paths into account. The assignment relies on the function `eval`, which is almost there. It just needs you to fix the evaluation of constants! Unless you jumped straight to this line, it should not be too complicated to fix this. -With this in place, we should have sufficient information to tell Goblint that the assertion does hold (run `make` to compile the updated analysis in Goblint). +With this in place, we should have sufficient information to tell Goblint that the assertion does hold. For more information on the signature of the individual transfer functions, please check out `module type Spec` documentation in [`src/framework/analyses.ml`](https://github.com/goblint/analyzer/blob/master/src/framework/analyses.ml). diff --git a/docs/developer-guide/messaging.md b/docs/developer-guide/messaging.md index 91fba82b51e..28f24bc49cf 100644 --- a/docs/developer-guide/messaging.md +++ b/docs/developer-guide/messaging.md @@ -18,8 +18,7 @@ A message consists of the following: 3. **Context.** Optional. Currently completely abstract, so not very useful. * **Group.** For messages related to numerous locations with different texts. Contains the following: 1. **Group text.** An overall description of the group message. - 2. **Group location.** Optional. An overall location of the group message. - 3. **Pieces.** A list of single messages as described above. + 2. **Pieces.** A list of single messages as described above. ## Creating @@ -48,3 +47,16 @@ The `~loc` argument is optional and defaults to the current location, but allows The `_noloc` suffixed functions allow general messages without any location (not even current). By convention, may-warnings (the usual case) should use warning severity and must-warnings should use error severity. + +### Spec analysis + +Warnings inside `.spec` files are converted to warnings. +They parsed from string warnings: the first space-delimited substring determines the category and the rest determines the text. + +For example: +``` +w1 "behavior.undefined.use_after_free" +w2 "integer.overflow" +w3 "unknown my message" +w4 "integer.overflow some text describing the warning" +``` diff --git a/docs/developer-guide/releasing.md b/docs/developer-guide/releasing.md index d875c0d3bf0..69ffcb2461d 100644 --- a/docs/developer-guide/releasing.md +++ b/docs/developer-guide/releasing.md @@ -37,11 +37,13 @@ 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. + 5. Pin package from distribution archive: `opam pin add --no-action .`. + 6. Install depexts: `opam depext --with-test goblint`. + 7. Install and test package: `opam install --with-test goblint`. + 8. Activate opam environment: `eval $(opam env)`. + 9. Check version: `goblint --version`. + 10. Check that analysis works: `goblint -v tests/regression/04-mutex/01-simple_rc.c`. + 11. Exit Docker container. 12. Temporarily enable Zenodo GitHub webhook. @@ -57,7 +59,6 @@ 15. Create an opam package: `dune-release opam pkg`. 16. Submit the opam package to opam-repository: `dune-release opam submit`. -17. Revert temporary removal of opam pins. ## SV-COMP @@ -70,7 +71,7 @@ This is required such that the created archive would have everything in a single directory called `goblint`. -4. Update SV-COMP year in `scripts/sv-comp/archive.sh`. +4. Update SV-COMP year in `sv-comp/archive.sh`. This includes: git tag name, git tag message and zipped conf file. @@ -83,9 +84,9 @@ 2. Make sure you have nothing valuable that would be deleted by `make clean`. 3. Delete git tag from previous prerun: `git tag -d svcompXY`. -4. Create archive: `./scripts/sv-comp/archive.sh`. +4. Create archive: `./sv-comp/archive.sh`. - The resulting archive is `scripts/sv-comp/goblint.zip`. + The resulting archive is `sv-comp/goblint.zip`. 5. Check unextracted archive in latest SV-COMP container image: . @@ -96,17 +97,16 @@ This ensures that the environment and the archive have all the correct system libraries. -6. Create (or add new version) Zenodo artifact and upload the archive. +6. Commit and push the archive to an SV-COMP archives repository branch (but don't open a MR yet): (SV-COMP 2023). +7. Check pushed archive via CoveriTeam-Remote: . -7. Open MR with Zenodo version DOI to the [fm-tools](https://gitlab.com/sosy-lab/benchmarking/fm-tools) repository. + 1. Clone coveriteam repository. + 2. Locally modify `actors/goblint.yml` archive location to the raw URL of the pushed archive. + 3. Run Goblint on some sv-benchmarks and properties via CoveriTeam. - +8. Open MR to the SV-COMP archives repository. ### After all preruns diff --git a/docs/requirements.txt b/docs/requirements.txt index c86e84d8e82..3904834c2ec 100644 --- a/docs/requirements.txt +++ b/docs/requirements.txt @@ -1,5 +1,6 @@ # Python requirements for MkDocs and Read the Docs -mkdocs==1.2.4 +mkdocs==1.2.3 -jinja2==3.1.3 +# TODO: temporary workaround for deprecated usage (https://github.com/mkdocs/mkdocs/issues/2794#issuecomment-1077705509) +jinja2==3.0.3 diff --git a/docs/user-guide/configuring.md b/docs/user-guide/configuring.md index cae57fc8cd9..9a32a14a4cd 100644 --- a/docs/user-guide/configuring.md +++ b/docs/user-guide/configuring.md @@ -24,7 +24,7 @@ In `.vscode/settings.json` add the following: "/conf/*.json", "/tests/incremental/*/*.json" ], - "url": "/src/config/options.schema.json" + "url": "/src/common/util/options.schema.json" } ] } diff --git a/docs/user-guide/inspecting.md b/docs/user-guide/inspecting.md index 266a4866c64..f4f6036f1b3 100644 --- a/docs/user-guide/inspecting.md +++ b/docs/user-guide/inspecting.md @@ -23,20 +23,3 @@ To build GobView (also for development): `./_build/default/gobview/goblint-http-server/goblint_http.exe -with-goblint ../analyzer/goblint -goblint --set files[+] "../analyzer/tests/regression/00-sanity/01-assert.c"` 4. Visit - -## Witnesses - -### GraphML - -#### yEd - -1. Open (Ctrl+o) `witness.graphml` from Goblint root directory. -2. Click menu "Edit" → "Properties Mapper". - 1. _First time:_ Click button "Imports additional configurations" and open `scripts/sv-comp/yed-sv-comp.cnfx`. - 2. Select "SV-COMP (Node)" and click "Apply". - 3. Select "SV-COMP (Edge)" and click "Ok". -3. Click menu "Layout" → "Hierarchial" (Alt+shift+h). - 1. _First time:_ Click tab "Labeling", select "Hierarchic" in "Edge Labeling". - 2. Click "Ok". - -yEd manual for the Properties Mapper: . diff --git a/docs/user-guide/running.md b/docs/user-guide/running.md index aac1c21ca6d..97d2587be8d 100644 --- a/docs/user-guide/running.md +++ b/docs/user-guide/running.md @@ -67,20 +67,3 @@ Here is a list of issues and workarounds for different compilation database gene #### bear 1. Bear 2.3.11 from Ubuntu 18.04 produces incomplete database (, ). * Bear 3.0.8 seems fine. - - -## SV-COMP -The most up-to-date SV-COMP configuration is in `conf/svcomp.json`. -There are also per-year configurations (e.g. `conf/svcomp24.json`) which try to reflect that year's submission using current option names. -Due to unconfigurable changes (e.g. bug fixes) these do not _exactly_ behave as that year's submission. -See SV-COMP submissions in GitHub releases for exact submitted versions. - -In SV-COMP Goblint is run as follows: -```console -./goblint --conf conf/svcomp.json --set ana.specification property.prp --set exp.architecture {32bit,64bit} input.c -``` - -Goblint YAML correctness witness validator is run as: -```console -./goblint --conf conf/svcomp.json --set ana.specification property.prp --set exp.architecture {32bit,64bit} --set witness.yaml.unassume witness.yml --set witness.yaml.validate witness.yml input.c -``` diff --git a/dune-project b/dune-project index de6e955e609..4a9cd8e3c1d 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 3.7) +(lang dune 3.6) (using dune_site 0.1) (cram enable) (name goblint) @@ -16,7 +16,7 @@ (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 -(maintainers "Simmo Saan " "Michael Schwarz " "Karoliine Holter") +(maintainers "Simmo Saan " "Michael Schwarz ") (license MIT) (package @@ -24,8 +24,8 @@ (synopsis "Static analysis framework for C") (depends (ocaml (>= 4.10)) - (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. - (batteries (>= 3.5.1)) + (goblint-cil (>= 2.0.2)) ; 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.0)) (zarith (>= 1.8)) (yojson (>= 2.0.0)) (qcheck-core (>= 0.19)) @@ -64,5 +64,3 @@ (share lib) (share conf)) ) - -; (map_workspace_root false) ;uncomment to enable breakpoints diff --git a/goblint.opam b/goblint.opam index 7a75a1fb453..bf51924626f 100644 --- a/goblint.opam +++ b/goblint.opam @@ -4,7 +4,6 @@ synopsis: "Static analysis framework for C" maintainer: [ "Simmo Saan " "Michael Schwarz " - "Karoliine Holter" ] authors: [ "Simmo Saan" @@ -20,10 +19,10 @@ homepage: "https://goblint.in.tum.de" doc: "https://goblint.readthedocs.io/en/latest/" bug-reports: "https://github.com/goblint/analyzer/issues" depends: [ - "dune" {>= "3.7"} + "dune" {>= "3.6"} "ocaml" {>= "4.10"} - "goblint-cil" {>= "2.0.3"} - "batteries" {>= "3.5.1"} + "goblint-cil" {>= "2.0.2"} + "batteries" {>= "3.5.0"} "zarith" {>= "1.8"} "yojson" {>= "2.0.0"} "qcheck-core" {>= "0.19"} @@ -76,8 +75,7 @@ dev-repo: "git+https://github.com/goblint/analyzer.git" # also remember to generate/adjust goblint.opam.locked! 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#d2760bacfbfdb25a374254de44f2ff1cb5f42abd" ] + [ "goblint-cil.2.0.2" "git+https://github.com/goblint/cil.git#c7ffc37ad83216a84d90fdbf427cc02a68ea5331" ] # 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" ] ] diff --git a/goblint.opam.locked b/goblint.opam.locked index b0a1c9ef203..2744d2fe925 100644 --- a/goblint.opam.locked +++ b/goblint.opam.locked @@ -5,7 +5,6 @@ synopsis: "Static analysis framework for C" maintainer: [ "Simmo Saan " "Michael Schwarz " - "Karoliine Holter" ] authors: [ "Simmo Saan" @@ -51,16 +50,16 @@ depends: [ "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"} + "dune" {= "3.6.1"} + "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"} "fileutils" {= "0.6.4"} "fmt" {= "0.9.0"} "fpath" {= "0.7.3"} - "goblint-cil" {= "2.0.3"} + "goblint-cil" {= "2.0.2"} "integers" {= "0.7.0"} "json-data-encoding" {= "0.12.1"} "jsonrpc" {= "1.15.0~5.0preview1"} @@ -77,7 +76,7 @@ depends: [ "ocamlfind" {= "1.9.5"} "odoc" {= "2.2.0" & with-doc} "odoc-parser" {= "2.0.0" & with-doc} - "ordering" {= "3.7.1"} + "ordering" {= "3.6.1"} "ounit2" {= "2.2.6" & with-test} "pp" {= "1.1.2"} "ppx_derivers" {= "1.2.1"} @@ -94,7 +93,7 @@ depends: [ "sexplib0" {= "v0.15.1"} "sha" {= "1.15.2"} "stdlib-shims" {= "0.3.0"} - "stdune" {= "3.7.1"} + "stdune" {= "3.6.1"} "stringext" {= "1.6.0"} "topkg" {= "1.0.6"} "tyxml" {= "4.5.0" & with-doc} @@ -131,6 +130,10 @@ post-messages: [ ] # TODO: manually reordered to avoid opam pin crash: https://github.com/ocaml/opam/issues/4936 pin-depends: [ + [ + "goblint-cil.2.0.2" + "git+https://github.com/goblint/cil.git#c7ffc37ad83216a84d90fdbf427cc02a68ea5331" + ] [ "ppx_deriving.5.2.1" "git+https://github.com/ocaml-ppx/ppx_deriving.git#0a89b619f94cbbfc3b0fb3255ab4fe5bc77d32d6" diff --git a/goblint.opam.template b/goblint.opam.template index ca2796b3c73..d8e25cde38b 100644 --- a/goblint.opam.template +++ b/goblint.opam.template @@ -2,8 +2,7 @@ # also remember to generate/adjust goblint.opam.locked! 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#d2760bacfbfdb25a374254de44f2ff1cb5f42abd" ] + [ "goblint-cil.2.0.2" "git+https://github.com/goblint/cil.git#c7ffc37ad83216a84d90fdbf427cc02a68ea5331" ] # 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" ] ] diff --git a/lib/goblint/runtime/include/goblint.h b/lib/goblint/runtime/include/goblint.h index af87035d338..b0af41616e4 100644 --- a/lib/goblint/runtime/include/goblint.h +++ b/lib/goblint/runtime/include/goblint.h @@ -6,5 +6,3 @@ void __goblint_assume_join(/* pthread_t thread */); // undeclared argument to av void __goblint_split_begin(int exp); void __goblint_split_end(int exp); - -void __goblint_bounded(unsigned long long exp); \ No newline at end of file diff --git a/lib/goblint/runtime/src/goblint.c b/lib/goblint/runtime/src/goblint.c index cbcb7cf505e..bc176f93a6a 100644 --- a/lib/goblint/runtime/src/goblint.c +++ b/lib/goblint/runtime/src/goblint.c @@ -27,8 +27,4 @@ void __goblint_split_begin(int exp) { void __goblint_split_end(int exp) { -} - -void __goblint_bounded(unsigned long long exp) { - } \ No newline at end of file diff --git a/scripts/goblint-lib-modules.py b/scripts/goblint-lib-modules.py index fc6d33b421a..5f022716162 100755 --- a/scripts/goblint-lib-modules.py +++ b/scripts/goblint-lib-modules.py @@ -8,7 +8,6 @@ goblint_lib_paths = [ src_root_path / "goblint_lib.ml", - src_root_path / "solver" / "goblint_solver.ml", src_root_path / "util" / "std" / "goblint_std.ml", ] goblint_lib_modules = set() @@ -31,19 +30,20 @@ "MessagesCompare", "PrivPrecCompare", "ApronPrecCompare", + "Mainspec", # libraries "Goblint_std", - "Goblint_solver", "Goblint_timing", "Goblint_backtrace", - "Goblint_tracing", "Goblint_sites", "Goblint_build_info", "Dune_build_info", "MessageCategory", # included in Messages "PreValueDomain", # included in ValueDomain + "SpecCore", # spec stuff + "SpecUtil", # spec stuff "ConfigVersion", "ConfigProfile", @@ -65,5 +65,5 @@ missing_modules = src_modules - goblint_lib_modules if len(missing_modules) > 0: - print(f"Modules missing from {goblint_lib_paths[0]}: {missing_modules}") + print(f"Modules missing from {goblint_lib_path}: {missing_modules}") sys.exit(1) diff --git a/scripts/regression2sv-benchmarks.py b/scripts/regression2sv-benchmarks.py index 7bcc1c7ea3e..8f74a70f527 100755 --- a/scripts/regression2sv-benchmarks.py +++ b/scripts/regression2sv-benchmarks.py @@ -31,6 +31,7 @@ "09-regions_34-escape_rc", # duplicate of 04/45 "09-regions_35-list2_rc-offsets-thread", # duplicate of 09/03 "10-synch_17-glob_fld_nr", # duplicate of 05/08 + "19-spec_02-mutex_rc", # duplicate of 04/01 "29-svcomp_01-race-2_3b-container_of", # duplicate sv-benchmarks "29-svcomp_01-race-2_4b-container_of", # duplicate sv-benchmarks diff --git a/scripts/spec/check.sh b/scripts/spec/check.sh new file mode 100755 index 00000000000..57b63edfd26 --- /dev/null +++ b/scripts/spec/check.sh @@ -0,0 +1,27 @@ +export OCAMLRUNPARAM=b +# file to analyze +file=${1-"tests/file.c"} +# analysis to run or spec file +ana=${2-"tests/regression/18-file/file.optimistic.spec"} +debug=${debug-"true"} +if [ $ana == "file" ]; then + ana="file" + opt="--set ana.file.optimistic true" +else + spec=$ana + ana="spec" + opt="--set ana.spec.file $spec" +fi +cmd="./goblint --set ana.activated[0][+] $ana $opt --html --set warn.debug $debug $file" +echo -e "$(tput setaf 6)$cmd$(tput sgr 0)" +$cmd + + +# # focuses Firefox and reloads current tab +# if false && command -v xdotool >/dev/null 2>&1; then +# WID=`xdotool search --name "Mozilla Firefox" | head -1` +# xdotool windowactivate $WID +# #xdotool key F5 +# # reload is done by add-on Auto Reload (reload result/* on change of report.html) +# # https://addons.mozilla.org/en-US/firefox/addon/auto-reload/?src=api +# fi diff --git a/scripts/spec/regression.py b/scripts/spec/regression.py new file mode 100755 index 00000000000..dc9f9fa276a --- /dev/null +++ b/scripts/spec/regression.py @@ -0,0 +1,61 @@ +# import fileinput +# for line in fileinput.input(): +# pass + +import sys, os +import re + +if len(sys.argv) != 2: + print("Stdin: output from goblint, 1. argument: C source-file") + sys.exit(1) +path = sys.argv[1] + +goblint = {} +for line in sys.stdin.readlines(): + line = re.sub(r"\033.*?m", "", line) + m = re.match(r"(.+) \("+re.escape(path)+":(.+)\)", line) + if m: goblint[int(m.group(2))] = m.group(1) + +source = {} +lines = open(path).readlines() +for i,line in zip(range(1, len(lines)+1), lines): + m = re.match(r".+ // WARN: (.+)", line) + if m: source[i] = m.group(1) + +diff = {}; +for k,v in sorted(set.union(set(goblint.items()), set(source.items()))): + if k in diff: continue + if k in goblint and k in source and goblint[k]!=source[k]: + diff[k] = ('D', [goblint[k], source[k]]) + elif (k,v) in goblint.items() and (k,v) not in source.items(): + diff[k] = ('G', [goblint[k]]) + elif (k,v) not in goblint.items() and (k,v) in source.items(): + diff[k] = ('S', [source[k]]) + +if not len(diff): + sys.exit(0) + +print("#"*50) +print(path) +print("file://"+os.getcwd()+"/result/"+os.path.basename(path)+".html") + +if len(goblint): + print("## Goblint warnings:") + for k,v in sorted(goblint.items()): + print("{} \t {}".format(k, v)) + print + +if len(source): + print("## Source warnings:") + for k,v in source.items(): + print("{} \t {}".format(k, v)) + print + +if len(diff): + print("## Diff (G..only goblint, S..only source, D..different):") + for k,(s,v) in sorted(diff.items()): + print("{} {} \t {}".format(s, k, v[0])) + for v in v[1:]: print("\t {}".format(v)) + +print +sys.exit(1) \ No newline at end of file diff --git a/scripts/spec/regression.sh b/scripts/spec/regression.sh new file mode 100755 index 00000000000..6dc740ca75f --- /dev/null +++ b/scripts/spec/regression.sh @@ -0,0 +1,18 @@ +debug_tmp=$debug +export debug=false # temporarily disable debug output +n=0 +c=0 +dir=${2-"tests/regression/18-file"} +for f in $dir/*.c; do + ./scripts/spec/check.sh $f ${1-"file"} 2>/dev/null | python scripts/spec/regression.py $f && ((c++)) + ((n++)) +done +debug=$debug_tmp +msg="passed $c/$n tests" +echo $msg +if [ $c -eq $n ]; then + exit 0 +else + notify-send -i stop "$msg" + exit 1 +fi diff --git a/scripts/spec/spec.sh b/scripts/spec/spec.sh new file mode 100755 index 00000000000..03abe9a0c7d --- /dev/null +++ b/scripts/spec/spec.sh @@ -0,0 +1,10 @@ +# print all states the parser goes through +#export OCAMLRUNPARAM='p' +bin=src/mainspec.native +spec=${1-"tests/regression/18-file/file.spec"} +ocamlbuild -yaccflag -v -X webapp -no-links -use-ocamlfind $bin \ + && (./_build/$bin $spec \ + || (echo "$spec failed, running interactive now..."; + rlwrap ./_build/$bin + ) + ) diff --git a/scripts/update_suite.rb b/scripts/update_suite.rb index 2722b3ddb54..ca408a513a6 100755 --- a/scripts/update_suite.rb +++ b/scripts/update_suite.rb @@ -145,11 +145,10 @@ def collect_warnings @vars = $1 @evals = $2 end - if l =~ /\[Termination\]/ then warnings[-1] = "nonterm" end # Get Termination warning next unless l =~ /(.*)\(.*?\:(\d+)(?:\:\d+)?(?:-(?:\d+)(?:\:\d+)?)?\)/ obj,i = $1,$2.to_i - ranking = ["other", "warn", "goto", "fundec", "loop", "term", "nonterm", "race", "norace", "deadlock", "nodeadlock", "success", "fail", "unknown"] + ranking = ["other", "warn", "race", "norace", "deadlock", "nodeadlock", "success", "fail", "unknown"] thiswarn = case obj when /\(conf\. \d+\)/ then "race" when /Deadlock/ then "deadlock" @@ -160,9 +159,6 @@ def collect_warnings when /invariant confirmed/ then "success" when /invariant unconfirmed/ then "unknown" when /invariant refuted/ then "fail" - when /(Upjumping Goto)/ then "goto" - when /(Fundec \w+ is contained in a call graph cycle)/ then "fundec" - when /(Loop analysis)/ then "loop" when /^\[Warning\]/ then "warn" when /^\[Error\]/ then "warn" when /^\[Info\]/ then "warn" @@ -187,33 +183,19 @@ def compare_warnings if cond then @correct += 1 # full p.path is too long and p.name does not allow click to open in terminal - if todo.include? idx - if idx < 0 - puts "Excellent: ignored check on #{relpath(p.path).to_s.cyan} for #{type.yellow} is now passing!" - else - puts "Excellent: ignored check on #{relpath(p.path).to_s.cyan}:#{idx.to_s.blue} is now passing!" - end - end + if todo.include? idx then puts "Excellent: ignored check on #{relpath(p.path).to_s.cyan}:#{idx.to_s.blue} is now passing!" end else - if todo.include? idx - @ignored += 1 - else - if idx < 0 # When non line specific keywords were used don't print a line - puts "Expected #{type.yellow}, but registered #{(warnings[idx] or "nothing").yellow} on #{p.name.cyan}" - else - puts "Expected #{type.yellow}, but registered #{(warnings[idx] or "nothing").yellow} on #{p.name.cyan}:#{idx.to_s.blue}" - puts tests_line[idx].rstrip.gray - ferr = idx if ferr.nil? or idx < ferr - end + if todo.include? idx then @ignored += 1 else + puts "Expected #{type.yellow}, but registered #{(warnings[idx] or "nothing").yellow} on #{p.name.cyan}:#{idx.to_s.blue}" + puts tests_line[idx].rstrip.gray + ferr = idx if ferr.nil? or idx < ferr end end } case type - when "goto", "fundec", "loop", "deadlock", "race", "fail", "unknown", "warn" - check.call warnings[idx] == type - when "nonterm" + when "deadlock", "race", "fail", "unknown", "warn" check.call warnings[idx] == type - when "nowarn", "term" + when "nowarn" check.call warnings[idx].nil? when "assert", "success" check.call warnings[idx] == "success" @@ -312,12 +294,6 @@ def parse_tests (lines) tests[i] = "success" elsif obj =~ /FAIL/ then tests[i] = "fail" - elsif obj =~ /NONTERMLOOP/ then - tests[i] = "loop" - elsif obj =~ /NONTERMGOTO/ then - tests[i] = "goto" - elsif obj =~ /NONTERMFUNDEC/ then - tests[i] = "fundec" elsif obj =~ /UNKNOWN/ then tests[i] = "unknown" elsif obj =~ /(assert|__goblint_check).*\(/ then @@ -330,15 +306,6 @@ def parse_tests (lines) end end end - case lines[0] - when /NONTERM/ - tests[-1] = "nonterm" - when /TERM/ - tests[-1] = "term" - end - if lines[0] =~ /TODO/ then - todo << -1 - end Tests.new(self, tests, tests_line, todo) end diff --git a/src/analyses/abortUnless.ml b/src/analyses/abortUnless.ml index ee4db698202..813d999ac30 100644 --- a/src/analyses/abortUnless.ml +++ b/src/analyses/abortUnless.ml @@ -65,8 +65,8 @@ struct false let startstate v = false - let threadenter ctx ~multiple lval f args = [false] - let threadspawn ctx ~multiple lval f args fctx = false + let threadenter ctx lval f args = [false] + let threadspawn ctx lval f args fctx = false let exitstate v = false end diff --git a/src/analyses/accessAnalysis.ml b/src/analyses/accessAnalysis.ml index efad8b4c2e2..e99aefa0e5f 100644 --- a/src/analyses/accessAnalysis.ml +++ b/src/analyses/accessAnalysis.ml @@ -29,7 +29,7 @@ struct let init _ = collect_local := get_bool "witness.yaml.enabled" && get_bool "witness.invariant.accessed"; let activated = get_string_list "ana.activated" in - emit_single_threaded := List.mem (ModifiedSinceSetjmp.Spec.name ()) activated || List.mem (PoisonVariables.Spec.name ()) activated + emit_single_threaded := List.mem (ModifiedSinceLongjmp.Spec.name ()) activated || List.mem (PoisonVariables.Spec.name ()) activated let do_access (ctx: (D.t, G.t, C.t, V.t) ctx) (kind:AccessKind.t) (reach:bool) (e:exp) = if M.tracing then M.trace "access" "do_access %a %a %B\n" d_exp e AccessKind.pretty kind reach; @@ -54,7 +54,7 @@ struct (** We just lift start state, global and dependency functions: *) let startstate v = () - let threadenter ctx ~multiple lval f args = [()] + let threadenter ctx lval f args = [()] let exitstate v = () let context fd d = () @@ -121,7 +121,7 @@ struct ctx.local - let threadspawn ctx ~multiple lval f args fctx = + let threadspawn ctx lval f args fctx = (* must explicitly access thread ID lval because special to pthread_create doesn't if singlethreaded before *) begin match lval with | None -> () diff --git a/src/analyses/activeLongjmp.ml b/src/analyses/activeLongjmp.ml index 9baa601ddc6..9c9868e32fb 100644 --- a/src/analyses/activeLongjmp.ml +++ b/src/analyses/activeLongjmp.ml @@ -26,7 +26,7 @@ struct (* Initial values don't really matter: overwritten at longjmp call. *) let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.bot ()] + let threadenter ctx lval f args = [D.bot ()] let exitstate v = D.top () let query ctx (type a) (q: a Queries.t): a Queries.result = diff --git a/src/analyses/activeSetjmp.ml b/src/analyses/activeSetjmp.ml index be134899933..069111d3ba7 100644 --- a/src/analyses/activeSetjmp.ml +++ b/src/analyses/activeSetjmp.ml @@ -25,7 +25,7 @@ struct | _ -> ctx.local let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.bot ()] + let threadenter ctx lval f args = [D.bot ()] let exitstate v = D.top () let query ctx (type a) (q: a Queries.t): a Queries.result = diff --git a/src/analyses/apron/affineEqualityAnalysis.apron.ml b/src/analyses/apron/affineEqualityAnalysis.apron.ml index ce859d87b78..03a9ecdb57c 100644 --- a/src/analyses/apron/affineEqualityAnalysis.apron.ml +++ b/src/analyses/apron/affineEqualityAnalysis.apron.ml @@ -11,6 +11,7 @@ let spec_module: (module MCPSpec) Lazy.t = let module AD = AffineEqualityDomain.D2 (VectorMatrix.ArrayVector) (VectorMatrix.ArrayMatrix) in let module RD: RelationDomain.RD = struct + module Var = AffineEqualityDomain.Var module V = AffineEqualityDomain.V include AD end diff --git a/src/analyses/apron/apronAnalysis.apron.ml b/src/analyses/apron/apronAnalysis.apron.ml index 0ba17cdb35c..29e295a6622 100644 --- a/src/analyses/apron/apronAnalysis.apron.ml +++ b/src/analyses/apron/apronAnalysis.apron.ml @@ -12,9 +12,10 @@ let spec_module: (module MCPSpec) Lazy.t = let module AD = (val if diff_box then (module ApronDomain.BoxProd (AD): ApronDomain.S3) else (module AD)) in let module RD: RelationDomain.RD = struct + module Var = ApronDomain.Var module V = ApronDomain.V include AD - type var = Apron.Var.t + type var = ApronDomain.Var.t end in let module Priv = (val RelationPriv.get_priv ()) in diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 9697429f673..39158bb0380 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -70,7 +70,7 @@ struct let visitor = object inherit nopCilVisitor method! vlval = function - | (Var v, NoOffset) when (v.vglob || ThreadEscape.has_escaped ask v) && RD.Tracked.varinfo_tracked v -> + | (Var v, NoOffset) when v.vglob || ThreadEscape.has_escaped ask v -> let v_in = if VH.mem v_ins v then VH.find v_ins v @@ -196,7 +196,7 @@ struct let assert_type_bounds ask rel x = assert (RD.Tracked.varinfo_tracked x); match Cilfacade.get_ikind x.vtype with - | ik -> + | ik -> (* don't add type bounds for signed when assume_none *) let (type_min, type_max) = IntDomain.Size.range ik in (* TODO: don't go through CIL exp? *) let e1 = BinOp (Le, Lval (Cil.var x), (Cil.kintegerCilint ik type_max), intType) in @@ -293,10 +293,10 @@ struct let castedPointer = PointerMap.to_varinfo v in Lval (Var castedPointer, offset) | BinOp (binop, e1, e2, typ) when binop = PlusPI || binop = IndexPI -> (*pointer is always on the most left*) - let e2WithMult = BinOp (Mult, integer sizeOfTyp , CastE (!ptrdiffType ,e2), !ptrdiffType) in + let e2WithMult = BinOp (Mult, integer sizeOfTyp , CastE (!upointType ,e2), !upointType) in BinOp (PlusA, replacePointer e1 , e2WithMult, typ) | BinOp (MinusPI, e1, e2, typ) -> - let e2WithMult = BinOp (Mult, integer sizeOfTyp, CastE (!ptrdiffType ,e2), !ptrdiffType) in + let e2WithMult = BinOp (Mult, integer sizeOfTyp, CastE (!upointType ,e2), !upointType) in BinOp (MinusA, replacePointer e1 , e2WithMult, typ) | e -> e in @@ -387,15 +387,14 @@ struct let pass_to_callee fundec any_local_reachable var = (* TODO: currently, we pass all locals of the caller to the callee, provided one of them is reachbale to preserve relationality *) (* 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 var_option = RV.to_cil_varinfo var in if var_option != None && PointerMap.mem_varinfo (Option.get var_option) then false else - let vname = Apron.Var.to_string var in + let vname = RD.Var.to_string 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 *) + match List.find_opt (fun v -> VM.var_name (Local v) = vname) locals with | None -> true | Some v -> any_local_reachable @@ -420,27 +419,24 @@ struct let make_callee_rel ~thread ctx f args = let fundec = Node.find_fundec ctx.node in let st = ctx.local in - let argPointerMapping (x,e) = (*maps expression assigned to pointer args *) - if GobConfig.get_bool "ana.apron.pointer_tracking" then + let argPointerMapping (x,y) = (*maps expression assigned to pointer args *) + if GobConfig.get_bool "ana.apron.pointer_tracking" && isPointerType x.vtype then begin match sizeOfTyp (Lval (Var x, NoOffset)) with | Some typSize -> - let x = PointerMap.to_varinfo x in (*map pointer to helper variable*) - let y = replacePointerWithMapping e typSize in (*replace right side of assignment with pointer mapping*) - Some (RV.local x, y) (* assignment only works with local for some reason *) - | _ -> None + (PointerMap.to_varinfo x, replacePointerWithMapping y typSize) + | _ -> (x,y) end - else None + else (x,y) in let arg_assigns = GobList.combine_short f.sformals args (* TODO: is it right to ignore missing formals/args? *) - |> List.filter_map (fun (x, e) -> - if RD.Tracked.varinfo_tracked x then - Some (RV.arg x, e) - else if isPointerType x.vtype then - argPointerMapping (x,e) + |> List.filter (fun (x, _) -> RD.Tracked.varinfo_tracked x || isPointerType x.vtype) + |> List.map argPointerMapping + |> List.map (Tuple2.map1 (fun x -> + if PointerMap.mem_varinfo x then + RV.local x (* assignment only works with local for some reason *) else - None - ) + RV.arg x)) in let reachableAllocSizeVars = (* get a list of all possible addresses arg may point to *) GobList.combine_short f.sformals args |> List.filter (fun (x, _) -> isPointerType x.vtype) |> List.map ((fun (_,x) -> mayPointToList ctx x)) |> List.flatten @@ -464,9 +460,10 @@ struct let any_local_reachable = any_local_reachable fundec reachable_from_args in RD.remove_filter_with new_rel (fun var -> match RV.find_metadata var with - | Some (Local _) when not (pass_to_callee fundec any_local_reachable var) && not (List.mem_cmp Apron.Var.compare var arg_vars) -> true (* remove caller locals provided they are unreachable *) - | Some (Arg _) when not (List.mem_cmp Apron.Var.compare var arg_vars) -> true (* remove caller args, but keep just added args *) - | _ -> match RV.to_cil_varinfo var with + | Some (Local _) when not (pass_to_callee fundec any_local_reachable var) && not (List.mem_cmp RD.Var.compare var arg_vars) -> if M.tracing then M.trace "re" "remove Local: %a\n" (docOpt (CilType.Varinfo.pretty())) (RV.to_cil_varinfo var);true (* remove caller locals provided they are unreachable *) + | Some (Arg _) when not (List.mem_cmp RD.Var.compare var arg_vars) -> if M.tracing then M.trace "re" "remove Arg: %a\n" (docOpt (CilType.Varinfo.pretty())) (RV.to_cil_varinfo var);true (* remove caller args, but keep just added args *) + | _ -> + match RV.to_cil_varinfo var with | None -> false | Some var -> filterAllocVar var reachableAllocSizeVars (* check if the allocMapping var is reachable from the new function *) (* keep everything else (just added args, globals, global privs) *) @@ -566,7 +563,7 @@ struct in let any_local_reachable = any_local_reachable fundec reachable_from_args in let arg_vars = f.sformals |> List.filter (RD.Tracked.varinfo_tracked) |> List.map RV.arg in - if M.tracing then M.tracel "combine" "relation remove vars: %a\n" (docList (fun v -> Pretty.text (Apron.Var.to_string v))) arg_vars; + if M.tracing then M.tracel "combine" "relation remove vars: %a\n" (docList (fun v -> Pretty.text (RD.Var.to_string v))) arg_vars; RD.remove_vars_with new_fun_rel arg_vars; (* fine to remove arg vars that also exist in caller because unify from new_rel adds them back with proper constraints *) let tainted = f_ask.f Queries.MayBeTainted in let tainted_vars = TaintPartialContexts.conv_varset tainted in @@ -815,7 +812,7 @@ struct |> Enum.filter_map (fun (lincons1: Apron.Lincons1.t) -> (* filter one-vars and exact *) (* TODO: exact filtering doesn't really work with octagon because it returns two SUPEQ constraints instead *) - if (one_var || GobApron.Lincons1.num_vars lincons1 >= 2) && (exact || Apron.Lincons1.get_typ lincons1 <> EQ) then + if (one_var || Apron.Linexpr0.get_size lincons1.lincons0.linexpr0 >= 2) && (exact || Apron.Lincons1.get_typ lincons1 <> EQ) then RD.cil_exp_of_lincons1 lincons1 |> Option.map e_inv |> Option.filter (fun exp -> not (InvariantCil.exp_contains_tmp exp) && InvariantCil.exp_is_in_scope scope exp) @@ -891,7 +888,7 @@ struct if M.tracing then M.trace "OOB" "st: %a\n" RD.pretty st.rel; begin match sizeOfTyp e1 with | Some typSize -> - let e2Mult = BinOp (Mult, e2, integer typSize, TInt (IInt, []) )in + let e2Mult = BinOp (Mult, e2, integer typSize, TInt ( Cilfacade.ptrdiff_ikind (), []) )in let isAfterZero = begin match IntDomain.IntDomTuple.minimal i with | None -> VDQ.ID.top () @@ -899,7 +896,7 @@ struct begin try let min = Z.to_int min in - let aZExp = BinOp (binop, integer min, e2Mult, TInt (IInt, [])) in + let aZExp = BinOp (binop, integer min, e2Mult, TInt (Cilfacade.ptrdiff_ikind (),[])) in let afterZero = Cilfacade.makeBinOp Le Cil.zero aZExp in eval_int afterZero (no_overflow ask afterZero) with @@ -913,7 +910,7 @@ struct | Some i -> begin try let i = Z.to_int i + structOffset in - let relExp = BinOp (binop, integer i, e2Mult, TInt (IInt, [])) in + let relExp = BinOp (binop, integer i, e2Mult, TInt (Cilfacade.ptrdiff_ikind () ,[])) in inBoundsForAllAddresses relExp with | Z.Overflow -> VDQ.ID.top () @@ -958,7 +955,7 @@ struct (* Thread transfer functions. *) - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = let st = ctx.local in match Cilfacade.find_varinfo_fundec f with | fd -> @@ -978,7 +975,7 @@ struct (* TODO: do something like base? *) failwith "relation.threadenter: unknown function" - let threadspawn ctx ~multiple lval f args fctx = + let threadspawn ctx lval f args fctx = ctx.local let event ctx e octx = diff --git a/src/analyses/apron/relationPriv.apron.ml b/src/analyses/apron/relationPriv.apron.ml index a4936580995..eab7e3cf32a 100644 --- a/src/analyses/apron/relationPriv.apron.ml +++ b/src/analyses/apron/relationPriv.apron.ml @@ -197,7 +197,8 @@ struct end module AV = struct - include RelationDomain.VarMetadataTbl (VM) + include RelationDomain.VarMetadataTbl (VM) (RD.Var) + let local g = make_var (Local g) let unprot g = make_var (Unprot g) @@ -848,7 +849,7 @@ struct end (** Per-mutex meet with TIDs. *) -module PerMutexMeetPrivTID (Digest: Digest) (Cluster: ClusterArg): S = functor (RD: RelationDomain.RD) -> +module PerMutexMeetPrivTID (Cluster: ClusterArg): S = functor (RD: RelationDomain.RD) -> struct open CommonPerMutex(RD) include MutexGlobals @@ -858,7 +859,10 @@ struct module Cluster = NC module LRD = NC.LRD - include PerMutexTidCommon (Digest) (LRD) + include PerMutexTidCommon(struct + let exclude_not_started () = GobConfig.get_bool "ana.relation.priv.not-started" + let exclude_must_joined () = GobConfig.get_bool "ana.relation.priv.must-joined" + end)(LRD) module AV = RD.V module P = UnitP @@ -866,9 +870,10 @@ struct let name () = "PerMutexMeetPrivTID(" ^ (Cluster.name ()) ^ (if GobConfig.get_bool "ana.relation.priv.must-joined" then ",join" else "") ^ ")" let get_relevant_writes (ask:Q.ask) m v = - let current = Digest.current ask in + let current = ThreadId.get_current ask in + let must_joined = ask.f Queries.MustJoinedThreads in GMutex.fold (fun k v acc -> - if not (Digest.accounted_for ask ~current ~other:k) then + if compatible ask current must_joined k then LRD.join acc (Cluster.keep_only_protected_globals ask m v) else acc @@ -946,8 +951,8 @@ struct (* unlock *) let rel_side = RD.keep_vars rel_local [g_var] in let rel_side = Cluster.unlock (W.singleton g) rel_side in - let digest = Digest.current ask in - let sidev = GMutex.singleton digest rel_side in + let tid = ThreadId.get_current ask in + let sidev = GMutex.singleton tid rel_side in sideg (V.global g) (G.create_global sidev); let l' = L.add lm rel_side l in let rel_local' = @@ -984,8 +989,8 @@ struct else let rel_side = keep_only_protected_globals ask m rel in let rel_side = Cluster.unlock w rel_side in - let digest = Digest.current ask in - let sidev = GMutex.singleton digest rel_side in + let tid = ThreadId.get_current ask in + let sidev = GMutex.singleton tid rel_side in sideg (V.mutex m) (G.create_mutex sidev); let lm = LLock.mutex m in let l' = L.add lm rel_side l in @@ -1011,17 +1016,17 @@ struct ) ) else ( - if ConcDomain.ThreadSet.is_top tids then + match ConcDomain.ThreadSet.elements tids with + | [tid] -> + let lmust',l' = G.thread (getg (V.thread tid)) in + {st with priv = (w, LMust.union lmust' lmust, L.join l l')} + | _ -> + (* To match the paper more closely, one would have to join in the non-definite case too *) + (* Given how we handle lmust (for initialization), doing this might actually be beneficial given that it grows lmust *) + st + | exception SetDomain.Unsupported _ -> + (* elements throws if the thread set is top *) st - else - match ConcDomain.ThreadSet.elements tids with - | [tid] -> - let lmust',l' = G.thread (getg (V.thread tid)) in - {st with priv = (w, LMust.union lmust' lmust, L.join l l')} - | _ -> - (* To match the paper more closely, one would have to join in the non-definite case too *) - (* Given how we handle lmust (for initialization), doing this might actually be beneficial given that it grows lmust *) - st ) let thread_return ask getg sideg tid (st: relation_components_t) = @@ -1070,8 +1075,8 @@ struct in let rel_side = RD.keep_vars rel g_vars in let rel_side = Cluster.unlock (W.top ()) rel_side in (* top W to avoid any filtering *) - let digest = Digest.current ask in - let sidev = GMutex.singleton digest rel_side in + let tid = ThreadId.get_current ask in + let sidev = GMutex.singleton tid rel_side in sideg V.mutex_inits (G.create_mutex sidev); (* Introduction into local state not needed, will be read via initializer *) (* Also no side-effect to mutex globals needed, the value here will either by read via the initializer, *) @@ -1211,11 +1216,11 @@ let priv_module: (module S) Lazy.t = | "protection" -> (module ProtectionBasedPriv (struct let path_sensitive = false end)) | "protection-path" -> (module ProtectionBasedPriv (struct let path_sensitive = true end)) | "mutex-meet" -> (module PerMutexMeetPriv) - | "mutex-meet-tid" -> (module PerMutexMeetPrivTID (ThreadDigest) (NoCluster)) - | "mutex-meet-tid-cluster12" -> (module PerMutexMeetPrivTID (ThreadDigest) (DownwardClosedCluster (Clustering12))) - | "mutex-meet-tid-cluster2" -> (module PerMutexMeetPrivTID (ThreadDigest) (ArbitraryCluster (Clustering2))) - | "mutex-meet-tid-cluster-max" -> (module PerMutexMeetPrivTID (ThreadDigest) (ArbitraryCluster (ClusteringMax))) - | "mutex-meet-tid-cluster-power" -> (module PerMutexMeetPrivTID (ThreadDigest) (DownwardClosedCluster (ClusteringPower))) + | "mutex-meet-tid" -> (module PerMutexMeetPrivTID (NoCluster)) + | "mutex-meet-tid-cluster12" -> (module PerMutexMeetPrivTID (DownwardClosedCluster (Clustering12))) + | "mutex-meet-tid-cluster2" -> (module PerMutexMeetPrivTID (ArbitraryCluster (Clustering2))) + | "mutex-meet-tid-cluster-max" -> (module PerMutexMeetPrivTID (ArbitraryCluster (ClusteringMax))) + | "mutex-meet-tid-cluster-power" -> (module PerMutexMeetPrivTID (DownwardClosedCluster (ClusteringPower))) | _ -> failwith "ana.relation.privatization: illegal value" ) in diff --git a/src/analyses/base.ml b/src/analyses/base.ml index 8cf3daabcc9..b8c41719ac6 100644 --- a/src/analyses/base.ml +++ b/src/analyses/base.ml @@ -6,7 +6,6 @@ open Pretty open Analyses open GobConfig open BaseUtil -open ReturnUtil module A = Analyses module H = Hashtbl module Q = Queries @@ -53,7 +52,7 @@ struct module G = struct - include Lattice.Lift2Conf (struct include Printable.DefaultConf let expand1 = false let expand2 = false end) (Priv.G) (VD) + include Lattice.Lift2 (Priv.G) (VD) (Printable.DefaultNames) let priv = function | `Bot -> Priv.G.bot () @@ -142,6 +141,13 @@ struct * Initializing my variables **************************************************************************) + let return_varstore = ref dummyFunDec.svar + let return_varinfo () = !return_varstore + let return_var () = AD.of_var (return_varinfo ()) + let return_lval (): lval = (Var (return_varinfo ()), NoOffset) + + let longjmp_return = ref dummyFunDec.svar + let heap_var on_stack ctx = let info = match (ctx.ask (Q.AllocVar {on_stack})) with | `Lifted vinfo -> vinfo @@ -391,8 +397,6 @@ struct Int (if AD.is_bot (AD.meet p1 p2) then ID.of_int ik BI.one else match eq p1 p2 with Some x when x -> ID.of_int ik BI.zero | _ -> bool_top ik) | IndexPI when AD.to_string p2 = ["all_index"] -> addToAddrOp p1 (ID.top_of (Cilfacade.ptrdiff_ikind ())) - | IndexPI | PlusPI -> - addToAddrOp p1 (AD.to_int p2) (* sometimes index is AD for some reason... *) | _ -> VD.top () end (* For other values, we just give up! *) @@ -1131,9 +1135,6 @@ struct (* interpreter end *) - let is_not_alloc_var ctx v = - not (ctx.ask (Queries.IsAllocVar v)) - let is_not_heap_alloc_var ctx v = let is_alloc = ctx.ask (Queries.IsAllocVar v) in not is_alloc || (is_alloc && not (ctx.ask (Queries.IsHeapVar v))) @@ -1272,7 +1273,7 @@ struct (* If there's a non-heap var or an offset in the lval set, we answer with bottom *) (* If we're asking for the BlobSize from the base address, then don't check for offsets => we want to avoid getting bot *) if AD.exists (function - | Addr (v,o) -> is_not_alloc_var ctx v || (if not from_base_addr then o <> `NoOffset else false) + | Addr (v,o) -> is_not_heap_alloc_var ctx v || (if not from_base_addr then o <> `NoOffset else false) | _ -> false) a then Queries.Result.bot q else ( @@ -1284,15 +1285,9 @@ struct else a in - let r = get ~full:true (Analyses.ask_of_ctx ctx) ctx.global ctx.local a None in + let r = get ~full:true (Analyses.ask_of_ctx ctx) ctx.global ctx.local a None in (* ignore @@ printf "BlobSize %a = %a\n" d_plainexp e VD.pretty r; *) (match r with - | Array a -> - (* unroll into array for Calloc calls *) - (match ValueDomain.CArrays.get (Queries.to_value_domain_ask (Analyses.ask_of_ctx ctx)) a (None, (IdxDom.of_int (Cilfacade.ptrdiff_ikind ()) BI.zero)) None with - | Blob (_,s,_) -> `Lifted s - | _ -> Queries.Result.top q - ) | Blob (_,s,_) -> `Lifted s | _ -> Queries.Result.top q) ) @@ -1414,7 +1409,7 @@ struct (** [set st addr val] returns a state where [addr] is set to [val] * it is always ok to put None for lval_raw and rval_raw, this amounts to not using/maintaining * precise information about arrays. *) - let set (a: Q.ask) ~(ctx: _ ctx) ?(invariant=false) ?(blob_destructive=false) ?lval_raw ?rval_raw ?t_override (gs:glob_fun) (st: store) (lval: AD.t) (lval_type: Cil.typ) (value: value) : store = + let set (a: Q.ask) ~(ctx: _ ctx) ?(invariant=false) ?lval_raw ?rval_raw ?t_override (gs:glob_fun) (st: store) (lval: AD.t) (lval_type: Cil.typ) (value: value) : store = let update_variable x t y z = if M.tracing then M.tracel "set" ~var:x.vname "update_variable: start '%s' '%a'\nto\n%a\n\n" x.vname VD.pretty y CPA.pretty z; let r = update_variable x t y z in (* refers to defintion that is outside of set *) @@ -1447,7 +1442,7 @@ struct let update_offset old_value = (* Projection globals to highest Precision *) let projected_value = project_val (Queries.to_value_domain_ask a) None None value (is_global a x) in - let new_value = VD.update_offset ~blob_destructive (Queries.to_value_domain_ask a) old_value offs projected_value lval_raw ((Var x), cil_offset) t in + let new_value = VD.update_offset (Queries.to_value_domain_ask a) old_value offs projected_value lval_raw ((Var x), cil_offset) t in if WeakUpdates.mem x st.weak then VD.join old_value new_value else if invariant then ( @@ -1483,7 +1478,7 @@ struct Priv.read_global a priv_getg st x in let new_value = update_offset old_value in - if M.tracing then M.tracel "set" "update_offset %a -> %a\n" VD.pretty old_value VD.pretty new_value; + M.tracel "hgh" "update_offset %a -> %a\n" VD.pretty old_value VD.pretty new_value; let r = Priv.write_global ~invariant a priv_getg (priv_sideg ctx.sideg) st x new_value in if M.tracing then M.tracel "set" ~var:x.vname "update_one_addr: updated a global var '%s' \nstate:%a\n\n" x.vname D.pretty r; r @@ -1875,7 +1870,7 @@ struct let invalidate ?(deep=true) ~ctx ask (gs:glob_fun) (st:store) (exps: exp list): store = if M.tracing && exps <> [] then M.tracel "invalidate" "Will invalidate expressions [%a]\n" (d_list ", " d_plainexp) exps; - if exps <> [] then M.info ~category:Imprecise "Invalidating expressions: %a" (d_list ", " d_exp) exps; + if exps <> [] then M.info ~category:Imprecise "Invalidating expressions: %a" (d_list ", " d_plainexp) exps; (* To invalidate a single address, we create a pair with its corresponding * top value. *) let invalidate_address st a = @@ -1950,8 +1945,8 @@ struct - let forkfun (ctx:(D.t, G.t, C.t, V.t) Analyses.ctx) (lv: lval option) (f: varinfo) (args: exp list) : (lval option * varinfo * exp list * bool) list = - let create_thread ~multiple lval arg v = + let forkfun (ctx:(D.t, G.t, C.t, V.t) Analyses.ctx) (lv: lval option) (f: varinfo) (args: exp list) : (lval option * varinfo * exp list) list = + let create_thread lval arg v = try (* try to get function declaration *) let fd = Cilfacade.find_varinfo_fundec v in @@ -1960,7 +1955,7 @@ struct | Some x -> [x] | None -> List.map (fun x -> MyCFG.unknown_exp) fd.sformals in - Some (lval, v, args, multiple) + Some (lval, v, args) with Not_found -> if LF.use_special f.vname then None (* we handle this function *) else if isFunctionType v.vtype then @@ -1970,7 +1965,7 @@ struct | Some x -> [x] | None -> List.map (fun x -> MyCFG.unknown_exp) (Cil.argsToList v_args) in - Some (lval, v, args, multiple) + Some (lval, v, args) else ( M.debug ~category:Analyzer "Not creating a thread from %s because its type is %a" v.vname d_type v.vtype; None @@ -1979,7 +1974,7 @@ struct let desc = LF.find f in match desc.special args, f.vname with (* handling thread creations *) - | ThreadCreate { thread = id; start_routine = start; arg = ptc_arg; multiple }, _ -> begin + | ThreadCreate { thread = id; start_routine = start; arg = ptc_arg }, _ -> begin (* extra sync so that we do not analyze new threads with bottom global invariant *) publish_all ctx `Thread; (* Collect the threads. *) @@ -1991,7 +1986,7 @@ struct else start_funvars in - List.filter_map (create_thread ~multiple (Some (Mem id, NoOffset)) (Some ptc_arg)) start_funvars_with_unknown + List.filter_map (create_thread (Some (Mem id, NoOffset)) (Some ptc_arg)) start_funvars_with_unknown 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. @@ -2004,8 +1999,8 @@ struct let deep_flist = collect_invalidate ~deep:true (Analyses.ask_of_ctx ctx) ctx.global ctx.local deep_args in let flist = shallow_flist @ deep_flist in let addrs = List.concat_map AD.to_var_may flist in - if addrs <> [] then M.debug ~category:Analyzer "Spawning non-unique functions from unknown function: %a" (d_list ", " CilType.Varinfo.pretty) addrs; - List.filter_map (create_thread ~multiple:true None None) addrs + if addrs <> [] then M.debug ~category:Analyzer "Spawning functions from unknown function: %a" (d_list ", " CilType.Varinfo.pretty) addrs; + List.filter_map (create_thread None None) addrs | _, _ -> [] let assert_fn ctx e refine = @@ -2129,7 +2124,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\n" d_plainlval lv f.vname; - invalidate ~deep:false ~ctx (Analyses.ask_of_ctx ctx) ctx.global st [Cil.mkAddrOrStartOf lv] + invalidate ~ctx (Analyses.ask_of_ctx ctx) ctx.global st [Cil.mkAddrOrStartOf lv] | None -> st in let addr_type_of_exp exp = @@ -2138,8 +2133,8 @@ struct (addr, AD.type_of addr) in let forks = forkfun ctx lv f args in - if M.tracing then if not (List.is_empty forks) then M.tracel "spawn" "Base.special %s: spawning functions %a\n" f.vname (d_list "," CilType.Varinfo.pretty) (List.map BatTuple.Tuple4.second forks); - List.iter (fun (lval, f, args, multiple) -> ctx.spawn ~multiple lval f args) forks; + if M.tracing then if not (List.is_empty forks) then M.tracel "spawn" "Base.special %s: spawning functions %a\n" f.vname (d_list "," CilType.Varinfo.pretty) (List.map BatTuple.Tuple3.second forks); + List.iter (BatTuple.Tuple3.uncurry ctx.spawn) forks; let st: store = ctx.local in let gs = ctx.global in let desc = LF.find f in @@ -2186,90 +2181,24 @@ struct (* do nothing if all characters are needed *) | _ -> None in - let address_from_value (v:value) = match v with - | Address a -> - (* TODO: is it fine to just drop the last index unconditionally? https://github.com/goblint/analyzer/pull/1076#discussion_r1408975611 *) - let rec lo = function - | `Index (i, `NoOffset) -> `NoOffset - | `NoOffset -> `NoOffset - | `Field (f, o) -> `Field (f, lo o) - | `Index (i, o) -> `Index (i, lo o) in - let rmLastOffset = function - | Addr.Addr (v, o) -> Addr.Addr (v, lo o) - | other -> other in - AD.map rmLastOffset a - | _ -> raise (Failure "String function: not an address") - in - let string_manipulation s1 s2 lv all op_addr op_array = - let s1_v = eval_rv (Analyses.ask_of_ctx ctx) gs st s1 in - let s1_a = address_from_value s1_v in - let s1_typ = AD.type_of s1_a in - let s2_v = eval_rv (Analyses.ask_of_ctx ctx) gs st s2 in - let s2_a = address_from_value s2_v in - let s2_typ = AD.type_of s2_a in - (* compute value in string literals domain if s1 and s2 are both string literals *) - (* TODO: is this reliable? there could be a char* which isn't StrPtr *) - if CilType.Typ.equal s1_typ charPtrType && CilType.Typ.equal s2_typ charPtrType then - begin match lv, op_addr with - | Some lv_val, Some f -> - (* when whished types coincide, compute result of operation op_addr, otherwise use top *) - let lv_a = eval_lv (Analyses.ask_of_ctx ctx) gs st lv_val in - let lv_typ = Cilfacade.typeOfLval lv_val in - if all && typeSig s1_typ = typeSig s2_typ && typeSig s2_typ = typeSig lv_typ then (* all types need to coincide *) - set ~ctx (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (f s1_a s2_a) - else if not all && typeSig s1_typ = typeSig s2_typ then (* only the types of s1 and s2 need to coincide *) - set ~ctx (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (f s1_a s2_a) - else - set ~ctx (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (VD.top_value (unrollType lv_typ)) - | _ -> - (* check if s1 is potentially a string literal as writing to it would be undefined behavior; then return top *) - let _ = AD.string_writing_defined s1_a in - set ~ctx (Analyses.ask_of_ctx ctx) gs st s1_a s1_typ (VD.top_value (unrollType s1_typ)) - end - (* else compute value in array domain *) - else - let lv_a, lv_typ = match lv with - | Some lv_val -> eval_lv (Analyses.ask_of_ctx ctx) gs st lv_val, Cilfacade.typeOfLval lv_val - | None -> s1_a, s1_typ in - begin match (get (Analyses.ask_of_ctx ctx) gs st s1_a None), get (Analyses.ask_of_ctx ctx) gs st s2_a None with - | Array array_s1, Array array_s2 -> set ~ctx ~blob_destructive:true (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (op_array array_s1 array_s2) - | Array array_s1, _ when CilType.Typ.equal s2_typ charPtrType -> - let s2_null_bytes = List.map CArrays.to_null_byte_domain (AD.to_string s2_a) in - let array_s2 = List.fold_left CArrays.join (CArrays.bot ()) s2_null_bytes in - set ~ctx ~blob_destructive:true (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (op_array array_s1 array_s2) - | Bot, Array array_s2 -> - (* If we have bot inside here, we assume the blob is used as a char array and create one inside *) - let ptrdiff_ik = Cilfacade.ptrdiff_ikind () in - let size = ctx.ask (Q.BlobSize {exp = s1; base_address = false}) in - let s_id = - try ValueDomainQueries.ID.unlift (ID.cast_to ptrdiff_ik) size - with Failure _ -> ID.top_of ptrdiff_ik in - let empty_array = CArrays.make s_id (Int (ID.top_of IChar)) in - set ~ctx (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (op_array empty_array array_s2) - | Bot , _ when CilType.Typ.equal s2_typ charPtrType -> - (* If we have bot inside here, we assume the blob is used as a char array and create one inside *) - let ptrdiff_ik = Cilfacade.ptrdiff_ikind () in - let size = ctx.ask (Q.BlobSize {exp = s1; base_address = false}) in - let s_id = - try ValueDomainQueries.ID.unlift (ID.cast_to ptrdiff_ik) size - with Failure _ -> ID.top_of ptrdiff_ik in - let empty_array = CArrays.make s_id (Int (ID.top_of IChar)) in - let s2_null_bytes = List.map CArrays.to_null_byte_domain (AD.to_string s2_a) in - let array_s2 = List.fold_left CArrays.join (CArrays.bot ()) s2_null_bytes in - set ~ctx (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (op_array empty_array array_s2) - | _, Array array_s2 when CilType.Typ.equal s1_typ charPtrType -> - (* if s1 is string literal, str(n)cpy and str(n)cat are undefined *) - if op_addr = None then - (* triggers warning, function only evaluated for side-effects *) - let _ = AD.string_writing_defined s1_a in - set ~ctx (Analyses.ask_of_ctx ctx) gs st s1_a s1_typ (VD.top_value (unrollType s1_typ)) - else - let s1_null_bytes = List.map CArrays.to_null_byte_domain (AD.to_string s1_a) in - let array_s1 = List.fold_left CArrays.join (CArrays.bot ()) s1_null_bytes in - set ~ctx (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (op_array array_s1 array_s2) - | _ -> - set ~ctx (Analyses.ask_of_ctx ctx) gs st lv_a lv_typ (VD.top_value (unrollType lv_typ)) - end + let string_manipulation s1 s2 lv all op = + let s1_a, s1_typ = addr_type_of_exp s1 in + let s2_a, s2_typ = addr_type_of_exp s2 in + match lv, op with + | Some lv_val, Some f -> + (* when whished types coincide, compute result of operation op, otherwise use top *) + let lv_a = eval_lv (Analyses.ask_of_ctx ctx) gs st lv_val in + let lv_typ = Cilfacade.typeOfLval lv_val in + if all && typeSig s1_typ = typeSig s2_typ && typeSig s2_typ = typeSig lv_typ then (* all types need to coincide *) + lv_a, lv_typ, (f s1_a s2_a) + else if not all && typeSig s1_typ = typeSig s2_typ then (* only the types of s1 and s2 need to coincide *) + lv_a, lv_typ, (f s1_a s2_a) + else + lv_a, lv_typ, (VD.top_value (unrollType lv_typ)) + | _ -> + (* check if s1 is potentially a string literal as writing to it would be undefined behavior; then return top *) + let _ = AD.string_writing_defined s1_a in + s1_a, s1_typ, VD.top_value (unrollType s1_typ) in let st = match desc.special args, f.vname with | Memset { dest; ch; count; }, _ -> @@ -2292,51 +2221,53 @@ struct set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Memcpy { dest = dst; src; n; }, _ -> (* TODO: use n *) memory_copying dst src (Some n) - | Strcpy { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_copy ar1 ar2 (eval_n n))) - | Strcat { dest = dst; src; n }, _ -> string_manipulation dst src None false None (fun ar1 ar2 -> Array (CArrays.string_concat ar1 ar2 (eval_n n))) + (* strcpy(dest, src); *) + | Strcpy { dest = dst; src; n = None }, _ -> + let dest_a, dest_typ = addr_type_of_exp dst in + (* when dest surely isn't a string literal, try copying src to dest *) + if AD.string_writing_defined dest_a then + memory_copying dst src None + else + (* else return top (after a warning was issued) *) + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ (VD.top_value (unrollType dest_typ)) + (* strncpy(dest, src, n); *) + | Strcpy { dest = dst; src; n }, _ -> + begin match eval_n n with + | Some num -> + let dest_a, dest_typ, value = string_manipulation dst src None false None in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value + | None -> failwith "already handled in case above" + end + | Strcat { dest = dst; src; n }, _ -> + let dest_a, dest_typ, value = string_manipulation dst src None false None in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | Strlen s, _ -> begin match lv with | Some lv_val -> let dest_a = eval_lv (Analyses.ask_of_ctx ctx) gs st lv_val in let dest_typ = Cilfacade.typeOfLval lv_val in - let v = eval_rv (Analyses.ask_of_ctx ctx) gs st s in - let a = address_from_value v in - let value:value = - (* if s string literal, compute strlen in string literals domain *) - (* TODO: is this reliable? there could be a char* which isn't StrPtr *) - if CilType.Typ.equal (AD.type_of a) charPtrType then - Int (AD.to_string_length a) - (* else compute strlen in array domain *) - else - begin match get (Analyses.ask_of_ctx ctx) gs st a None with - | Array array_s -> Int (CArrays.to_string_length array_s) - | _ -> VD.top_value (unrollType dest_typ) - end in + let lval = mkMem ~addr:(Cil.stripCasts s) ~off:NoOffset in + let address = eval_lv (Analyses.ask_of_ctx ctx) gs st lval in + let (value:value) = Int(AD.to_string_length address) in set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | None -> st end | Strstr { haystack; needle }, _ -> begin match lv with - | Some lv_val -> - (* check if needle is a substring of haystack in string literals domain if haystack and needle are string literals, - else check in null bytes domain if both haystack and needle are / can be transformed to an array domain representation; - if needle is substring, assign the substring of haystack starting at the first occurrence of needle to dest, - if it surely isn't, assign a null_ptr *) - string_manipulation haystack needle lv true (Some (fun h_a n_a -> Address (AD.substring_extraction h_a n_a))) - (fun h_ar n_ar -> match CArrays.substring_extraction h_ar n_ar with - | CArrays.IsNotSubstr -> Address (AD.null_ptr) - | CArrays.IsSubstrAtIndex0 -> Address (eval_lv (Analyses.ask_of_ctx ctx) gs st (mkMem ~addr:(Cil.stripCasts haystack) ~off:NoOffset)) - | CArrays.IsMaybeSubstr -> Address (AD.join (eval_lv (Analyses.ask_of_ctx ctx) gs st - (mkMem ~addr:(Cil.stripCasts haystack) ~off:(Index (Offset.Index.Exp.any, NoOffset)))) (AD.null_ptr))) + | Some _ -> + (* when haystack, needle and dest type coincide, check if needle is a substring of haystack: + if that is the case, assign the substring of haystack starting at the first occurrence of needle to dest, + else use top *) + let dest_a, dest_typ, value = string_manipulation haystack needle lv true (Some (fun h_a n_a -> Address(AD.substring_extraction h_a n_a))) in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | None -> st end | Strcmp { s1; s2; n }, _ -> begin match lv with | Some _ -> - (* when s1 and s2 are string literals, compare both completely or their first n characters in the string literals domain; - else compare them in the null bytes array domain if they are / can be transformed to an array domain representation *) - string_manipulation s1 s2 lv false (Some (fun s1_a s2_a -> Int (AD.string_comparison s1_a s2_a (eval_n n)))) - (fun s1_ar s2_ar -> Int (CArrays.string_comparison s1_ar s2_ar (eval_n n))) + (* when s1 and s2 type coincide, compare both both strings completely or their first n characters, otherwise use top *) + let dest_a, dest_typ, value = string_manipulation s1 s2 lv false (Some (fun s1_a s2_a -> Int(AD.string_comparison s1_a s2_a (eval_n n)))) in + set ~ctx (Analyses.ask_of_ctx ctx) gs st dest_a dest_typ value | None -> st end | Abort, _ -> raise Deadcode @@ -2398,24 +2329,6 @@ struct | _ -> failwith ("non-floating-point argument in call to function "^f.vname) end in - let apply_abs ik x = - let eval_x = eval_rv (Analyses.ask_of_ctx ctx) gs st x in - begin match eval_x with - | Int int_x -> - let xcast = ID.cast_to ik int_x in - (* the absolute value of the most-negative value is out of range for 2'complement types *) - (match (ID.minimal xcast), (ID.minimal (ID.top_of ik)) with - | _, None - | None, _ -> ID.top_of ik - | Some mx, Some mm when Z.equal mx mm -> ID.top_of ik - | _, _ -> - let x1 = ID.neg (ID.meet (ID.ending ik Z.zero) xcast) in - let x2 = ID.meet (ID.starting ik Z.zero) xcast in - ID.join x1 x2 - ) - | _ -> failwith ("non-integer argument in call to function "^f.vname) - end - in let result:value = begin match fun_args with | Nan (fk, str) when Cil.isPointerType (Cilfacade.typeOf str) -> Float (FD.nan_of fk) @@ -2444,8 +2357,6 @@ struct | Isunordered (x,y) -> Int(ID.cast_to IInt (apply_binary FDouble FD.unordered x y)) | Fmax (fd, x ,y) -> Float (apply_binary fd FD.fmax x y) | Fmin (fd, x ,y) -> Float (apply_binary fd FD.fmin x y) - | Sqrt (fk, x) -> Float (apply_unary fk FD.sqrt x) - | Abs (ik, x) -> Int (ID.cast_to ik (apply_abs ik x)) end in begin match lv with @@ -2458,12 +2369,10 @@ struct (* handling thread joins... sort of *) | ThreadJoin { thread = id; ret_var }, _ -> let st' = - (* TODO: should invalidate shallowly? https://github.com/goblint/analyzer/pull/1224#discussion_r1405826773 *) match (eval_rv (Analyses.ask_of_ctx ctx) gs st ret_var) with | Int n when GobOption.exists (BI.equal BI.zero) (ID.to_int n) -> st | Address ret_a -> begin match eval_rv (Analyses.ask_of_ctx ctx) gs st id with - | Thread a when ValueDomain.Threads.is_top a -> invalidate ~ctx (Analyses.ask_of_ctx ctx) gs 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? *) @@ -2733,7 +2642,7 @@ struct in combine_one ctx.local after - let threadenter ctx ~multiple (lval: lval option) (f: varinfo) (args: exp list): D.t list = + let threadenter ctx (lval: lval option) (f: varinfo) (args: exp list): D.t list = match Cilfacade.find_varinfo_fundec f with | fd -> [make_entry ~thread:true ctx fd args] @@ -2743,7 +2652,7 @@ struct let st = special_unknown_invalidate ctx (Analyses.ask_of_ctx ctx) ctx.global st f args in [st] - let threadspawn ctx ~multiple (lval: lval option) (f: varinfo) (args: exp list) fctx: D.t = + let threadspawn ctx (lval: lval option) (f: varinfo) (args: exp list) fctx: D.t = begin match lval with | Some lval -> begin match ThreadId.get_current (Analyses.ask_of_ctx fctx) with @@ -2868,7 +2777,7 @@ struct | "once" -> f (D.bot ()) | "fixpoint" -> - let module DFP = Goblint_solver.LocalFixpoint.Make (D) in + let module DFP = LocalFixpoint.Make (D) in DFP.lfp f | _ -> assert false @@ -2927,6 +2836,8 @@ end module type MainSpec = sig include MCPSpec include BaseDomain.ExpEvaluator + val return_lval: unit -> Cil.lval + val return_varinfo: unit -> Cil.varinfo end let main_module: (module MainSpec) Lazy.t = diff --git a/src/analyses/baseInvariant.ml b/src/analyses/baseInvariant.ml index f18eeed24ff..72e00efbb1b 100644 --- a/src/analyses/baseInvariant.ml +++ b/src/analyses/baseInvariant.ml @@ -243,12 +243,12 @@ struct refine_lv_fallback ctx a gs st lval value tv | None -> if M.tracing then M.traceu "invariant" "Doing nothing.\n"; - M.debug ~category:Analyzer "Invariant failed: expression \"%a\" not understood." d_exp exp; + M.debug ~category:Analyzer "Invariant failed: expression \"%a\" not understood." d_plainexp exp; st let invariant ctx a gs st exp tv: D.t = let fallback reason st = - if M.tracing then M.tracel "inv" "Can't handle %a.\n%t\n" d_plainexp exp reason; + if M.tracing then M.tracel "inv" "Can't handle %a.\n%s\n" d_plainexp exp reason; invariant_fallback ctx a gs st exp tv in (* inverse values for binary operation a `op` b == c *) @@ -689,7 +689,7 @@ struct (* Mixed Float and Int cases should never happen, as there are no binary operators with one float and one int parameter ?!*) | Int _, Float _ | Float _, Int _ -> failwith "ill-typed program"; (* | Address a, Address b -> ... *) - | a1, a2 -> fallback (fun () -> Pretty.dprintf "binop: got abstract values that are not Int: %a and %a" VD.pretty a1 VD.pretty a2) st) + | a1, a2 -> fallback (GobPretty.sprintf "binop: got abstract values that are not Int: %a and %a" VD.pretty a1 VD.pretty a2) st) (* use closures to avoid unused casts *) in (match c_typed with | Int c -> invert_binary_op c ID.pretty (fun ik -> ID.cast_to ik c) (fun fk -> FD.of_int fk c) @@ -709,22 +709,18 @@ struct | _ -> Int c in (* handle special calls *) - begin match x, t with - | (Var v, offs), TInt (ik, _) -> - let tmpSpecial = ctx.ask (Queries.TmpSpecial (v, Offset.Exp.of_cil offs)) in - if M.tracing then M.trace "invSpecial" "qry Result: %a\n" Queries.ML.pretty tmpSpecial; - begin match tmpSpecial with - | `Lifted (Abs (ik, xInt)) -> - let c' = ID.cast_to ik c in (* different ik! *) - inv_exp (Int (ID.join c' (ID.neg c'))) xInt st - | tmpSpecial -> - begin match ID.to_bool c with + begin match t with + | TInt (ik, _) -> + begin match x with + | ((Var v), offs) -> + if M.tracing then M.trace "invSpecial" "qry Result: %a\n" Queries.ML.pretty (ctx.ask (Queries.TmpSpecial (v, Offset.Exp.of_cil offs))); + let tv_opt = ID.to_bool c in + begin match tv_opt with | Some tv -> - begin match tmpSpecial with + begin match ctx.ask (Queries.TmpSpecial (v, Offset.Exp.of_cil offs)) with | `Lifted (Isfinite xFloat) when tv -> inv_exp (Float (FD.finite (unroll_fk_of_exp xFloat))) xFloat st | `Lifted (Isnan xFloat) when tv -> inv_exp (Float (FD.nan_of (unroll_fk_of_exp xFloat))) xFloat st (* should be correct according to C99 standard*) - (* The following do to_bool and of_bool to convert Not{0} into 1 for downstream float inversions *) | `Lifted (Isgreater (xFloat, yFloat)) -> inv_exp (Int (ID.of_bool ik tv)) (BinOp (Gt, xFloat, yFloat, (typeOf xFloat))) st | `Lifted (Isgreaterequal (xFloat, yFloat)) -> inv_exp (Int (ID.of_bool ik tv)) (BinOp (Ge, xFloat, yFloat, (typeOf xFloat))) st | `Lifted (Isless (xFloat, yFloat)) -> inv_exp (Int (ID.of_bool ik tv)) (BinOp (Lt, xFloat, yFloat, (typeOf xFloat))) st @@ -734,8 +730,9 @@ struct end | None -> update_lval c x c' ID.pretty end + | _ -> update_lval c x c' ID.pretty end - | _, _ -> update_lval c x c' ID.pretty + | _ -> update_lval c x c' ID.pretty end | Float c -> let c' = match t with @@ -747,19 +744,22 @@ struct | _ -> Float c in (* handle special calls *) - begin match x, t with - | (Var v, offs), TFloat (fk, _) -> - let tmpSpecial = ctx.ask (Queries.TmpSpecial (v, Offset.Exp.of_cil offs)) in - if M.tracing then M.trace "invSpecial" "qry Result: %a\n" Queries.ML.pretty tmpSpecial; - begin match tmpSpecial with - | `Lifted (Ceil (ret_fk, xFloat)) -> inv_exp (Float (FD.inv_ceil (FD.cast_to ret_fk c))) xFloat st - | `Lifted (Floor (ret_fk, xFloat)) -> inv_exp (Float (FD.inv_floor (FD.cast_to ret_fk c))) xFloat st - | `Lifted (Fabs (ret_fk, xFloat)) -> - let inv = FD.inv_fabs (FD.cast_to ret_fk c) in - if FD.is_bot inv then - raise Analyses.Deadcode - else - inv_exp (Float inv) xFloat st + begin match t with + | TFloat (fk, _) -> + begin match x with + | ((Var v), offs) -> + if M.tracing then M.trace "invSpecial" "qry Result: %a\n" Queries.ML.pretty (ctx.ask (Queries.TmpSpecial (v, Offset.Exp.of_cil offs))); + begin match ctx.ask (Queries.TmpSpecial (v, Offset.Exp.of_cil offs)) with + | `Lifted (Ceil (ret_fk, xFloat)) -> inv_exp (Float (FD.inv_ceil (FD.cast_to ret_fk c))) xFloat st + | `Lifted (Floor (ret_fk, xFloat)) -> inv_exp (Float (FD.inv_floor (FD.cast_to ret_fk c))) xFloat st + | `Lifted (Fabs (ret_fk, xFloat)) -> + let inv = FD.inv_fabs (FD.cast_to ret_fk c) in + if FD.is_bot inv then + raise Analyses.Deadcode + else + inv_exp (Float inv) xFloat st + | _ -> update_lval c x c' FD.pretty + end | _ -> update_lval c x c' FD.pretty end | _ -> update_lval c x c' FD.pretty @@ -778,7 +778,7 @@ struct | TFloat (fk, _), FLongDouble | TFloat (FDouble as fk, _), FDouble | TFloat (FFloat as fk, _), FFloat -> inv_exp (Float (FD.cast_to fk c)) e st - | _ -> fallback (fun () -> Pretty.text "CastE: incompatible types") st) + | _ -> fallback ("CastE: incompatible types") st) | CastE ((TInt (ik, _)) as t, e), Int c | CastE ((TEnum ({ekind = ik; _ }, _)) as t, e), Int c -> (* Can only meet the t part of an Lval in e with c (unless we meet with all overflow possibilities)! Since there is no good way to do this, we only continue if e has no values outside of t. *) (match eval e st with @@ -791,11 +791,11 @@ struct let c' = ID.cast_to ik_e (ID.meet c (ID.cast_to ik (ID.top_of ik_e))) in (* TODO: cast without overflow, is this right for normal invariant? *) if M.tracing then M.tracel "inv" "cast: %a from %a to %a: i = %a; cast c = %a to %a = %a\n" d_exp e d_ikind ik_e d_ikind ik ID.pretty i ID.pretty c d_ikind ik_e ID.pretty c'; inv_exp (Int c') e st - | x -> fallback (fun () -> Pretty.dprintf "CastE: e did evaluate to Int, but the type did not match %a" CilType.Typ.pretty t) st + | x -> fallback (GobPretty.sprintf "CastE: e did evaluate to Int, but the type did not match %a" CilType.Typ.pretty t) st else - fallback (fun () -> Pretty.dprintf "CastE: %a evaluates to %a which is bigger than the type it is cast to which is %a" d_plainexp e ID.pretty i CilType.Typ.pretty t) st - | v -> fallback (fun () -> Pretty.dprintf "CastE: e did not evaluate to Int, but %a" VD.pretty v) st) - | e, _ -> fallback (fun () -> Pretty.dprintf "%a not implemented" d_plainexp e) st + fallback (GobPretty.sprintf "CastE: %a evaluates to %a which is bigger than the type it is cast to which is %a" d_plainexp e ID.pretty i CilType.Typ.pretty t) st + | v -> fallback (GobPretty.sprintf "CastE: e did not evaluate to Int, but %a" VD.pretty v) st) + | e, _ -> fallback (GobPretty.sprintf "%a not implemented" d_plainexp e) st in if eval_bool exp st = Some (not tv) then contra st (* we already know that the branch is dead *) else diff --git a/src/analyses/basePriv.ml b/src/analyses/basePriv.ml index 85670ca5ada..36d8153a133 100644 --- a/src/analyses/basePriv.ml +++ b/src/analyses/basePriv.ml @@ -211,12 +211,12 @@ struct let thread_join ?(force=false) ask get e st = st let thread_return ask get set tid st = st - let invariant_global getg = function + let invariant_global getg g = + match g with + | `Left _ -> (* mutex *) + Invariant.none | `Right g' -> (* global *) ValueDomain.invariant_global (read_unprotected_global getg) g' - | _ -> (* mutex *) - Invariant.none - end module PerMutexOplusPriv: S = @@ -230,7 +230,7 @@ struct CPA.find x st.cpa (* let read_global ask getg cpa x = let (cpa', v) as r = read_global ask getg cpa x in - ignore (Pretty.printf "READ GLOBAL %a (%a, %B) = %a\n" CilType.Varinfo.pretty x CilType.Location.pretty !Goblint_tracing.current_loc (is_unprotected ask x) VD.pretty v); + ignore (Pretty.printf "READ GLOBAL %a (%a, %B) = %a\n" CilType.Varinfo.pretty x CilType.Location.pretty !Tracing.current_loc (is_unprotected ask x) VD.pretty v); r *) let write_global ?(invariant=false) ask getg sideg (st: BaseComponents (D).t) x v = let cpa' = CPA.add x v st.cpa in @@ -391,11 +391,14 @@ struct st end -module PerMutexMeetTIDPriv (Digest: Digest): S = +module PerMutexMeetTIDPriv: S = struct open Queries.Protection include PerMutexMeetPrivBase - include PerMutexTidCommon (Digest) (CPA) + include PerMutexTidCommon(struct + let exclude_not_started () = GobConfig.get_bool "ana.base.priv.not-started" + let exclude_must_joined () = GobConfig.get_bool "ana.base.priv.must-joined" + end)(CPA) let iter_sys_vars getg vq vf = match vq with @@ -422,10 +425,11 @@ struct r let get_relevant_writes (ask:Q.ask) m v = - let current = Digest.current ask in + let current = ThreadId.get_current ask in + let must_joined = ask.f Queries.MustJoinedThreads in let is_in_Gm x _ = is_protected_by ~protection:Weak ask m x in GMutex.fold (fun k v acc -> - if not (Digest.accounted_for ask ~current ~other:k) then + if compatible ask current must_joined k then CPA.join acc (CPA.filter is_in_Gm v) else acc @@ -470,8 +474,8 @@ struct CPA.add x v st.cpa in if M.tracing then M.tracel "priv" "WRITE GLOBAL SIDE %a = %a\n" CilType.Varinfo.pretty x VD.pretty v; - let digest = Digest.current ask in - let sidev = GMutex.singleton digest (CPA.singleton x v) in + let tid = ThreadId.get_current ask in + let sidev = GMutex.singleton tid (CPA.singleton x v) in let l' = L.add lm (CPA.singleton x v) l in let is_recovered_st = ask.f (Queries.MustBeSingleThreaded {since_start = false}) && not @@ ask.f (Queries.MustBeSingleThreaded {since_start = true}) in let l' = if is_recovered_st then @@ -513,8 +517,8 @@ struct {st with cpa = cpa'; priv = (w',lmust,l)} else let is_in_Gm x _ = is_protected_by ~protection:Weak ask m x in - let digest = Digest.current ask in - let sidev = GMutex.singleton digest (CPA.filter is_in_Gm st.cpa) in + let tid = ThreadId.get_current ask in + let sidev = GMutex.singleton tid (CPA.filter is_in_Gm st.cpa) in sideg (V.mutex m) (G.create_mutex sidev); let lm = LLock.mutex m in let l' = L.add lm (CPA.filter is_in_Gm st.cpa) l in @@ -540,17 +544,17 @@ struct ) ) else ( - if ConcDomain.ThreadSet.is_top tids then + match ConcDomain.ThreadSet.elements tids with + | [tid] -> + let lmust',l' = G.thread (getg (V.thread tid)) in + {st with priv = (w, LMust.union lmust' lmust, L.join l l')} + | _ -> + (* To match the paper more closely, one would have to join in the non-definite case too *) + (* Given how we handle lmust (for initialization), doing this might actually be beneficial given that it grows lmust *) + st + | exception SetDomain.Unsupported _ -> + (* elements throws if the thread set is top *) st - else - match ConcDomain.ThreadSet.elements tids with - | [tid] -> - let lmust',l' = G.thread (getg (V.thread tid)) in - {st with priv = (w, LMust.union lmust' lmust, L.join l l')} - | _ -> - (* To match the paper more closely, one would have to join in the non-definite case too *) - (* Given how we handle lmust (for initialization), doing this might actually be beneficial given that it grows lmust *) - st ) let thread_return ask getg sideg tid (st: BaseComponents (D).t) = @@ -564,13 +568,13 @@ struct let escape ask getg sideg (st: BaseComponents (D).t) escaped = let escaped_cpa = CPA.filter (fun x _ -> EscapeDomain.EscapedVars.mem x escaped) st.cpa in - let digest = Digest.current ask in - let sidev = GMutex.singleton digest escaped_cpa in + let tid = ThreadId.get_current ask in + let sidev = GMutex.singleton tid escaped_cpa in sideg V.mutex_inits (G.create_mutex sidev); let cpa' = CPA.fold (fun x v acc -> if EscapeDomain.EscapedVars.mem x escaped (* && is_unprotected ask x *) then ( if M.tracing then M.tracel "priv" "ESCAPE SIDE %a = %a\n" CilType.Varinfo.pretty x VD.pretty v; - let sidev = GMutex.singleton digest (CPA.singleton x v) in + let sidev = GMutex.singleton tid (CPA.singleton x v) in sideg (V.global x) (G.create_global sidev); CPA.remove x acc ) @@ -583,8 +587,8 @@ struct let enter_multithreaded ask getg sideg (st: BaseComponents (D).t) = let cpa = st.cpa in let cpa_side = CPA.filter (fun x _ -> is_global ask x) cpa in - let digest = Digest.current ask in - let sidev = GMutex.singleton digest cpa_side in + let tid = ThreadId.get_current ask in + let sidev = GMutex.singleton tid cpa_side in sideg V.mutex_inits (G.create_mutex sidev); (* Introduction into local state not needed, will be read via initializer *) (* Also no side-effect to mutex globals needed, the value here will either by read via the initializer, *) @@ -621,11 +625,13 @@ struct let get_mutex_inits' = CPA.find x get_mutex_inits in VD.join get_mutex_global_x' get_mutex_inits' - let invariant_global getg = function - | `Middle g -> (* global *) - ValueDomain.invariant_global (read_unprotected_global getg) g - | `Left _ - | `Right _ -> (* mutex or thread *) + let invariant_global getg g = + match g with + | `Left (`Left _) -> (* mutex *) + Invariant.none + | `Left (`Right g') -> (* global *) + ValueDomain.invariant_global (read_unprotected_global getg) g' + | `Right _ -> (* thread *) Invariant.none end @@ -656,11 +662,21 @@ struct struct include VarinfoV (* [g]' *) let name () = "unprotected" + let show x = show x ^ ":unprotected" (* distinguishable variant names for html *) + include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) end module VProt = struct include VarinfoV (* [g] *) let name () = "protected" + let show x = show x ^ ":protected" (* distinguishable variant names for html *) + include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) end module V = struct @@ -795,7 +811,7 @@ struct struct (* weak: G -> (2^M -> WeakRange) *) (* sync: M -> (2^M -> SyncRange) *) - include Lattice.Lift2Conf (struct include Printable.DefaultConf let expand1 = false let expand2 = false end) (GWeak) (GSync) + include Lattice.Lift2 (GWeak) (GSync) (Printable.DefaultNames) let weak = function | `Bot -> GWeak.bot () @@ -831,15 +847,16 @@ struct open Locksets - let invariant_global getg = function + let invariant_global getg g = + match g with + | `Left _ -> (* mutex *) + Invariant.none | `Right g' -> (* global *) ValueDomain.invariant_global (fun x -> GWeak.fold (fun s' tm acc -> WeakRange.fold_weak VD.join tm acc ) (G.weak (getg (V.global x))) (VD.bot ()) ) g' - | _ -> (* mutex *) - Invariant.none let invariant_vars ask getg st = let module VS = Set.Make (CilType.Varinfo) in @@ -876,7 +893,7 @@ end module MinePrivBase = struct include NoFinalize - include ConfCheck.RequireMutexPathSensOneMainInit + include ConfCheck.RequireMutexPathSensInit include MutexGlobals (* explicit not needed here because G is Prod anyway? *) let thread_join ?(force=false) ask get e st = st @@ -1651,7 +1668,7 @@ struct let read_global ask getg st x = let v = Priv.read_global ask getg st x in if !AnalysisState.postsolving && !is_dumping then - LVH.modify_def (VD.bot ()) (!Goblint_tracing.current_loc, x) (VD.join v) lvh; + LVH.modify_def (VD.bot ()) (!Tracing.current_loc, x) (VD.join v) lvh; v let dump () = @@ -1778,7 +1795,7 @@ let priv_module: (module S) Lazy.t = | "none" -> (module NonePriv: S) | "mutex-oplus" -> (module PerMutexOplusPriv) | "mutex-meet" -> (module PerMutexMeetPriv) - | "mutex-meet-tid" -> (module PerMutexMeetTIDPriv (ThreadDigest)) + | "mutex-meet-tid" -> (module PerMutexMeetTIDPriv) | "protection" -> (module ProtectionBasedPriv (struct let check_read_unprotected = false end)) | "protection-read" -> (module ProtectionBasedPriv (struct let check_read_unprotected = true end)) | "mine" -> (module MinePriv) diff --git a/src/analyses/commonPriv.ml b/src/analyses/commonPriv.ml index 8c406df6657..db75455b403 100644 --- a/src/analyses/commonPriv.ml +++ b/src/analyses/commonPriv.ml @@ -19,14 +19,12 @@ struct if not mutex_active then failwith "Privatization (to be useful) requires the 'mutex' analysis to be enabled (it is currently disabled)" end - module RequireMutexPathSensOneMainInit = + module RequireMutexPathSensInit = struct let init () = RequireMutexActivatedInit.init (); let mutex_path_sens = List.mem "mutex" (GobConfig.get_string_list "ana.path_sens") in if not mutex_path_sens then failwith "The activated privatization requires the 'mutex' analysis to be enabled & path sensitive (it is currently enabled, but not path sensitive)"; - let mainfuns = List.length @@ GobConfig.get_list "mainfun" in - if not (mainfuns = 1) then failwith "The activated privatization requires exactly one main function to be specified"; () end @@ -74,19 +72,22 @@ struct struct include LockDomain.Addr let name () = "mutex" + let show x = show x ^ ":mutex" (* distinguishable variant names for html *) end module VMutexInits = Printable.UnitConf (struct let name = "MUTEX_INITS" end) module VGlobal = struct include VarinfoV let name () = "global" + let show x = show x ^ ":global" (* distinguishable variant names for html *) end module V = struct - include Printable.Either3Conf (struct include Printable.DefaultConf let expand2 = false end) (VMutex) (VMutexInits) (VGlobal) + (* TODO: Either3? *) + include Printable.Either (Printable.Either (VMutex) (VMutexInits)) (VGlobal) let name () = "MutexGlobals" - let mutex x: t = `Left x - let mutex_inits: t = `Middle () + let mutex x: t = `Left (`Left x) + let mutex_inits: t = `Left (`Right ()) let global x: t = `Right x end @@ -151,38 +152,12 @@ struct end end -module type Digest = -sig - include Printable.S - - val current: Q.ask -> t - val accounted_for: Q.ask -> current:t -> other:t -> bool +module type PerMutexTidCommonArg = sig + val exclude_not_started: unit -> bool + val exclude_must_joined: unit -> bool end -module ThreadDigest: Digest = -struct - include ThreadIdDomain.ThreadLifted - - module TID = ThreadIdDomain.Thread - - let current (ask: Q.ask) = - ThreadId.get_current ask - - let accounted_for (ask: Q.ask) ~(current: t) ~(other: t) = - match current, other with - | `Lifted current, `Lifted other -> - if TID.is_unique current && TID.equal current other then - true (* self-read *) - else if GobConfig.get_bool "ana.relation.priv.not-started" && MHP.definitely_not_started (current, ask.f Q.CreatedThreads) other then - true (* other is not started yet *) - else if GobConfig.get_bool "ana.relation.priv.must-joined" && MHP.must_be_joined other (ask.f Queries.MustJoinedThreads) then - true (* accounted for in local information *) - else - false - | _ -> false -end - -module PerMutexTidCommon (Digest: Digest) (LD:Lattice.S) = +module PerMutexTidCommon (Conf:PerMutexTidCommonArg) (LD:Lattice.S) = struct include ConfCheck.RequireThreadFlagPathSensInit @@ -197,7 +172,7 @@ struct module V = struct - include Printable.EitherConf (struct let expand1 = false let expand2 = true end) (MutexGlobals.V) (TID) + include Printable.Either (MutexGlobals.V) (TID) let mutex x = `Left (MutexGlobals.V.mutex x) let mutex_inits = `Left MutexGlobals.V.mutex_inits let global x = `Left (MutexGlobals.V.global x) @@ -219,12 +194,12 @@ struct (* Map from locks to last written values thread-locally *) module L = MapDomain.MapBot_LiftTop (LLock) (LD) - module GMutex = MapDomain.MapBot_LiftTop (Digest) (LD) + module GMutex = MapDomain.MapBot_LiftTop (ThreadIdDomain.ThreadLifted) (LD) module GThread = Lattice.Prod (LMust) (L) module G = struct - include Lattice.Lift2Conf (struct include Printable.DefaultConf let expand1 = false let expand2 = false end) (GMutex) (GThread) + include Lattice.Lift2 (GMutex) (GThread) (Printable.DefaultNames) let mutex = function | `Bot -> GMutex.bot () @@ -241,10 +216,24 @@ struct module D = Lattice.Prod3 (W) (LMust) (L) + let compatible (ask:Q.ask) current must_joined other = + match current, other with + | `Lifted current, `Lifted other -> + if (TID.is_unique current) && (TID.equal current other) then + false (* self-read *) + else if Conf.exclude_not_started () && MHP.definitely_not_started (current, ask.f Q.CreatedThreads) other then + false (* other is not started yet *) + else if Conf.exclude_must_joined () && MHP.must_be_joined other must_joined then + false (* accounted for in local information *) + else + true + | _ -> true + let get_relevant_writes_nofilter (ask:Q.ask) v = - let current = Digest.current ask in + let current = ThreadId.get_current ask in + let must_joined = ask.f Queries.MustJoinedThreads in GMutex.fold (fun k v acc -> - if not (Digest.accounted_for ask ~current ~other:k) then + if compatible ask current must_joined k then LD.join acc v else acc diff --git a/src/analyses/condVars.ml b/src/analyses/condVars.ml index 3b23dc03fcd..04b148dd020 100644 --- a/src/analyses/condVars.ml +++ b/src/analyses/condVars.ml @@ -155,8 +155,8 @@ struct ctx.local let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.bot ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.bot ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.bot () end diff --git a/src/analyses/expsplit.ml b/src/analyses/expsplit.ml index fef3d9ff9fa..f121d0380ee 100644 --- a/src/analyses/expsplit.ml +++ b/src/analyses/expsplit.ml @@ -84,9 +84,9 @@ struct in emit_splits ctx d - let threadenter ctx ~multiple lval f args = [ctx.local] + let threadenter ctx lval f args = [ctx.local] - let threadspawn ctx ~multiple lval f args fctx = + let threadspawn ctx lval f args fctx = emit_splits_ctx ctx let event ctx (event: Events.t) octx = diff --git a/src/analyses/extractPthread.ml b/src/analyses/extractPthread.ml index 8412a656832..60e389fedf8 100644 --- a/src/analyses/extractPthread.ml +++ b/src/analyses/extractPthread.ml @@ -220,7 +220,7 @@ module Tbls = struct let make_new_val table k = (* TODO: all same key occurrences instead *) let line = -5 - all_keys_count table in - let loc = { !Goblint_tracing.current_loc with line } in + let loc = { !Tracing.current_loc with line } in MyCFG.Statement { (mkStmtOneInstr @@ Set (var dummyFunDec.svar, zero, loc, loc)) with sid = new_sid () @@ -1238,7 +1238,7 @@ module Spec : Analyses.MCPSpec = struct (Ctx.top ()) - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = let d : D.t = ctx.local in let tasks = ctx.global tasks_var in (* TODO: optimize finding *) @@ -1254,7 +1254,7 @@ module Spec : Analyses.MCPSpec = struct [ { f_d with pred = d.pred } ] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.top () diff --git a/src/analyses/fileUse.ml b/src/analyses/fileUse.ml new file mode 100644 index 00000000000..a9088a4bb26 --- /dev/null +++ b/src/analyses/fileUse.ml @@ -0,0 +1,296 @@ +(** Analysis of correct file handle usage ([file]). + + @see Vogler, R. Verifying Regular Safety Properties of C Programs Using the Static Analyzer Goblint. Section 3.*) + +open Batteries +open GoblintCil +open Analyses + +module Spec = +struct + include Analyses.DefaultSpec + + let name () = "file" + module D = FileDomain.Dom + module C = FileDomain.Dom + + (* special variables *) + let return_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@return" Cil.voidType, `NoOffset + let unclosed_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@unclosed" Cil.voidType, `NoOffset + + (* keys that were already warned about; needed for multiple returns (i.e. can't be kept in D) *) + let warned_unclosed = ref Set.empty + + (* queries *) + let query ctx (type a) (q: a Queries.t) = + match q with + | Queries.MayPointTo exp -> if M.tracing then M.tracel "file" "query MayPointTo: %a" d_plainexp exp; Queries.Result.top q + | _ -> Queries.Result.top q + + let query_ad (ask: Queries.ask) exp = + match ask.f (Queries.MayPointTo exp) with + | ad when not (Queries.AD.is_top ad) -> Queries.AD.elements ad + | _ -> [] + let print_query_lv ?msg:(msg="") ask exp = + let addrs = query_ad ask exp in (* MayPointTo -> LValSet *) + let pretty_key = function + | Queries.AD.Addr.Addr (v,o) -> Pretty.text (D.string_of_key (v, ValueDomain.Addr.Offs.to_exp o)) + | _ -> Pretty.text "" in + if M.tracing then M.tracel "file" "%s MayPointTo %a = [%a]" msg d_exp exp (Pretty.docList ~sep:(Pretty.text ", ") pretty_key) addrs + + let eval_fv ask exp: varinfo option = + match query_ad ask exp with + | [addr] -> Queries.AD.Addr.to_var_may addr + | _ -> None + + + (* transfer functions *) + let assign ctx (lval:lval) (rval:exp) : D.t = + let m = ctx.local in + (* ignore(printf "%a = %a\n" d_plainlval lval d_plainexp rval); *) + let saveOpened ?unknown:(unknown=false) k m = (* save maybe opened files in the domain to warn about maybe unclosed files at the end *) + if D.may k D.opened m && not (D.is_unknown k m) then (* if unknown we don't have any location for the warning and have handled it already anyway *) + let mustOpen, mayOpen = D.filter_records k D.opened m in + let mustOpen, mayOpen = if unknown then Set.empty, mayOpen else mustOpen, Set.diff mayOpen mustOpen in + D.extend_value unclosed_var (mustOpen, mayOpen) m + else m + in + let key_from_exp = function + | Lval x -> Some (D.key_from_lval x) + | _ -> None + in + match key_from_exp (Lval lval), key_from_exp (stripCasts rval) with (* we just care about Lval assignments *) + | Some k1, Some k2 when k1=k2 -> m (* do nothing on self-assignment *) + | Some k1, Some k2 when D.mem k1 m && D.mem k2 m -> (* both in D *) + if M.tracing then M.tracel "file" "assign (both in D): %s = %s" (D.string_of_key k1) (D.string_of_key k2); + saveOpened k1 m |> D.remove' k1 |> D.alias k1 k2 + | Some k1, Some k2 when D.mem k1 m -> (* only k1 in D *) + if M.tracing then M.tracel "file" "assign (only k1 in D): %s = %s" (D.string_of_key k1) (D.string_of_key k2); + saveOpened k1 m |> D.remove' k1 + | Some k1, Some k2 when D.mem k2 m -> (* only k2 in D *) + if M.tracing then M.tracel "file" "assign (only k2 in D): %s = %s" (D.string_of_key k1) (D.string_of_key k2); + D.alias k1 k2 m + | Some k1, _ when D.mem k1 m -> (* k1 in D and assign something unknown *) + if M.tracing then M.tracel "file" "assign (only k1 in D): %s = %a" (D.string_of_key k1) d_exp rval; + D.warn @@ "[Unsound]changed pointer "^D.string_of_key k1^" (no longer safe)"; + saveOpened ~unknown:true k1 m |> D.unknown k1 + | _ -> (* no change in D for other things *) + if M.tracing then M.tracel "file" "assign (none in D): %a = %a [%a]" d_lval lval d_exp rval d_plainexp rval; + m + + let branch ctx (exp:exp) (tv:bool) : D.t = + let m = ctx.local in + (* ignore(printf "if %a = %B (line %i)\n" d_plainexp exp tv (!Tracing.current_loc).line); *) + let check a b tv = + (* ignore(printf "check: %a = %a, %B\n" d_plainexp a d_plainexp b tv); *) + match a, b with + | Const (CInt(i, kind, str)), Lval lval + | Lval lval, Const (CInt(i, kind, str)) -> + (* ignore(printf "branch(%s==%i, %B)\n" v.vname (Int64.to_int i) tv); *) + let k = D.key_from_lval lval in + if Z.compare i Z.zero = 0 && tv then ( + (* ignore(printf "error-branch\n"); *) + D.error k m + )else + D.success k m + | _ -> M.debug ~category:Analyzer "nothing matched the given BinOp: %a = %a" d_plainexp a d_plainexp b; m + in + match stripCasts (constFold true exp) with + (* somehow there are a lot of casts inside the BinOp which stripCasts only removes when called on the subparts + -> matching as in flagMode didn't work *) + (* | BinOp (Eq, Const (CInt64(i, kind, str)), Lval (Var v, NoOffset), _) + | BinOp (Eq, Lval (Var v, NoOffset), Const (CInt64(i, kind, str)), _) -> + ignore(printf "%s %i\n" v.vname (Int64.to_int i)); m *) + | BinOp (Eq, a, b, _) -> check (stripCasts a) (stripCasts b) tv + | BinOp (Ne, a, b, _) -> check (stripCasts a) (stripCasts b) (not tv) + | e -> M.debug ~category:Analyzer "branch: nothing matched the given exp: %a" d_plainexp e; m + + let body ctx (f:fundec) : D.t = + ctx.local + + let return ctx (exp:exp option) (f:fundec) : D.t = + (* TODO check One Return transformation: oneret.ml *) + let m = ctx.local in + (* if f.svar.vname <> "main" && BatList.is_empty (callstack m) then M.write ("\n\t!!! call stack is empty for function "^f.svar.vname^" !!!"); *) + if f.svar.vname = "main" then ( + let mustOpen, mayOpen = D.union (D.filter_values D.opened m) (D.get_value unclosed_var m) in + if Set.cardinal mustOpen > 0 then ( + D.warn @@ "unclosed files: "^D.string_of_keys mustOpen; + Set.iter (fun v -> D.warn ~loc:(D.V.loc v) "file is never closed") mustOpen; + (* add warnings about currently open files (don't include overwritten or changed file handles!) *) + warned_unclosed := Set.union !warned_unclosed (fst (D.filter_values D.opened m)) (* can't save in domain b/c it wouldn't reach the other return *) + ); + (* go through files "never closed" and recheck for current return *) + Set.iter (fun v -> if D.must (D.V.key v) D.closed m then D.warn ~may:true ~loc:(D.V.loc v) "file is never closed") !warned_unclosed; + (* let mustOpenVars = List.map (fun x -> x.key) mustOpen in *) + (* let mayOpen = List.filter (fun x -> not (List.mem x.key mustOpenVars)) mayOpen in (* ignore values that are already in mustOpen *) *) + let mayOpen = Set.diff mayOpen mustOpen in + if Set.cardinal mayOpen > 0 then + D.warn ~may:true @@ "unclosed files: "^D.string_of_keys mayOpen; + Set.iter (fun v -> D.warn ~may:true ~loc:(D.V.loc v) "file is never closed") mayOpen + ); + (* take care of return value *) + let au = match exp with + | Some(Lval lval) when D.mem (D.key_from_lval lval) m -> (* we return a var in D *) + let k = D.key_from_lval lval in + let varinfo,offset = k in + if varinfo.vglob then + D.alias return_var k m (* if var is global, we alias it *) + else + D.add return_var (D.find' k m) m (* if var is local, we make a copy *) + | _ -> m + in + (* remove formals and locals *) + (* this is not a good approach, what if we added a key foo.fp? -> just keep the globals *) + List.fold_left (fun m var -> D.remove' (var, `NoOffset) m) au (f.sformals @ f.slocals) + (* D.only_globals au *) + + let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = + let m = if f.svar.vname <> "main" then + (* push current location onto stack *) + D.edit_callstack (BatList.cons (Option.get !Node.current_node)) ctx.local + else ctx.local in + (* we need to remove all variables that are neither globals nor special variables from the domain for f *) + (* problem: we need to be able to check aliases of globals in check_overwrite_open -> keep those in too :/ *) + (* TODO see Base.make_entry, reachable vars > globals? *) + (* [m, D.only_globals m] *) + [m, m] (* this is [caller, callee] *) + + let check_overwrite_open k m = (* used in combine and special *) + if List.is_empty (D.get_aliases k m) then ( + (* there are no other variables pointing to the file handle + and it is opened again without being closed before *) + D.report k D.opened ("overwriting still opened file handle "^D.string_of_key k) m; + let mustOpen, mayOpen = D.filter_records k D.opened m in + let mayOpen = Set.diff mayOpen mustOpen in + (* save opened files in the domain to warn about unclosed files at the end *) + D.extend_value unclosed_var (mustOpen, mayOpen) m + ) else m + + let combine_env ctx lval fexp f args fc au f_ask = + let m = ctx.local in + (* pop the last location off the stack *) + let m = D.edit_callstack List.tl m in (* TODO could it be problematic to keep this in the caller instead of callee domain? if we only add the stack for the callee in enter, then there would be no need to pop a location anymore... *) + (* TODO add all globals from au to m (since we remove formals and locals on return, we can just add everything except special vars?) *) + D.without_special_vars au |> D.add_all m + + let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (au:D.t) (f_ask: Queries.ask) : D.t = + let m = ctx.local in + let return_val = D.find_option return_var au in + match lval, return_val with + | Some lval, Some v -> + let k = D.key_from_lval lval in + (* handle potential overwrites *) + let m = check_overwrite_open k m in + (* if v.key is still in D, then it must be a global and we need to alias instead of rebind *) + (* TODO what if there is a local with the same name as the global? *) + if D.V.is_top v then (* returned a local that was top -> just add k as top *) + D.add' k v m + else (* v is now a local which is not top or a global which is aliased *) + let vvar = D.V.get_alias v in (* this is also ok if v is not an alias since it chooses an element from the May-Set which is never empty (global top gets aliased) *) + if D.mem vvar au then (* returned variable was a global TODO what if local had the same name? -> seems to work *) + D.alias k vvar m + else (* returned variable was a local *) + let v = D.V.set_key k v in (* adjust var-field to lval *) + D.add' k v m + | _ -> m + + let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = + (* is f a pointer to a function we look out for? *) + let f = eval_fv (Analyses.ask_of_ctx ctx) (Lval (Var f, NoOffset)) |? f in + let m = ctx.local in + let loc = (Option.get !Node.current_node)::(D.callstack m) in + let arglist = List.map (Cil.stripCasts) arglist in (* remove casts, TODO safe? *) + let split_err_branch lval dom = + (* type? NULL = 0 = 0-ptr? Cil.intType, Cil.intPtrType, Cil.voidPtrType -> no difference *) + if not (GobConfig.get_bool "ana.file.optimistic") then + ctx.split dom [Events.SplitBranch ((Cil.BinOp (Cil.Eq, Cil.Lval lval, Cil.integer 0, Cil.intType)), true)]; + dom + in + (* fold possible keys on domain *) + let ret_all f lval = + let xs = D.keys_from_lval lval (Analyses.ask_of_ctx ctx) in (* get all possible keys for a given lval *) + if xs = [] then (D.warn @@ GobPretty.sprintf "could not resolve %a" CilType.Lval.pretty lval; m) + else if List.compare_length_with xs 1 = 0 then f (List.hd xs) m true + (* else List.fold_left (fun m k -> D.join m (f k m)) m xs *) + else + (* if there is more than one key, join all values and do warnings on the result *) + let v = List.fold_left (fun v k -> match v, D.find_option k m with + | None, None -> None + | Some a, None + | None, Some a -> Some a + | Some a, Some b -> Some (D.V.join a b)) None xs in + (* set all of the keys to the computed joined value *) + (* let m' = Option.map_default (fun v -> List.fold_left (fun m k -> D.add' k v m) m xs) m v in *) + (* then check each key *) + (* List.iter (fun k -> ignore(f k m')) xs; *) + (* get Mval.Exp from lval *) + let k' = D.key_from_lval lval in + (* add joined value for that key *) + let m' = Option.map_default (fun v -> D.add' k' v m) m v in + (* check for warnings *) + ignore(f k' m' true); + (* and join the old domain without issuing warnings *) + List.fold_left (fun m k -> D.join m (f k m false)) m xs + in + match lval, f.vname, arglist with + | None, "fopen", _ -> + D.warn "file handle is not saved!"; m + | Some lval, "fopen", _ -> + let f k m w = + let m = check_overwrite_open k m in + (match arglist with + | Const(CStr(filename,_))::Const(CStr(mode,_))::[] -> + (* M.debug ~category:Analyzer @@ "fopen(\""^filename^"\", \""^mode^"\")"; *) + D.fopen k loc filename mode m |> split_err_branch lval (* TODO k instead of lval? *) + | e::Const(CStr(mode,_))::[] -> + (* ignore(printf "CIL: %a\n" d_plainexp e); *) + (match ctx.ask (Queries.EvalStr e) with + | `Lifted filename -> D.fopen k loc filename mode m + | _ -> D.warn "[Unsound]unknown filename"; D.fopen k loc "???" mode m + ) + | xs -> + let args = (String.concat ", " (List.map CilType.Exp.show xs)) in + M.debug ~category:Analyzer "fopen args: %s" args; + (* List.iter (fun exp -> ignore(printf "%a\n" d_plainexp exp)) xs; *) + D.warn @@ "[Program]fopen needs two strings as arguments, given: "^args; m + ) + in ret_all f lval + + | _, "fclose", [Lval fp] -> + let f k m w = + if w then D.reports k [ + false, D.closed, "closeing already closed file handle "^D.string_of_key k; + true, D.opened, "closeing unopened file handle "^D.string_of_key k + ] m; + D.fclose k loc m + in ret_all f fp + | _, "fclose", _ -> + D.warn "fclose needs exactly one argument"; m + + | _, "fprintf", (Lval fp)::_::_ -> + let f k m w = + if w then D.reports k [ + false, D.closed, "writing to closed file handle "^D.string_of_key k; + true, D.opened, "writing to unopened file handle "^D.string_of_key k; + true, D.writable, "writing to read-only file handle "^D.string_of_key k; + ] m; + m + in ret_all f fp + | _, "fprintf", fp::_::_ -> + (* List.iter (fun exp -> ignore(printf "%a\n" d_plainexp exp)) arglist; *) + print_query_lv ~msg:"fprintf(?, ...): " (Analyses.ask_of_ctx ctx) fp; + D.warn "[Program]first argument to printf must be a Lval"; m + | _, "fprintf", _ -> + D.warn "[Program]fprintf needs at least two arguments"; m + + | _ -> m + + let startstate v = D.bot () + let threadenter ctx lval f args = [D.bot ()] + let threadspawn ctx lval f args fctx = ctx.local + let exitstate v = D.bot () +end + +let _ = + MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/util/library/libraryDesc.ml b/src/analyses/libraryDesc.ml similarity index 93% rename from src/util/library/libraryDesc.ml rename to src/analyses/libraryDesc.ml index e2dbedb5167..72a4261cb50 100644 --- a/src/util/library/libraryDesc.ml +++ b/src/analyses/libraryDesc.ml @@ -27,7 +27,6 @@ type math = | Islessequal of (Basetype.CilExp.t * Basetype.CilExp.t) | Islessgreater of (Basetype.CilExp.t * Basetype.CilExp.t) | Isunordered of (Basetype.CilExp.t * Basetype.CilExp.t) - | Abs of (CilType.Ikind.t * Basetype.CilExp.t) | Ceil of (CilType.Fkind.t * Basetype.CilExp.t) | Floor of (CilType.Fkind.t * Basetype.CilExp.t) | Fabs of (CilType.Fkind.t * Basetype.CilExp.t) @@ -39,8 +38,7 @@ type math = | Atan2 of (CilType.Fkind.t * Basetype.CilExp.t * Basetype.CilExp.t) | Cos of (CilType.Fkind.t * Basetype.CilExp.t) | Sin of (CilType.Fkind.t * Basetype.CilExp.t) - | Tan of (CilType.Fkind.t * Basetype.CilExp.t) - | Sqrt of (CilType.Fkind.t * Basetype.CilExp.t) [@@deriving eq, ord, hash] + | Tan of (CilType.Fkind.t * Basetype.CilExp.t) [@@deriving eq, ord, hash] (** Type of special function, or {!Unknown}. *) (* Use inline record if not single {!Cil.exp} argument. *) @@ -53,7 +51,7 @@ type special = | Assert of { exp: Cil.exp; check: bool; refine: bool; } | Lock of { lock: Cil.exp; try_: bool; write: bool; return_on_success: bool; } | Unlock of Cil.exp - | ThreadCreate of { thread: Cil.exp; start_routine: Cil.exp; arg: Cil.exp; multiple: bool } + | ThreadCreate of { thread: Cil.exp; start_routine: Cil.exp; arg: Cil.exp; } | ThreadJoin of { thread: Cil.exp; ret_var: Cil.exp; } | ThreadExit of { ret_val: Cil.exp; } | Signal of Cil.exp @@ -80,7 +78,6 @@ type special = | Identity of Cil.exp (** Identity function. Some compiler optimization annotation functions map to this. *) | Setjmp of { env: Cil.exp; } | Longjmp of { env: Cil.exp; value: Cil.exp; } - | Bounded of { exp: Cil.exp} (** Used to check for bounds for termination analysis. *) | Rand | Unknown (** Anything not belonging to other types. *) (* TODO: rename to Other? *) @@ -161,7 +158,6 @@ module MathPrintable = struct | Islessequal (exp1, exp2) -> Pretty.dprintf "isLessEqual(%a, %a)" d_exp exp1 d_exp exp2 | Islessgreater (exp1, exp2) -> Pretty.dprintf "isLessGreater(%a, %a)" d_exp exp1 d_exp exp2 | Isunordered (exp1, exp2) -> Pretty.dprintf "isUnordered(%a, %a)" d_exp exp1 d_exp exp2 - | Abs (ik, exp) -> Pretty.dprintf "(%a )abs(%a)" d_ikind ik d_exp exp | Ceil (fk, exp) -> Pretty.dprintf "(%a )ceil(%a)" d_fkind fk d_exp exp | Floor (fk, exp) -> Pretty.dprintf "(%a )floor(%a)" d_fkind fk d_exp exp | Fabs (fk, exp) -> Pretty.dprintf "(%a )fabs(%a)" d_fkind fk d_exp exp @@ -174,7 +170,6 @@ module MathPrintable = struct | Cos (fk, exp) -> Pretty.dprintf "(%a )cos(%a)" d_fkind fk d_exp exp | Sin (fk, exp) -> Pretty.dprintf "(%a )sin(%a)" d_fkind fk d_exp exp | Tan (fk, exp) -> Pretty.dprintf "(%a )tan(%a)" d_fkind fk d_exp exp - | Sqrt (fk, exp) -> Pretty.dprintf "(%a )sqrt(%a)" d_fkind fk d_exp exp include Printable.SimplePretty ( struct @@ -184,8 +179,7 @@ module MathPrintable = struct ) end -module MathLifted = Lattice.FlatConf (struct - include Printable.DefaultConf +module MathLifted = Lattice.Flat (MathPrintable) (struct let top_name = "Unknown or no math desc" let bot_name = "Nonexistent math desc" - end) (MathPrintable) + end) diff --git a/src/util/library/libraryDsl.ml b/src/analyses/libraryDsl.ml similarity index 100% rename from src/util/library/libraryDsl.ml rename to src/analyses/libraryDsl.ml diff --git a/src/util/library/libraryDsl.mli b/src/analyses/libraryDsl.mli similarity index 100% rename from src/util/library/libraryDsl.mli rename to src/analyses/libraryDsl.mli diff --git a/src/util/library/libraryFunctions.ml b/src/analyses/libraryFunctions.ml similarity index 87% rename from src/util/library/libraryFunctions.ml rename to src/analyses/libraryFunctions.ml index 54b244f9e0e..0f9c34f957b 100644 --- a/src/util/library/libraryFunctions.ml +++ b/src/analyses/libraryFunctions.ml @@ -32,7 +32,6 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__builtin_strncat", special [__ "dest" [r; w]; __ "src" [r]; __ "n" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); ("__builtin___strncat_chk", special [__ "dest" [r; w]; __ "src" [r]; __ "n" []; drop "os" []] @@ fun dest src n -> Strcat { dest; src; n = Some n; }); ("memcmp", unknown [drop "s1" [r]; drop "s2" [r]; drop "n" []]); - ("__builtin_memcmp", unknown [drop "s1" [r]; drop "s2" [r]; drop "n" []]); ("memchr", unknown [drop "s" [r]; drop "c" []; drop "n" []]); ("asctime", unknown ~attrs:[ThreadUnsafe] [drop "time_ptr" [r_deep]]); ("fclose", unknown [drop "stream" [r_deep; w_deep; f_deep]]); @@ -43,7 +42,6 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("getc", unknown [drop "stream" [r_deep; w_deep]]); ("fgets", unknown [drop "str" [w]; drop "count" []; drop "stream" [r_deep; w_deep]]); ("fopen", unknown [drop "pathname" [r]; drop "mode" [r]]); - ("freopen", unknown [drop "pathname" [r]; drop "mode" [r]; drop "stream" [r_deep; w_deep]]); ("printf", unknown (drop "format" [r] :: VarArgs (drop' [r]))); ("fprintf", unknown (drop "stream" [r_deep; w_deep] :: drop "format" [r] :: VarArgs (drop' [r]))); ("sprintf", unknown (drop "buffer" [w] :: drop "format" [r] :: VarArgs (drop' [r]))); @@ -63,7 +61,6 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("localeconv", unknown ~attrs:[ThreadUnsafe] []); ("localtime", unknown ~attrs:[ThreadUnsafe] [drop "time" [r]]); ("strlen", special [__ "s" [r]] @@ fun s -> Strlen s); - ("__builtin_strlen", special [__ "s" [r]] @@ fun s -> Strlen s); ("strstr", special [__ "haystack" [r]; __ "needle" [r]] @@ fun haystack needle -> Strstr { haystack; needle; }); ("strcmp", special [__ "s1" [r]; __ "s2" [r]] @@ fun s1 s2 -> Strcmp { s1; s2; n = None; }); ("strtok", unknown ~attrs:[ThreadUnsafe] [drop "str" [r; w]; drop "delim" [r]]); @@ -89,7 +86,6 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("iswspace", unknown [drop "wc" []]); ("iswalnum", unknown [drop "wc" []]); ("iswprint", unknown [drop "wc" []]); - ("iswxdigit", unknown [drop "ch" []]); ("rename" , unknown [drop "oldpath" [r]; drop "newpath" [r];]); ("perror", unknown [drop "s" [r]]); ("getchar", unknown []); @@ -114,15 +110,12 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("vprintf", unknown [drop "format" [r]; drop "vlist" [r_deep]]); (* TODO: what to do with a va_list type? is r_deep correct? *) ("vfprintf", unknown [drop "stream" [r_deep; w_deep]; drop "format" [r]; drop "vlist" [r_deep]]); (* TODO: what to do with a va_list type? is r_deep correct? *) ("vsprintf", unknown [drop "buffer" [w]; drop "format" [r]; drop "vlist" [r_deep]]); (* TODO: what to do with a va_list type? is r_deep correct? *) - ("asprintf", unknown (drop "strp" [w] :: drop "format" [r] :: VarArgs (drop' [r_deep]))); (* TODO: glibc section? *) ("vasprintf", unknown [drop "strp" [w]; drop "format" [r]; drop "ap" [r_deep]]); (* TODO: what to do with a va_list type? is r_deep correct? *) ("vsnprintf", unknown [drop "str" [w]; drop "size" []; drop "format" [r]; drop "ap" [r_deep]]); (* TODO: what to do with a va_list type? is r_deep correct? *) ("mktime", unknown [drop "tm" [r;w]]); ("ctime", unknown ~attrs:[ThreadUnsafe] [drop "rm" [r]]); - ("clearerr", unknown [drop "stream" [w]]); (* TODO: why only w? *) + ("clearerr", unknown [drop "stream" [w]]); ("setbuf", unknown [drop "stream" [w]; drop "buf" [w]]); - ("wprintf", unknown (drop "fmt" [r] :: VarArgs (drop' [r]))); - ("fwprintf", unknown (drop "stream" [r_deep; w_deep] :: drop "fmt" [r] :: VarArgs (drop' [r]))); ("swprintf", unknown (drop "wcs" [w] :: drop "maxlen" [] :: drop "fmt" [r] :: VarArgs (drop' [r]))); ("assert", special [__ "exp" []] @@ fun exp -> Assert { exp; check = true; refine = get_bool "sem.assert.refine" }); (* only used if assert is used without include, e.g. in transformed files *) ("difftime", unknown [drop "time1" []; drop "time2" []]); @@ -133,10 +126,7 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("wcstombs", unknown ~attrs:[ThreadUnsafe] [drop "dst" [w]; drop "src" [r]; drop "size" []]); ("wcsrtombs", unknown ~attrs:[ThreadUnsafe] [drop "dst" [w]; drop "src" [r_deep; w]; drop "size" []; drop "ps" [r_deep; w_deep]]); ("mbstowcs", unknown [drop "dest" [w]; drop "src" [r]; drop "n" []]); - ("abs", special [__ "j" []] @@ fun j -> Math { fun_args = (Abs (IInt, j)) }); - ("labs", special [__ "j" []] @@ fun j -> Math { fun_args = (Abs (ILong, j)) }); - ("llabs", special [__ "j" []] @@ fun j -> Math { fun_args = (Abs (ILongLong, j)) }); - ("imaxabs", unknown [drop "j" []]); + ("abs", unknown [drop "j" []]); ("localtime_r", unknown [drop "timep" [r]; drop "result" [w]]); ("strpbrk", unknown [drop "s" [r]; drop "accept" [r]]); ("_setjmp", special [__ "env" [w]] @@ fun env -> Setjmp { env }); (* only has one underscore *) @@ -154,15 +144,6 @@ let c_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("atomic_flag_test_and_set_explicit", unknown [drop "obj" [r; w]; drop "order" []]); ("atomic_load", unknown [drop "obj" [r]]); ("atomic_store", unknown [drop "obj" [w]; drop "desired" []]); - ("_Exit", special [drop "status" []] @@ Abort); - ("strcoll", unknown [drop "lhs" [r]; drop "rhs" [r]]); - ("wscanf", unknown (drop "fmt" [r] :: VarArgs (drop' [w]))); - ("fwscanf", unknown (drop "stream" [r_deep; w_deep] :: drop "fmt" [r] :: VarArgs (drop' [w]))); - ("swscanf", unknown (drop "buffer" [r] :: drop "fmt" [r] :: VarArgs (drop' [w]))); - ("remove", unknown [drop "pathname" [r]]); - ("raise", unknown [drop "sig" []]); (* safe-ish, we don't handle signal handlers for now *) - ("timespec_get", unknown [drop "ts" [w]; drop "base" []]); - ("signal", unknown [drop "signum" []; drop "handler" [s]]); ] (** C POSIX library functions. @@ -265,7 +246,6 @@ let posix_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("ftruncate", unknown [drop "fd" []; drop "length" []]); ("mkfifo", unknown [drop "pathname" [r]; drop "mode" []]); ("alarm", unknown [drop "seconds" []]); - ("pread", unknown [drop "fd" []; drop "buf" [w]; drop "count" []; drop "offset" []]); ("pwrite", unknown [drop "fd" []; drop "buf" [r]; drop "count" []; drop "offset" []]); ("hstrerror", unknown [drop "err" []]); ("inet_ntoa", unknown ~attrs:[ThreadUnsafe] [drop "in" []]); @@ -285,9 +265,6 @@ let posix_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("access", unknown [drop "pathname" [r]; drop "mode" []]); ("ttyname", unknown ~attrs:[ThreadUnsafe] [drop "fd" []]); ("shm_open", unknown [drop "name" [r]; drop "oflag" []; drop "mode" []]); - ("shmget", unknown [drop "key" []; drop "size" []; drop "shmflag" []]); - ("shmat", unknown [drop "shmid" []; drop "shmaddr" []; drop "shmflag" []]) (* TODO: shmaddr? *); - ("shmdt", unknown [drop "shmaddr" []]) (* TODO: shmaddr? *); ("sched_get_priority_max", unknown [drop "policy" []]); ("mprotect", unknown [drop "addr" []; drop "len" []; drop "prot" []]); ("ftime", unknown [drop "tp" [w]]); @@ -312,7 +289,6 @@ let posix_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("sendto", unknown [drop "sockfd" []; drop "buf" [r]; drop "len" []; drop "flags" []; drop "dest_addr" [r_deep]; drop "addrlen" []]); ("strdup", unknown [drop "s" [r]]); ("strndup", unknown [drop "s" [r]; drop "n" []]); - ("__strndup", unknown [drop "s" [r]; drop "n" []]); ("syscall", unknown (drop "number" [] :: VarArgs (drop' [r; w]))); ("sysconf", unknown [drop "name" []]); ("syslog", unknown (drop "priority" [] :: drop "format" [r] :: VarArgs (drop' [r]))); (* TODO: is the VarArgs correct here? *) @@ -353,12 +329,11 @@ let posix_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("regexec", unknown [drop "preg" [r_deep]; drop "string" [r]; drop "nmatch" []; drop "pmatch" [w_deep]; drop "eflags" []]); ("regfree", unknown [drop "preg" [f_deep]]); ("ffs", unknown [drop "i" []]); - ("_exit", special [drop "status" []] @@ Abort); + ("_exit", special [drop "status" []] Abort); ("execvp", unknown [drop "file" [r]; drop "argv" [r_deep]]); ("execl", unknown (drop "path" [r] :: drop "arg" [r] :: VarArgs (drop' [r]))); ("statvfs", unknown [drop "path" [r]; drop "buf" [w]]); ("readlink", unknown [drop "path" [r]; drop "buf" [w]; drop "bufsz" []]); - ("wcwidth", unknown [drop "c" []]); ("wcswidth", unknown [drop "s" [r]; drop "n" []]); ("link", unknown [drop "oldpath" [r]; drop "newpath" [r]]); ("renameat", unknown [drop "olddirfd" []; drop "oldpath" [r]; drop "newdirfd" []; drop "newpath" [r]]); @@ -389,9 +364,6 @@ let posix_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("sigdelset", unknown [drop "set" [r; w]; drop "signum" []]); ("sigismember", unknown [drop "set" [r]; drop "signum" []]); ("sigprocmask", unknown [drop "how" []; drop "set" [r]; drop "oldset" [w]]); - ("sigwait", unknown [drop "set" [r]; drop "sig" [w]]); - ("sigwaitinfo", unknown [drop "set" [r]; drop "info" [w]]); - ("sigtimedwait", unknown [drop "set" [r]; drop "info" [w]; drop "timeout" [r]]); ("fork", unknown []); ("dlopen", unknown [drop "filename" [r]; drop "flag" []]); ("dlerror", unknown ~attrs:[ThreadUnsafe] []); @@ -412,35 +384,15 @@ let posix_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("unlink", unknown [drop "pathname" [r]]); ("popen", unknown [drop "command" [r]; drop "type" [r]]); ("stat", unknown [drop "pathname" [r]; drop "statbuf" [w]]); - ("fsync", unknown [drop "fd" []]); - ("fdatasync", unknown [drop "fd" []]); - ("getrusage", unknown [drop "who" []; drop "usage" [w]]); - ("alphasort", unknown [drop "a" [r]; drop "b" [r]]); - ("gmtime_r", unknown [drop "timer" [r]; drop "result" [w]]); - ("rand_r", special [drop "seedp" [r; w]] Rand); - ("srandom", unknown [drop "seed" []]); - ("random", special [] Rand); - ("posix_memalign", unknown [drop "memptr" [w]; drop "alignment" []; drop "size" []]); (* TODO: Malloc *) - ("stpcpy", unknown [drop "dest" [w]; drop "src" [r]]); - ("dup", unknown [drop "oldfd" []]); - ("readdir_r", unknown [drop "dirp" [r_deep]; drop "entry" [r_deep]; drop "result" [w]]); - ("pipe", unknown [drop "pipefd" [w_deep]]); - ("waitpid", unknown [drop "pid" []; drop "wstatus" [w]; drop "options" []]); - ("strerror_r", unknown [drop "errnum" []; drop "buff" [w]; drop "buflen" []]); - ("umask", unknown [drop "mask" []]); - ("openlog", unknown [drop "ident" [r]; drop "option" []; drop "facility" []]); - ("times", unknown [drop "buf" [w]]); - ("mmap", unknown [drop "addr" []; drop "length" []; drop "prot" []; drop "flags" []; drop "fd" []; drop "offset" []]); - ("munmap", unknown [drop "addr" []; drop "length" []]); + ("statfs", unknown [drop "path" [r]; drop "buf" [w]]); ] (** Pthread functions. *) let pthread_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ - ("pthread_create", special [__ "thread" [w]; drop "attr" [r]; __ "start_routine" [s]; __ "arg" []] @@ fun thread start_routine arg -> ThreadCreate { thread; start_routine; arg; multiple = false }); (* For precision purposes arg is not considered accessed here. Instead all accesses (if any) come from actually analyzing start_routine. *) + ("pthread_create", special [__ "thread" [w]; drop "attr" [r]; __ "start_routine" [s]; __ "arg" []] @@ fun thread start_routine arg -> ThreadCreate { thread; start_routine; arg }); (* For precision purposes arg is not considered accessed here. Instead all accesses (if any) come from actually analyzing start_routine. *) ("pthread_exit", special [__ "retval" []] @@ fun retval -> ThreadExit { ret_val = retval }); (* Doesn't dereference the void* itself, but just passes to pthread_join. *) ("pthread_join", special [__ "thread" []; __ "retval" [w]] @@ fun thread retval -> ThreadJoin {thread; ret_var = retval}); ("pthread_kill", unknown [drop "thread" []; drop "sig" []]); - ("pthread_equal", unknown [drop "t1" []; drop "t2" []]); ("pthread_cond_init", unknown [drop "cond" [w]; drop "attr" [r]]); ("__pthread_cond_init", unknown [drop "cond" [w]; drop "attr" [r]]); ("pthread_cond_signal", special [__ "cond" []] @@ fun cond -> Signal cond); @@ -462,10 +414,6 @@ let pthread_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("pthread_mutex_unlock", special [__ "mutex" []] @@ fun mutex -> Unlock mutex); ("__pthread_mutex_unlock", special [__ "mutex" []] @@ fun mutex -> Unlock mutex); ("pthread_mutexattr_init", unknown [drop "attr" [w]]); - ("pthread_mutexattr_getpshared", unknown [drop "attr" [r]; drop "pshared" [w]]); - ("pthread_mutexattr_setpshared", unknown [drop "attr" [w]; drop "pshared" []]); - ("pthread_mutexattr_getrobust", unknown [drop "attr" [r]; drop "pshared" [w]]); - ("pthread_mutexattr_setrobust", unknown [drop "attr" [w]; drop "pshared" []]); ("pthread_mutexattr_destroy", unknown [drop "attr" [f]]); ("pthread_rwlock_init", unknown [drop "rwlock" [w]; drop "attr" [r]]); ("pthread_rwlock_destroy", unknown [drop "rwlock" [f]]); @@ -496,8 +444,6 @@ let pthread_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("pthread_key_create", unknown [drop "key" [w]; drop "destructor" [s]]); ("pthread_key_delete", unknown [drop "key" [f]]); ("pthread_cancel", unknown [drop "thread" []]); - ("pthread_testcancel", unknown []); - ("pthread_setcancelstate", unknown [drop "state" []; drop "oldstate" [w]]); ("pthread_setcanceltype", unknown [drop "type" []; drop "oldtype" [w]]); ("pthread_detach", unknown [drop "thread" []]); ("pthread_attr_setschedpolicy", unknown [drop "attr" [r; w]; drop "policy" []]); @@ -534,7 +480,6 @@ let gcc_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__builtin_unreachable", special' [] @@ fun () -> if get_bool "sem.builtin_unreachable.dead_code" then Abort else Unknown); (* https://github.com/sosy-lab/sv-benchmarks/issues/1296 *) ("__assert_rtn", special [drop "func" [r]; drop "file" [r]; drop "line" []; drop "exp" [r]] @@ Abort); (* MacOS's built-in assert *) ("__assert_fail", special [drop "assertion" [r]; drop "file" [r]; drop "line" []; drop "function" [r]] @@ Abort); (* gcc's built-in assert *) - ("__assert", special [drop "assertion" [r]; drop "file" [r]; drop "line" []] @@ Abort); (* header says: The following is not at all used here but needed for standard compliance. *) ("__builtin_return_address", unknown [drop "level" []]); ("__builtin___sprintf_chk", unknown (drop "s" [w] :: drop "flag" [] :: drop "os" [] :: drop "fmt" [r] :: VarArgs (drop' [r]))); ("__builtin_add_overflow", unknown [drop "a" []; drop "b" []; drop "c" [w]]); @@ -571,12 +516,6 @@ let gcc_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__atomic_clear", unknown [drop "ptr" [w]; drop "memorder" []]); ("__atomic_compare_exchange_n", unknown [drop "ptr" [r; w]; drop "expected" [r; w]; drop "desired" []; drop "weak" []; drop "success_memorder" []; drop "failure_memorder" []]); ("__atomic_compare_exchange", unknown [drop "ptr" [r; w]; drop "expected" [r; w]; drop "desired" [r]; drop "weak" []; drop "success_memorder" []; drop "failure_memorder" []]); - ("__atomic_add_fetch", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); - ("__atomic_sub_fetch", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); - ("__atomic_and_fetch", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); - ("__atomic_xor_fetch", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); - ("__atomic_or_fetch", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); - ("__atomic_nand_fetch", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); ("__atomic_fetch_add", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); ("__atomic_fetch_sub", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); ("__atomic_fetch_and", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); @@ -585,7 +524,6 @@ let gcc_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__atomic_fetch_nand", unknown [drop "ptr" [r; w]; drop "val" []; drop "memorder" []]); ("__atomic_test_and_set", unknown [drop "ptr" [r; w]; drop "memorder" []]); ("__atomic_thread_fence", unknown [drop "memorder" []]); - ("__sync_bool_compare_and_swap", unknown [drop "ptr" [r; w]; drop "oldval" []; drop "newval" []]); ("__sync_fetch_and_add", unknown (drop "ptr" [r; w] :: drop "value" [] :: VarArgs (drop' []))); ("__sync_fetch_and_sub", unknown (drop "ptr" [r; w] :: drop "value" [] :: VarArgs (drop' []))); ("__builtin_va_copy", unknown [drop "dest" [w]; drop "src" [r]]); @@ -595,13 +533,8 @@ let gcc_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ let glibc_desc_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("fputs_unlocked", unknown [drop "s" [r]; drop "stream" [w]]); - ("feof_unlocked", unknown [drop "stream" [r_deep; w_deep]]); - ("ferror_unlocked", unknown [drop "stream" [r_deep; w_deep]]); - ("fwrite_unlocked", unknown [drop "buffer" [r]; drop "size" []; drop "count" []; drop "stream" [r_deep; w_deep]]); - ("clearerr_unlocked", unknown [drop "stream" [w]]); (* TODO: why only w? *) ("futimesat", unknown [drop "dirfd" []; drop "pathname" [r]; drop "times" [r]]); - ("error", unknown ((drop "status" []) :: (drop "errnum" []) :: (drop "format" [r]) :: (VarArgs (drop' [r])))); - ("warn", unknown (drop "format" [r] :: VarArgs (drop' [r]))); + ("error", unknown ((drop "status" []):: (drop "errnum" []) :: (drop "format" [r]) :: (VarArgs (drop' [r])))); ("gettext", unknown [drop "msgid" [r]]); ("euidaccess", unknown [drop "pathname" [r]; drop "mode" []]); ("rpmatch", unknown [drop "response" [r]]); @@ -610,11 +543,6 @@ let glibc_desc_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__fgets_chk", unknown [drop "__s" [w]; drop "__size" []; drop "__n" []; drop "__stream" [r_deep; w_deep]]); ("__fread_alias", unknown [drop "__ptr" [w]; drop "__size" []; drop "__n" []; drop "__stream" [r_deep; w_deep]]); ("__fread_chk", unknown [drop "__ptr" [w]; drop "__ptrlen" []; drop "__size" []; drop "__n" []; drop "__stream" [r_deep; w_deep]]); - ("__fread_chk_warn", unknown [drop "buffer" [w]; drop "os" []; drop "size" []; drop "count" []; drop "stream" [r_deep; w_deep]]); - ("fread_unlocked", unknown ~attrs:[ThreadUnsafe] [drop "buffer" [w]; drop "size" []; drop "count" []; drop "stream" [r_deep; w_deep]]); - ("__fread_unlocked_alias", unknown ~attrs:[ThreadUnsafe] [drop "__ptr" [w]; drop "__size" []; drop "__n" []; drop "__stream" [r_deep; w_deep]]); - ("__fread_unlocked_chk", unknown ~attrs:[ThreadUnsafe] [drop "__ptr" [w]; drop "__ptrlen" []; drop "__size" []; drop "__n" []; drop "__stream" [r_deep; w_deep]]); - ("__fread_unlocked_chk_warn", unknown ~attrs:[ThreadUnsafe] [drop "__ptr" [w]; drop "__ptrlen" []; drop "__size" []; drop "__n" []; drop "__stream" [r_deep; w_deep]]); ("__read_chk", unknown [drop "__fd" []; drop "__buf" [w]; drop "__nbytes" []; drop "__buflen" []]); ("__read_alias", unknown [drop "__fd" []; drop "__buf" [w]; drop "__nbytes" []]); ("__readlink_chk", unknown [drop "path" [r]; drop "buf" [w]; drop "len" []; drop "buflen" []]); @@ -651,8 +579,6 @@ let glibc_desc_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("atoq", unknown [drop "nptr" [r]]); ("strchrnul", unknown [drop "s" [r]; drop "c" []]); ("getdtablesize", unknown []); - ("daemon", unknown [drop "nochdir" []; drop "noclose" []]); - ("putw", unknown [drop "w" []; drop "stream" [r_deep; w_deep]]); ] let linux_userspace_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ @@ -669,8 +595,6 @@ let linux_userspace_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__xpg_basename", unknown [drop "path" [r]]); ("ptrace", unknown (drop "request" [] :: VarArgs (drop' [r_deep; w_deep]))); (* man page has 4 arguments, but header has varargs and real-world programs may call with <4 *) ("madvise", unknown [drop "addr" []; drop "length" []; drop "advice" []]); - ("mremap", unknown (drop "old_address" [] :: drop "old_size" [] :: drop "new_size" [] :: drop "flags" [] :: VarArgs (drop "new_address" []))); - ("msync", unknown [drop "addr" []; drop "len" []; drop "flags" []]); ("inotify_init1", unknown [drop "flags" []]); ("inotify_add_watch", unknown [drop "fd" []; drop "pathname" [r]; drop "mask" []]); ("inotify_rm_watch", unknown [drop "fd" []; drop "wd" []]); @@ -680,12 +604,6 @@ let linux_userspace_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("mount", unknown [drop "source" [r]; drop "target" [r]; drop "filesystemtype" [r]; drop "mountflags" []; drop "data" [r]]); ("umount", unknown [drop "target" [r]]); ("umount2", unknown [drop "target" [r]; drop "flags" []]); - ("statfs", unknown [drop "path" [r]; drop "buf" [w]]); - ("fstatfs", unknown [drop "fd" []; drop "buf" [w]]); - ("cfmakeraw", unknown [drop "termios" [r; w]]); - ("process_vm_readv", unknown [drop "pid" []; drop "local_iov" [w_deep]; drop "liovcnt" []; drop "remote_iov" []; drop "riovcnt" []; drop "flags" []]); - ("__libc_current_sigrtmax", unknown []); - ("__libc_current_sigrtmin", unknown []); ] let big_kernel_lock = AddrOf (Cil.var (Cilfacade.create_var (makeGlobalVar "[big kernel lock]" intType))) @@ -750,7 +668,6 @@ let linux_kernel_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__kmalloc", special [__ "size" []; drop "flags" []] @@ fun size -> Malloc size); ("kzalloc", special [__ "size" []; drop "flags" []] @@ fun size -> Calloc {count = Cil.one; size}); ("usb_alloc_urb", special [__ "iso_packets" []; drop "mem_flags" []] @@ fun iso_packets -> Malloc MyCFG.unknown_exp); - ("ioctl", unknown (drop "fd" [] :: drop "request" [] :: VarArgs (drop' [r_deep; w_deep]))); ] (** Goblint functions. *) @@ -761,7 +678,6 @@ let goblint_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__goblint_assert", special [__ "exp" []] @@ fun exp -> Assert { exp; check = true; refine = get_bool "sem.assert.refine" }); ("__goblint_split_begin", unknown [drop "exp" []]); ("__goblint_split_end", unknown [drop "exp" []]); - ("__goblint_bounded", special [__ "exp"[]] @@ fun exp -> Bounded { exp }); ] (** zstd functions. @@ -980,9 +896,9 @@ let math_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("scalbln", unknown [drop "arg" []; drop "exp" []]); ("scalblnf", unknown [drop "arg" []; drop "exp" []]); ("scalblnl", unknown [drop "arg" []; drop "exp" []]); - ("sqrt", special [__ "x" []] @@ fun x -> Math { fun_args = (Sqrt (FDouble, x)) }); - ("sqrtf", special [__ "x" []] @@ fun x -> Math { fun_args = (Sqrt (FFloat, x)) }); - ("sqrtl", special [__ "x" []] @@ fun x -> Math { fun_args = (Sqrt (FLongDouble, x)) }); + ("sqrt", unknown [drop "x" []]); + ("sqrtf", unknown [drop "x" []]); + ("sqrtl", unknown [drop "x" []]); ("tgamma", unknown [drop "x" []]); ("tgammaf", unknown [drop "x" []]); ("tgammal", unknown [drop "x" []]); @@ -1016,22 +932,6 @@ let svcomp_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("__VERIFIER_atomic_end", special [] @@ Unlock verifier_atomic); ("__VERIFIER_nondet_loff_t", unknown []); (* cannot give it in sv-comp.c without including stdlib or similar *) ("__VERIFIER_nondet_int", unknown []); (* declare invalidate actions to prevent invalidating globals when extern in regression tests *) - ("__VERIFIER_nondet_size_t", unknown []); (* cannot give it in sv-comp.c without including stdlib or similar *) - ] - -let rtnl_lock = AddrOf (Cil.var (Cilfacade.create_var (makeGlobalVar "[rtnl_lock]" intType))) - -(** LDV Klever functions. *) -let klever_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ - ("pthread_create_N", special [__ "thread" [w]; drop "attr" [r]; __ "start_routine" [s]; __ "arg" []] @@ fun thread start_routine arg -> ThreadCreate { thread; start_routine; arg; multiple = true }); - ("pthread_join_N", special [__ "thread" []; __ "retval" [w]] @@ fun thread retval -> ThreadJoin {thread; ret_var = retval}); - ("ldv_mutex_model_lock", special [__ "lock" []; drop "sign" []] @@ fun lock -> Lock { lock; try_ = get_bool "sem.lock.fail"; write = true; return_on_success = true }); - ("ldv_mutex_model_unlock", special [__ "lock" []; drop "sign" []] @@ fun lock -> Unlock lock); - ("ldv_spin_model_lock", unknown [drop "sign" []]); - ("ldv_spin_model_unlock", unknown [drop "sign" []]); - ("rtnl_lock", special [] @@ Lock { lock = rtnl_lock; try_ = false; write = true; return_on_success = true }); - ("rtnl_unlock", special [] @@ Unlock rtnl_lock); - ("__rtnl_unlock", special [] @@ Unlock rtnl_lock); ] let ncurses_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ @@ -1090,11 +990,6 @@ let zlib_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ ("deflateInit2_", unknown [drop "strm" [r_deep; w_deep]; drop "level" []; drop "method" []; drop "windowBits" []; drop "memLevel" []; drop "strategy" []; drop "version" [r]; drop "stream_size" []]); ("deflateEnd", unknown [drop "strm" [f_deep]]); ("zlibVersion", unknown []); - ("zError", unknown [drop "err" []]); - ("gzopen", unknown [drop "path" [r]; drop "mode" [r]]); - ("gzdopen", unknown [drop "fd" []; drop "mode" [r]]); - ("gzread", unknown [drop "file" [r_deep; w_deep]; drop "buf" [w]; drop "len" []]); - ("gzclose", unknown [drop "file" [f_deep]]); ] let liblzma_descs_list: (string * LibraryDesc.t) list = LibraryDsl.[ @@ -1119,7 +1014,6 @@ let libraries = Hashtbl.of_list [ ("linux-kernel", linux_kernel_descs_list); ("goblint", goblint_descs_list); ("sv-comp", svcomp_descs_list); - ("klever", klever_descs_list); ("ncurses", ncurses_descs_list); ("zstd", zstd_descs_list); ("pcre", pcre_descs_list); @@ -1265,74 +1159,89 @@ open Invalidate * We assume that no known functions that are reachable are executed/spawned. For that we use ThreadCreate above. *) (* WTF: why are argument numbers 1-indexed (in partition)? *) let invalidate_actions = [ - "__printf_chk", readsAll;(*safe*) - "printk", readsAll;(*safe*) - "__mutex_init", readsAll;(*safe*) - "__builtin___snprintf_chk", writes [1];(*keep [1]*) - "__vfprintf_chk", writes [1];(*keep [1]*) - "__builtin_va_arg", readsAll;(*safe*) - "__builtin_va_end", readsAll;(*safe*) - "__builtin_va_start", readsAll;(*safe*) - "__ctype_b_loc", readsAll;(*safe*) - "__errno", readsAll;(*safe*) - "__errno_location", readsAll;(*safe*) - "__strdup", readsAll;(*safe*) - "strtoul__extinline", readsAll;(*safe*) - "atoi__extinline", readsAll;(*safe*) - "_IO_getc", writesAll;(*unsafe*) - "_strlen", readsAll;(*safe*) - "stat__extinline", writesAllButFirst 1 readsAll;(*drop 1*) - "lstat__extinline", writesAllButFirst 1 readsAll;(*drop 1*) - "__open_alias", readsAll;(*safe*) - "__open_2", readsAll;(*safe*) - "fstat__extinline", writesAll;(*unsafe*) - "scandir", writes [1;3;4];(*keep [1;3;4]*) - "bindtextdomain", readsAll;(*safe*) - "textdomain", readsAll;(*safe*) - "dcgettext", readsAll;(*safe*) - "__getdelim", writes [3];(*keep [3]*) - "__h_errno_location", readsAll;(*safe*) - "__fxstat", readsAll;(*safe*) - (* RPC library start *) - "clntudp_create", writesAllButFirst 3 readsAll;(*drop 3*) - "svctcp_create", readsAll;(*safe*) - "clntudp_bufcreate", writesAll;(*unsafe*) - "authunix_create_default", readsAll;(*safe*) - "clnt_broadcast", writesAll;(*unsafe*) - "clnt_sperrno", readsAll;(*safe*) - "pmap_unset", writesAll;(*unsafe*) - "svcudp_create", readsAll;(*safe*) - "svc_register", writesAll;(*unsafe*) - "svc_run", writesAll;(*unsafe*) - (* RPC library end *) - "__builtin___vsnprintf", writesAllButFirst 3 readsAll; (*drop 3*) - "__builtin___vsnprintf_chk", writesAllButFirst 3 readsAll; (*drop 3*) - "__error", readsAll; (*safe*) - "__maskrune", writesAll; (*unsafe*) - "__tolower", readsAll; (*safe*) - "BF_cfb64_encrypt", writes [1;3;4;5]; (*keep [1;3;4,5]*) - "BZ2_bzBuffToBuffDecompress", writes [3;4]; (*keep [3;4]*) - "uncompress", writes [3;4]; (*keep [3;4]*) - "__xstat", writes [3]; (*keep [1]*) - "__lxstat", writes [3]; (*keep [1]*) - "BZ2_bzBuffToBuffCompress", writes [3;4]; (*keep [3;4]*) - "compress2", writes [3]; (*keep [3]*) - "__toupper", readsAll; (*safe*) - "BF_set_key", writes [3]; (*keep [3]*) - "PL_NewHashTable", readsAll; (*safe*) - "assert_failed", readsAll; (*safe*) - "__builtin_va_arg_pack_len", readsAll; - "__open_too_many_args", readsAll; - "usb_submit_urb", readsAll; (* first argument is written to but according to specification must not be read from anymore *) - "dev_driver_string", readsAll; - "__spin_lock_init", writes [1]; - "kmem_cache_create", readsAll; - "idr_pre_get", readsAll; - "zil_replay", writes [1;2;3;5]; - (* ddverify *) - "sema_init", readsAll; - "__goblint_assume_join", readsAll; -] + "__printf_chk", readsAll;(*safe*) + "printk", readsAll;(*safe*) + "__mutex_init", readsAll;(*safe*) + "__builtin___snprintf_chk", writes [1];(*keep [1]*) + "__vfprintf_chk", writes [1];(*keep [1]*) + "__builtin_va_arg", readsAll;(*safe*) + "__builtin_va_end", readsAll;(*safe*) + "__builtin_va_start", readsAll;(*safe*) + "__ctype_b_loc", readsAll;(*safe*) + "__errno", readsAll;(*safe*) + "__errno_location", readsAll;(*safe*) + "__strdup", readsAll;(*safe*) + "strtoul__extinline", readsAll;(*safe*) + "readdir_r", writesAll;(*unsafe*) + "atoi__extinline", readsAll;(*safe*) + "_IO_getc", writesAll;(*unsafe*) + "pipe", writesAll;(*unsafe*) + "strerror_r", writesAll;(*unsafe*) + "raise", writesAll;(*unsafe*) + "_strlen", readsAll;(*safe*) + "stat__extinline", writesAllButFirst 1 readsAll;(*drop 1*) + "lstat__extinline", writesAllButFirst 1 readsAll;(*drop 1*) + "waitpid", readsAll;(*safe*) + "__open_alias", readsAll;(*safe*) + "__open_2", readsAll;(*safe*) + "ioctl", writesAll;(*unsafe*) + "fstat__extinline", writesAll;(*unsafe*) + "scandir", writes [1;3;4];(*keep [1;3;4]*) + "sigwait", writesAllButFirst 1 readsAll;(*drop 1*) + "bindtextdomain", readsAll;(*safe*) + "textdomain", readsAll;(*safe*) + "dcgettext", readsAll;(*safe*) + "putw", readsAll;(*safe*) + "__getdelim", writes [3];(*keep [3]*) + "__h_errno_location", readsAll;(*safe*) + "__fxstat", readsAll;(*safe*) + "openlog", readsAll;(*safe*) + "umask", readsAll;(*safe*) + "clntudp_create", writesAllButFirst 3 readsAll;(*drop 3*) + "svctcp_create", readsAll;(*safe*) + "clntudp_bufcreate", writesAll;(*unsafe*) + "authunix_create_default", readsAll;(*safe*) + "clnt_broadcast", writesAll;(*unsafe*) + "clnt_sperrno", readsAll;(*safe*) + "pmap_unset", writesAll;(*unsafe*) + "svcudp_create", readsAll;(*safe*) + "svc_register", writesAll;(*unsafe*) + "svc_run", writesAll;(*unsafe*) + "dup", readsAll; (*safe*) + "__builtin___vsnprintf", writesAllButFirst 3 readsAll; (*drop 3*) + "__builtin___vsnprintf_chk", writesAllButFirst 3 readsAll; (*drop 3*) + "__error", readsAll; (*safe*) + "__maskrune", writesAll; (*unsafe*) + "times", writesAll; (*unsafe*) + "timespec_get", writes [1]; + "__tolower", readsAll; (*safe*) + "signal", writesAll; (*unsafe*) + "BF_cfb64_encrypt", writes [1;3;4;5]; (*keep [1;3;4,5]*) + "BZ2_bzBuffToBuffDecompress", writes [3;4]; (*keep [3;4]*) + "uncompress", writes [3;4]; (*keep [3;4]*) + "__xstat", writes [3]; (*keep [1]*) + "__lxstat", writes [3]; (*keep [1]*) + "remove", readsAll; + "BZ2_bzBuffToBuffCompress", writes [3;4]; (*keep [3;4]*) + "compress2", writes [3]; (*keep [3]*) + "__toupper", readsAll; (*safe*) + "BF_set_key", writes [3]; (*keep [3]*) + "PL_NewHashTable", readsAll; (*safe*) + "assert_failed", readsAll; (*safe*) + "munmap", readsAll;(*safe*) + "mmap", readsAll;(*safe*) + "__builtin_va_arg_pack_len", readsAll; + "__open_too_many_args", readsAll; + "usb_submit_urb", readsAll; (* first argument is written to but according to specification must not be read from anymore *) + "dev_driver_string", readsAll; + "__spin_lock_init", writes [1]; + "kmem_cache_create", readsAll; + "idr_pre_get", readsAll; + "zil_replay", writes [1;2;3;5]; + (* ddverify *) + "sema_init", readsAll; + "__goblint_assume_join", readsAll; + ] let invalidate_actions = let tbl = Hashtbl.create 113 in diff --git a/src/util/library/libraryFunctions.mli b/src/analyses/libraryFunctions.mli similarity index 100% rename from src/util/library/libraryFunctions.mli rename to src/analyses/libraryFunctions.mli diff --git a/src/analyses/locksetAnalysis.ml b/src/analyses/locksetAnalysis.ml index 6a816b9e6c9..2e9e08f03d5 100644 --- a/src/analyses/locksetAnalysis.ml +++ b/src/analyses/locksetAnalysis.ml @@ -18,7 +18,7 @@ struct module C = D let startstate v = D.empty () - let threadenter ctx ~multiple lval f args = [D.empty ()] + let threadenter ctx lval f args = [D.empty ()] let exitstate v = D.empty () end diff --git a/src/analyses/loopTermination.ml b/src/analyses/loopTermination.ml deleted file mode 100644 index 857b6189d0c..00000000000 --- a/src/analyses/loopTermination.ml +++ /dev/null @@ -1,87 +0,0 @@ -(** Termination analysis for loops and [goto] statements ([termination]). *) - -open Analyses -open GoblintCil -open TerminationPreprocessing - -(** Contains all loop counter variables (varinfo) and maps them to their corresponding loop statement. *) -let loop_counters : stmt VarToStmt.t ref = ref VarToStmt.empty - -(** Checks whether a variable can be bounded. *) -let check_bounded ctx varinfo = - let open IntDomain.IntDomTuple in - let exp = Lval (Var varinfo, NoOffset) in - match ctx.ask (EvalInt exp) with - | `Top -> false - | `Lifted v -> not (is_top_of (ikind v) v) - | `Bot -> failwith "Loop counter variable is Bot." - -(** We want to record termination information of loops and use the loop - * statements for that. We use this lifting because we need to have a - * lattice. *) -module Statements = Lattice.Flat (CilType.Stmt) - -(** The termination analysis considering loops and gotos *) -module Spec : Analyses.MCPSpec = -struct - - include Analyses.IdentitySpec - - let name () = "termination" - - module D = Lattice.Unit - module C = D - module V = struct - include UnitV - let is_write_only _ = true - end - module G = MapDomain.MapBot (Statements) (BoolDomain.MustBool) - - let startstate _ = () - let exitstate = startstate - - let find_loop ~loop_counter = - VarToStmt.find loop_counter !loop_counters - - (** Recognizes a call of [__goblint_bounded] to check the EvalInt of the - * respective loop counter variable at that position. *) - let special ctx (lval : lval option) (f : varinfo) (arglist : exp list) = - if !AnalysisState.postsolving then - match f.vname, arglist with - "__goblint_bounded", [Lval (Var loop_counter, NoOffset)] -> - (try - let loop_statement = find_loop ~loop_counter in - let is_bounded = check_bounded ctx loop_counter in - ctx.sideg () (G.add (`Lifted loop_statement) is_bounded (ctx.global ())); - (* In case the loop is not bounded, a warning is created. *) - if not (is_bounded) then ( - M.warn ~loc:(M.Location.CilLocation (Cilfacade.get_stmtLoc loop_statement)) ~category:Termination "The program might not terminate! (Loop analysis)" - ); - () - with Not_found -> - failwith "Encountered a call to __goblint_bounded with an unknown loop counter variable.") - | _ -> () - else () - - let query ctx (type a) (q: a Queries.t): a Queries.result = - match q with - | Queries.MustTermLoop loop_statement -> - let multithreaded = ctx.ask Queries.IsEverMultiThreaded in - (not multithreaded) - && (match G.find_opt (`Lifted loop_statement) (ctx.global ()) with - Some b -> b - | None -> false) - | Queries.MustTermAllLoops -> - let multithreaded = ctx.ask Queries.IsEverMultiThreaded in - if multithreaded then ( - M.warn ~category:Termination "The program might not terminate! (Multithreaded)\n"; - false) - else - G.for_all (fun _ term_info -> term_info) (ctx.global ()) - | _ -> Queries.Result.top q - -end - -let () = - Cilfacade.register_preprocess (Spec.name ()) (new loopCounterVisitor loop_counters); - MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/analyses/mCP.ml b/src/analyses/mCP.ml index 50f6d5409b2..9eb21b77ef5 100644 --- a/src/analyses/mCP.ml +++ b/src/analyses/mCP.ml @@ -140,9 +140,9 @@ struct f ((k,v::a')::a) b in f [] xs - let do_spawns ctx (xs:(varinfo * (lval option * exp list * bool)) list) = + let do_spawns ctx (xs:(varinfo * (lval option * exp list)) list) = let spawn_one v d = - List.iter (fun (lval, args, multiple) -> ctx.spawn ~multiple lval v args) d + List.iter (fun (lval, args) -> ctx.spawn lval v args) d in if get_bool "exp.single-threaded" then M.msg_final Error ~category:Unsound "Thread not spawned" @@ -324,8 +324,8 @@ struct and outer_ctx tfname ?spawns ?sides ?emits ctx = let spawn = match spawns with - | Some spawns -> (fun ?(multiple=false) l v a -> spawns := (v,(l,a,multiple)) :: !spawns) - | None -> (fun ?(multiple=false) v d -> failwith ("Cannot \"spawn\" in " ^ tfname ^ " context.")) + | Some spawns -> (fun l v a -> spawns := (v,(l,a)) :: !spawns) + | None -> (fun v d -> failwith ("Cannot \"spawn\" in " ^ tfname ^ " context.")) in let sideg = match sides with | Some sides -> (fun v g -> sides := (v, (!WideningTokens.side_tokens, g)) :: !sides) @@ -567,20 +567,20 @@ struct let d = do_emits ctx !emits d q in if q then raise Deadcode else d - let threadenter (ctx:(D.t, G.t, C.t, V.t) ctx) ~multiple lval f a = + let threadenter (ctx:(D.t, G.t, C.t, V.t) ctx) lval f a = let sides = ref [] in let emits = ref [] in let ctx'' = outer_ctx "threadenter" ~sides ~emits ctx in let f (n,(module S:MCPSpec),d) = let ctx' : (S.D.t, S.G.t, S.C.t, S.V.t) ctx = inner_ctx "threadenter" ctx'' n d in - map (fun d -> (n, repr d)) @@ (S.threadenter ~multiple) ctx' lval f a + map (fun d -> (n, repr d)) @@ S.threadenter ctx' lval f a in let css = map f @@ spec_list ctx.local in do_sideg ctx !sides; (* TODO: this do_emits is now different from everything else *) map (fun d -> do_emits ctx !emits d false) @@ map topo_sort_an @@ n_cartesian_product css - let threadspawn (ctx:(D.t, G.t, C.t, V.t) ctx) ~multiple lval f a fctx = + let threadspawn (ctx:(D.t, G.t, C.t, V.t) ctx) lval f a fctx = let sides = ref [] in let emits = ref [] in let ctx'' = outer_ctx "threadspawn" ~sides ~emits ctx in @@ -588,7 +588,7 @@ struct let f post_all (n,(module S:MCPSpec),(d,fd)) = let ctx' : (S.D.t, S.G.t, S.C.t, S.V.t) ctx = inner_ctx "threadspawn" ~post_all ctx'' n d in let fctx' : (S.D.t, S.G.t, S.C.t, S.V.t) ctx = inner_ctx "threadspawn" ~post_all fctx'' n fd in - n, repr @@ S.threadspawn ~multiple ctx' lval f a fctx' + n, repr @@ S.threadspawn ctx' lval f a fctx' in let d, q = map_deadcode f @@ spec_list2 ctx.local fctx.local in do_sideg ctx !sides; diff --git a/src/analyses/mCPRegistry.ml b/src/analyses/mCPRegistry.ml index 3961bc4d60b..810da827ff1 100644 --- a/src/analyses/mCPRegistry.ml +++ b/src/analyses/mCPRegistry.ml @@ -215,7 +215,7 @@ struct let arbitrary () = let arbs = map (fun (n, (module D: Printable.S)) -> QCheck.map ~rev:(fun (_, o) -> obj o) (fun x -> (n, repr x)) @@ D.arbitrary ()) @@ domain_list () in - GobQCheck.Arbitrary.sequence arbs + MyCheck.Arbitrary.sequence arbs let relift = unop_map (fun (module S: Printable.S) x -> Obj.repr (S.relift (Obj.obj x))) end @@ -426,7 +426,7 @@ end module DomVariantLattice (DLSpec : DomainListLatticeSpec) = struct - include Lattice.LiftConf (struct include Printable.DefaultConf let expand1 = false end) (DomVariantLattice0 (DLSpec)) + include Lattice.Lift (DomVariantLattice0 (DLSpec)) (Printable.DefaultNames) let name () = "MCP.G" end diff --git a/src/analyses/mallocFresh.ml b/src/analyses/mallocFresh.ml index d1314d50092..3a501fc72f7 100644 --- a/src/analyses/mallocFresh.ml +++ b/src/analyses/mallocFresh.ml @@ -52,10 +52,10 @@ struct | None -> ctx.local | Some lval -> assign_lval (Analyses.ask_of_ctx ctx) lval ctx.local - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = [D.empty ()] - let threadspawn ctx ~multiple lval f args fctx = + let threadspawn ctx lval f args fctx = D.empty () module A = diff --git a/src/analyses/malloc_null.ml b/src/analyses/malloc_null.ml index f993db0c6ea..4d5871cb807 100644 --- a/src/analyses/malloc_null.ml +++ b/src/analyses/malloc_null.ml @@ -215,8 +215,8 @@ struct let name () = "malloc_null" let startstate v = D.empty () - let threadenter ctx ~multiple lval f args = [D.empty ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.empty ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.empty () let init marshal = diff --git a/src/analyses/memLeak.ml b/src/analyses/memLeak.ml index 456d434be78..dbaa2d69fc7 100644 --- a/src/analyses/memLeak.ml +++ b/src/analyses/memLeak.ml @@ -6,7 +6,7 @@ open MessageCategory open AnalysisStateUtil module ToppedVarInfoSet = SetDomain.ToppedSet(CilType.Varinfo)(struct let topname = "All Heap Variables" end) -module WasMallocCalled = BoolDomain.MayBool + module Spec : Analyses.MCPSpec = struct include Analyses.IdentitySpec @@ -14,188 +14,35 @@ struct let name () = "memLeak" module D = ToppedVarInfoSet - module C = D - module P = IdentityP (D) - - module V = UnitV - module G = WasMallocCalled - - let context _ d = d - - let must_be_single_threaded ~since_start ctx = - ctx.ask (Queries.MustBeSingleThreaded { since_start }) + module C = Lattice.Unit - let was_malloc_called ctx = - ctx.global () + let context _ _ = () (* HELPER FUNCTIONS *) - let get_global_vars () = - List.filter_map (function GVar (v, _, _) | GVarDecl (v, _) -> Some v | _ -> None) !Cilfacade.current_file.globals - - let get_global_struct_ptr_vars () = - get_global_vars () - |> List.filter (fun v -> - match unrollType v.vtype with - | TPtr (TComp (ci,_), _) - | TPtr ((TNamed ({ttype = TComp (ci, _); _}, _)), _) -> ci.cstruct - | TComp (_, _) - | (TNamed ({ttype = TComp _; _}, _)) -> false - | _ -> false) - - let get_global_struct_non_ptr_vars () = - get_global_vars () - |> List.filter (fun v -> - match unrollType v.vtype with - | TComp (ci, _) - | (TNamed ({ttype = TComp (ci,_); _}, _)) -> ci.cstruct - | _ -> false) - - let get_reachable_mem_from_globals (global_vars:varinfo list) ctx = - global_vars - |> List.map (fun v -> Lval (Var v, NoOffset)) - |> List.filter_map (fun exp -> - match ctx.ask (Queries.MayPointTo exp) with - | a when not (Queries.AD.is_top a) && Queries.AD.cardinal a = 1 -> - begin match List.hd @@ Queries.AD.elements a with - | Queries.AD.Addr.Addr (v, _) when (ctx.ask (Queries.IsHeapVar v)) && not (ctx.ask (Queries.IsMultiple v)) -> Some v - | _ -> None - end - | _ -> None) - - let rec get_reachable_mem_from_str_ptr_globals (global_struct_ptr_vars:varinfo list) ctx = - let eval_value_of_heap_var heap_var = - match ctx.ask (Queries.EvalValue (Lval (Var heap_var, NoOffset))) with - | a when not (Queries.VD.is_top a) -> - begin match a with - | Struct s -> - List.fold_left (fun acc f -> - if isPointerType f.ftype then - begin match ValueDomain.Structs.get s f with - | Queries.VD.Address a when not (Queries.AD.is_top a) && Queries.AD.cardinal a = 1 -> - let reachable_from_addr_set = - Queries.AD.fold (fun addr acc -> - match addr with - | Queries.AD.Addr.Addr (v, _) -> (v :: get_reachable_mem_from_str_ptr_globals [v] ctx) @ acc - | _ -> acc - ) a [] - in - reachable_from_addr_set @ acc - | _ -> acc - end - else acc - ) [] (ValueDomain.Structs.keys s) - | _ -> [] - end - | _ -> [] - in - let get_pts_of_non_heap_ptr_var var = - match ctx.ask (Queries.MayPointTo (Lval (Var var, NoOffset))) with - | a when not (Queries.AD.is_top a) && Queries.AD.cardinal a = 1 -> - begin match List.hd @@ Queries.AD.elements a with - | Queries.AD.Addr.Addr (v, _) when (ctx.ask (Queries.IsHeapVar v)) && not (ctx.ask (Queries.IsMultiple v)) -> v :: (eval_value_of_heap_var v) - | Queries.AD.Addr.Addr (v, _) when not (ctx.ask (Queries.IsAllocVar v)) && isPointerType v.vtype -> get_reachable_mem_from_str_ptr_globals [v] ctx - | _ -> [] - end - | _ -> [] - in - global_struct_ptr_vars - |> List.fold_left (fun acc var -> - if ctx.ask (Queries.IsHeapVar var) then (eval_value_of_heap_var var) @ acc - else if not (ctx.ask (Queries.IsAllocVar var)) && isPointerType var.vtype then (get_pts_of_non_heap_ptr_var var) @ acc - else acc - ) [] - - let get_reachable_mem_from_str_non_ptr_globals (global_struct_non_ptr_vars:varinfo list) ctx = - global_struct_non_ptr_vars - (* Filter out global struct vars that don't have pointer fields *) - |> List.filter_map (fun v -> - match ctx.ask (Queries.EvalValue (Lval (Var v, NoOffset))) with - | a when not (Queries.VD.is_top a) -> - begin match a with - | Queries.VD.Struct s -> - let struct_fields = ValueDomain.Structs.keys s in - let ptr_struct_fields = List.filter (fun f -> isPointerType f.ftype) struct_fields in - if ptr_struct_fields = [] then None else Some (s, ptr_struct_fields) - | _ -> None - end - | _ -> None - ) - |> List.fold_left (fun acc_struct (s, fields) -> - let reachable_from_fields = - List.fold_left (fun acc_field field -> - match ValueDomain.Structs.get s field with - | Queries.VD.Address a -> - let reachable_from_addr_set = - Queries.AD.fold (fun addr acc_addr -> - match addr with - | Queries.AD.Addr.Addr (v, _) -> - let reachable_from_v = Queries.AD.of_list (List.map (fun v -> Queries.AD.Addr.Addr (v, `NoOffset)) (get_reachable_mem_from_str_ptr_globals [v] ctx)) in - Queries.AD.join (Queries.AD.add addr reachable_from_v) acc_addr - | _ -> acc_addr - ) a (Queries.AD.empty ()) - in (Queries.AD.to_var_may reachable_from_addr_set) @ acc_field - | _ -> acc_field - ) [] fields - in - reachable_from_fields @ acc_struct - ) [] - - let warn_for_multi_threaded_due_to_abort ctx = - let malloc_called = was_malloc_called ctx in - if not (must_be_single_threaded ctx ~since_start:true) && malloc_called then ( + let warn_for_multi_threaded ctx = + if not (ctx.ask (Queries.MustBeSingleThreaded { since_start = true })) then ( set_mem_safety_flag InvalidMemTrack; set_mem_safety_flag InvalidMemcleanup; - M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "Program aborted while running in multi-threaded mode. A memory leak might occur" - ) - - (* If [is_return] is set to [true], then a thread return occurred, else a thread exit *) - let warn_for_thread_return_or_exit ctx is_return = - if not (ToppedVarInfoSet.is_empty ctx.local) then ( - set_mem_safety_flag InvalidMemTrack; - set_mem_safety_flag InvalidMemcleanup; - let current_thread = ctx.ask (Queries.CurrentThreadId) in - M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "Memory may be leaked at thread %s for thread %a" (if is_return then "return" else "exit") ThreadIdDomain.ThreadLifted.pretty current_thread + M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "Program isn't running in single-threaded mode. A memory leak might occur due to multi-threading" ) let check_for_mem_leak ?(assert_exp_imprecise = false) ?(exp = None) ctx = - let allocated_mem = ctx.local in - if not (D.is_empty allocated_mem) then - let reachable_mem_from_non_struct_globals = D.of_list (get_reachable_mem_from_globals (get_global_vars ()) ctx) in - let reachable_mem_from_struct_ptr_globals = D.of_list (get_reachable_mem_from_str_ptr_globals (get_global_struct_ptr_vars ()) ctx) in - let reachable_mem_from_struct_non_ptr_globals = D.of_list (get_reachable_mem_from_str_non_ptr_globals (get_global_struct_non_ptr_vars ()) ctx) in - let reachable_mem_from_struct_globals = D.join reachable_mem_from_struct_ptr_globals reachable_mem_from_struct_non_ptr_globals in - let reachable_mem = D.join reachable_mem_from_non_struct_globals reachable_mem_from_struct_globals in - (* Check and warn if there's unreachable allocated memory at program exit *) - let allocated_and_unreachable_mem = D.diff allocated_mem reachable_mem in - if not (D.is_empty allocated_and_unreachable_mem) then ( - set_mem_safety_flag InvalidMemTrack; - M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "There is unreachable allocated heap memory at program exit. A memory leak might occur for the alloc vars %a\n" (Pretty.d_list ", " CilType.Varinfo.pretty) (D.elements allocated_and_unreachable_mem) - ); - (* Check and warn if some of the allocated memory is not deallocated at program exit *) + let state = ctx.local in + if not @@ D.is_empty state then match assert_exp_imprecise, exp with | true, Some exp -> + set_mem_safety_flag InvalidMemTrack; set_mem_safety_flag InvalidMemcleanup; - M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "Assert expression %a is unknown. Memory leak might possibly occur for heap variables: %a" d_exp exp D.pretty allocated_mem + M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "assert expression %a is unknown. Memory leak might possibly occur for heap variables: %a" d_exp exp D.pretty state | _ -> + set_mem_safety_flag InvalidMemTrack; set_mem_safety_flag InvalidMemcleanup; - M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "Memory leak detected for heap variables" + M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "Memory leak detected for heap variables: %a" D.pretty state (* TRANSFER FUNCTIONS *) let return ctx (exp:exp option) (f:fundec) : D.t = - (* Check for a valid-memcleanup and memtrack violation in a multi-threaded setting *) - (* The check for multi-threadedness is to ensure that valid-memtrack and valid-memclenaup are treated separately for single-threaded programs *) - if (ctx.ask (Queries.MayBeThreadReturn) && not (must_be_single_threaded ctx ~since_start:true)) then ( - warn_for_thread_return_or_exit ctx true - ); (* Returning from "main" is one possible program exit => need to check for memory leaks *) - if f.svar.vname = "main" then ( - check_for_mem_leak ctx; - if not (must_be_single_threaded ctx ~since_start:false) && was_malloc_called ctx then begin - set_mem_safety_flag InvalidMemTrack; - set_mem_safety_flag InvalidMemcleanup; - M.warn ~category:(Behavior (Undefined MemoryLeak)) ~tags:[CWE 401] "Possible memory leak: Memory was allocated in a multithreaded program, but not all threads are joined." - end - ); + if f.svar.vname = "main" then check_for_mem_leak ctx; ctx.local let special ctx (lval:lval option) (f:varinfo) (arglist:exp list) : D.t = @@ -205,58 +52,47 @@ struct | Malloc _ | Calloc _ | Realloc _ -> - ctx.sideg () true; + (* Warn about multi-threaded programs as soon as we encounter a dynamic memory allocation function *) + warn_for_multi_threaded ctx; begin match ctx.ask (Queries.AllocVar {on_stack = false}) with - | `Lifted var -> - ToppedVarInfoSet.add var state + | `Lifted var -> D.add var state | _ -> state end | Free ptr -> begin match ctx.ask (Queries.MayPointTo ptr) with - | ad when (not (Queries.AD.is_top ad)) && Queries.AD.cardinal ad = 1 -> + | ad when not (Queries.AD.is_top ad) && Queries.AD.cardinal ad = 1 -> (* Note: Need to always set "ana.malloc.unique_address_count" to a value > 0 *) begin match Queries.AD.choose ad with - | Queries.AD.Addr.Addr (v,_) when ctx.ask (Queries.IsAllocVar v) && ctx.ask (Queries.IsHeapVar v) && not @@ ctx.ask (Queries.IsMultiple v) -> - ToppedVarInfoSet.remove v ctx.local - | _ -> ctx.local + | Queries.AD.Addr.Addr (v,_) when ctx.ask (Queries.IsAllocVar v) && ctx.ask (Queries.IsHeapVar v) && not @@ ctx.ask (Queries.IsMultiple v) -> D.remove v state (* Unique pointed to heap vars *) + | _ -> state end - | _ -> ctx.local + | _ -> state end | Abort -> + (* An "Abort" special function indicates program exit => need to check for memory leaks *) check_for_mem_leak ctx; - (* Upon a call to the "Abort" special function in the multi-threaded case, we give up and conservatively warn *) - warn_for_multi_threaded_due_to_abort ctx; state | Assert { exp; _ } -> - begin match ctx.ask (Queries.EvalInt exp) with + let warn_for_assert_exp = + match ctx.ask (Queries.EvalInt exp) with | a when Queries.ID.is_bot a -> M.warn ~category:Assert "assert expression %a is bottom" d_exp exp | a -> begin match Queries.ID.to_bool a with - | Some true -> () - | Some false -> + | Some b -> (* If we know for sure that the expression in "assert" is false => need to check for memory leaks *) - warn_for_multi_threaded_due_to_abort ctx; - check_for_mem_leak ctx - | None -> - warn_for_multi_threaded_due_to_abort ctx; - check_for_mem_leak ctx ~assert_exp_imprecise:true ~exp:(Some exp) + if b = false then + check_for_mem_leak ctx + else () + | None -> check_for_mem_leak ctx ~assert_exp_imprecise:true ~exp:(Some exp) end - end; - state - | ThreadExit _ -> - begin match ctx.ask (Queries.CurrentThreadId) with - | `Lifted tid -> - warn_for_thread_return_or_exit ctx false - | _ -> () - end; + in + warn_for_assert_exp; state | _ -> state let startstate v = D.bot () let exitstate v = D.top () - - let threadenter ctx ~multiple lval f args = [D.bot ()] end let _ = - MCP.register_analysis (module Spec : MCPSpec) + MCP.register_analysis (module Spec : MCPSpec) \ No newline at end of file diff --git a/src/analyses/memOutOfBounds.ml b/src/analyses/memOutOfBounds.ml index db6faf48773..6fa0ae55319 100644 --- a/src/analyses/memOutOfBounds.ml +++ b/src/analyses/memOutOfBounds.ml @@ -69,17 +69,17 @@ struct in host_contains_a_ptr host || offset_contains_a_ptr offset - let points_to_alloc_only ctx ptr = + let points_to_heap_only ctx ptr = match ctx.ask (Queries.MayPointTo ptr) with | a when not (Queries.AD.is_top a)-> Queries.AD.for_all (function - | Addr (v, o) -> ctx.ask (Queries.IsAllocVar v) + | Addr (v, o) -> ctx.ask (Queries.IsHeapVar v) | _ -> false ) a | _ -> false let get_size_of_ptr_target ctx ptr = - if points_to_alloc_only ctx ptr then + if points_to_heap_only ctx ptr then (* Ask for BlobSize from the base address (the second component being set to true) in order to avoid BlobSize giving us bot *) ctx.ask (Queries.BlobSize {exp = ptr; base_address = true}) else diff --git a/src/analyses/modifiedSinceSetjmp.ml b/src/analyses/modifiedSinceLongjmp.ml similarity index 94% rename from src/analyses/modifiedSinceSetjmp.ml rename to src/analyses/modifiedSinceLongjmp.ml index 93e55b2a17f..5dae8748cb6 100644 --- a/src/analyses/modifiedSinceSetjmp.ml +++ b/src/analyses/modifiedSinceLongjmp.ml @@ -1,4 +1,6 @@ -(** Analysis of variables modified since [setjmp] ([modifiedSinceSetjmp]). *) +(** Analysis of variables modified since [setjmp] ([modifiedSinceLongjmp]). *) + +(* TODO: this name is wrong *) open GoblintCil open Analyses @@ -7,7 +9,7 @@ module Spec = struct include Analyses.IdentitySpec - let name () = "modifiedSinceSetjmp" + let name () = "modifiedSinceLongjmp" module D = JmpBufDomain.LocallyModifiedMap module VS = D.VarSet module C = Lattice.Unit @@ -55,7 +57,7 @@ struct ctx.local let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.bot ()] + let threadenter ctx lval f args = [D.bot ()] let exitstate v = D.top () let query ctx (type a) (q: a Queries.t): a Queries.result = diff --git a/src/analyses/mutexAnalysis.ml b/src/analyses/mutexAnalysis.ml index a13c8d6bfd7..ee050f55ca8 100644 --- a/src/analyses/mutexAnalysis.ml +++ b/src/analyses/mutexAnalysis.ml @@ -132,7 +132,7 @@ struct module G = struct - include Lattice.Lift2Conf (struct include Printable.DefaultConf let expand1 = false let expand2 = false end) (GProtecting) (GProtected) + include Lattice.Lift2 (GProtecting) (GProtected) (Printable.DefaultNames) let protecting = function | `Bot -> GProtecting.bot () diff --git a/src/analyses/mutexTypeAnalysis.ml b/src/analyses/mutexTypeAnalysis.ml index e640a261cdf..806c35f4645 100644 --- a/src/analyses/mutexTypeAnalysis.ml +++ b/src/analyses/mutexTypeAnalysis.ml @@ -65,8 +65,8 @@ struct | _ -> ctx.local let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.top ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.top ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.top () let query ctx (type a) (q: a Queries.t): a Queries.result = diff --git a/src/analyses/poisonVariables.ml b/src/analyses/poisonVariables.ml index 865cb928aaa..acd687835ef 100644 --- a/src/analyses/poisonVariables.ml +++ b/src/analyses/poisonVariables.ml @@ -65,7 +65,7 @@ struct VS.join au ctx.local let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.bot ()] + let threadenter ctx lval f args = [D.bot ()] let exitstate v = D.top () let event ctx e octx = diff --git a/src/analyses/pthreadSignals.ml b/src/analyses/pthreadSignals.ml index 70f1624922b..0b776282e81 100644 --- a/src/analyses/pthreadSignals.ml +++ b/src/analyses/pthreadSignals.ml @@ -73,7 +73,7 @@ struct | _ -> ctx.local let startstate v = Signals.empty () - let threadenter ctx ~multiple lval f args = [ctx.local] + let threadenter ctx lval f args = [ctx.local] let exitstate v = Signals.empty () end diff --git a/src/analyses/raceAnalysis.ml b/src/analyses/raceAnalysis.ml index 6b7217147e0..9c2272fabb0 100644 --- a/src/analyses/raceAnalysis.ml +++ b/src/analyses/raceAnalysis.ml @@ -194,7 +194,7 @@ struct module G = struct - include Lattice.Lift2Conf (struct include Printable.DefaultConf let expand1 = false let expand2 = false end) (OffsetTrie) (MemoSet) + include Lattice.Lift2 (OffsetTrie) (MemoSet) (Printable.DefaultNames) let access = function | `Bot -> OffsetTrie.bot () @@ -369,7 +369,7 @@ struct let special ctx (lvalOpt: lval option) (f:varinfo) (arglist:exp list) : D.t = (* perform shallow and deep invalidate according to Library descriptors *) let desc = LibraryFunctions.find f in - if List.mem LibraryDesc.ThreadUnsafe desc.attrs && ThreadFlag.is_currently_multi (Analyses.ask_of_ctx ctx) then ( + if List.mem LibraryDesc.ThreadUnsafe desc.attrs then ( let exp = Lval (Var f, NoOffset) in let conf = 110 in let kind = AccessKind.Call in diff --git a/src/analyses/region.ml b/src/analyses/region.ml index a6ffa54ed6f..6d2ae246c3c 100644 --- a/src/analyses/region.ml +++ b/src/analyses/region.ml @@ -109,7 +109,8 @@ struct let old_regpart = ctx.global () in let regpart, reg = match exp with | Some exp -> - Reg.assign (ReturnUtil.return_lval ()) exp (old_regpart, reg) + let module BS = (val Base.get_main ()) in + Reg.assign (BS.return_lval ()) exp (old_regpart, reg) | None -> (old_regpart, reg) in let regpart, reg = Reg.kill_vars locals (Reg.remove_vars locals (regpart, reg)) in @@ -142,11 +143,12 @@ struct match au with | `Lifted reg -> begin let old_regpart = ctx.global () in + let module BS = (val Base.get_main ()) in let regpart, reg = match lval with | None -> (old_regpart, reg) - | Some lval -> Reg.assign lval (AddrOf (ReturnUtil.return_lval ())) (old_regpart, reg) + | Some lval -> Reg.assign lval (AddrOf (BS.return_lval ())) (old_regpart, reg) in - let regpart, reg = Reg.remove_vars [ReturnUtil.return_varinfo ()] (regpart, reg) in + let regpart, reg = Reg.remove_vars [BS.return_varinfo ()] (regpart, reg) in if not (RegPart.leq regpart old_regpart) then ctx.sideg () regpart; `Lifted reg @@ -173,17 +175,9 @@ struct let startstate v = `Lifted (RegMap.bot ()) - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = [`Lifted (RegMap.bot ())] - let threadspawn ctx ~multiple lval f args fctx = - match ctx.local with - | `Lifted reg -> - let old_regpart = ctx.global () in - let regpart, reg = List.fold_right Reg.assign_escape args (old_regpart, reg) in - if not (RegPart.leq regpart old_regpart) then - ctx.sideg () regpart; - `Lifted reg - | x -> x + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = `Lifted (RegMap.bot ()) diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml new file mode 100644 index 00000000000..54ffcd26976 --- /dev/null +++ b/src/analyses/spec.ml @@ -0,0 +1,496 @@ +(** Analysis using finite automaton specification file ([spec]). + + @author Ralf Vogler + + @see Vogler, R. Verifying Regular Safety Properties of C Programs Using the Static Analyzer Goblint. Section 4. *) + +open Batteries +open GoblintCil +open Analyses + +module SC = SpecCore + +module Spec = +struct + include Analyses.DefaultSpec + + let name() = "spec" + module D = SpecDomain.Dom + module C = SpecDomain.Dom + + (* special variables *) + let return_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@return" Cil.voidType, `NoOffset + let global_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@global" Cil.voidType, `NoOffset + + (* spec data *) + let nodes = ref [] + let edges = ref [] + + let load_specfile () = + let specfile = GobConfig.get_string "ana.spec.file" in + if String.length specfile < 1 then failwith "You need to specify a specification file using --set ana.spec.file path/to/file.spec when using the spec analysis!"; + if not (Sys.file_exists specfile) then failwith @@ "The given spec-file ("^specfile^") doesn't exist (CWD is "^Sys.getcwd ()^")."; + let _nodes, _edges = SpecUtil.parseFile specfile in + nodes := _nodes; edges := _edges (* don't change -> no need to save them in domain *) + + (* module for encapsulating general spec checking functions used in multiple transfer functions (assign, special) *) + (* + .spec-format: + - The file contains two types of definitions: nodes and edges. The labels of nodes are output. The labels of edges are the constraints. + - The given nodes are warnings, which have an implicit back edge to the previous node if used as a target. + - Alternatively warnings can be specified like this: "node1 -w1,w2,w3> node2 ...1" (w1, w2 and w3 will be output when the transition is taken). + - The start node of the first transition is the start node of the automaton. + - End nodes are specified by "node -> end _". + - "_end" is the local warning for nodes that are not in an end state, _END is the warning at return ($ is the list of keys). + - An edge with '_' matches everything. + - Edges with "->>" (or "-w1,w2>>" etc.) are forwarding edges, which will continue matching the same statement for the target node. + *) + module SpecCheck = + struct + (* custom goto (D.goto is just for modifying) that checks if the target state is a warning and acts accordingly *) + let goto ?may:(may=false) ?change_state:(change_state=true) key state m ws = + let loc = (Option.get !Node.current_node)::(D.callstack m) in + let warn key m msg = + Str.global_replace (Str.regexp_string "$") (D.string_of_key key) msg + |> D.warn ~may:(D.is_may key m || D.is_unknown key m) + in + (* do transition warnings *) + List.iter (fun state -> match SC.warning state !nodes with Some msg -> warn key m msg | _ -> ()) ws; + match SC.warning state !nodes with + | Some msg -> + warn key m msg; + m (* no goto == implicit back edge *) + | None -> + M.debug ~category:Analyzer "GOTO %s: %s -> %s" (D.string_of_key key) (D.string_of_state key m) state; + if not change_state then m + else if may then D.may_goto key loc state m else D.goto key loc state m + + let equal_exp ctx spec_exp cil_exp = match spec_exp, cil_exp with + (* TODO match constants right away to avoid queries? *) + | `String a, Const(CStr (b,_)) -> a=b + (* | `String a, Const(CWStr xs as c) -> failwith "not implemented" *) + (* CWStr is done in base.ml, query only returns `Str if it's safe *) + | `String a, e -> (match ctx.ask (Queries.EvalStr e) with + | `Lifted b -> a = b + | _ -> M.debug ~category:Analyzer "EQUAL String Query: no result!"; false + ) + | `Regex a, e -> (match ctx.ask (Queries.EvalStr e) with + | `Lifted b -> Str.string_match (Str.regexp a) b 0 + | _ -> M.debug ~category:Analyzer "EQUAL Regex String Query: no result!"; false + ) + | `Bool a, e -> (match ctx.ask (Queries.EvalInt e) with + | b -> (match Queries.ID.to_bool b with Some b -> a=b | None -> false) + ) + | `Int a, e -> (match ctx.ask (Queries.EvalInt e) with + | b -> (match Queries.ID.to_int b with Some b -> (Int64.of_int a)=(IntOps.BigIntOps.to_int64 b) | None -> false) + ) + | `Float a, Const(CReal (b, fkind, str_opt)) -> a=b + | `Float a, _ -> M.debug ~category:Analyzer "EQUAL Float: unsupported!"; false + (* arg is a key. currently there can only be one key per constraint, so we already used it for lookup. TODO multiple keys? *) + | `Var a, b -> true + (* arg is a identifier we use for matching constraints. TODO save in domain *) + | `Ident a, b -> true + | `Error s, b -> failwith @@ "Spec error: "^s + (* wildcard matches anything *) + | `Free, b -> true + | a,b -> M.info ~category:Unsound "EQUAL? Unmatched case - assume true..."; true + + let check_constraint ctx get_key matches m new_a old_key (a,ws,fwd,b,c as edge) = + (* If we have come to a wildcard, we match it instantly, but since there is no way of determining a key + this only makes sense if fwd is true (TODO wildcard for global. TODO use old_key). We pass a state replacement as 'new_a', + which will be applied in the following checks. + Multiple forwarding wildcards are not allowed, i.e. new_a must be None, otherwise we end up in a loop. *) + if SC.is_wildcard c && fwd && new_a=None then Some (m,fwd,Some (b,a),old_key) (* replace b with a in the following checks *) + else + (* save original start state of the constraint (needed to detect reflexive edges) *) + let old_a = a in + (* Assume new_a *) + let a = match new_a with + | Some (x,y) when a=x -> y + | _ -> a + in + (* if we forward, we have to replace the starting state for the following constraints *) + let new_a = if fwd then Some (b,a) else None in + (* TODO how to detect the key?? use "$foo" as key, "foo" as var in constraint and "_" for anything we're not interested in. + What to do for multiple keys (e.g. $foo, $bar)? -> Only allow one key & one map per spec-file (e.g. only $ as a key) or implement multiple maps? *) + (* look inside the constraint if there is a key and if yes, return what it corresponds to *) + (* if we can't find a matching key, we use the global key *) + let key = get_key c |? Cil.var (fst global_var) in + (* ignore(printf "KEY: %a\n" d_plainlval key); *) + (* get possible keys that &lval may point to *) + let keys = D.keys_from_lval key (Analyses.ask_of_ctx ctx) in (* does MayPointTo query *) + let check_key (m,n) var = + (* M.debug ~category:Analyzer @@ "check_key: "^f.vname^"(...): "^D.string_of_entry var m; *) + let wildcard = SC.is_wildcard c && fwd && b<>"end" in + (* skip transitions we can't take b/c we're not in the right state *) + (* i.e. if not in map, we must be at the start node or otherwise we must be in one of the possible saved states *) + if not (D.mem var m) && a<>SC.startnode !edges || D.mem var m && not (D.may_in_state var a m) then ( + (* ignore(printf "SKIP %s: state: %s, a: %s at %i\n" f.vname (D.string_of_state var m) a (!Tracing.current_loc.line)); *) + (m,n) (* not in map -> initial state. TODO save initial state? *) + ) + (* edge must match the current state or be a wildcard transition (except those for end) *) + else if not (matches edge) && not wildcard then (m,n) + (* everything matches the constraint -> go to new state and increase counter *) + else + (* TODO if #Queries.MayPointTo > 1: each result is May, but all combined are Must *) + let may = (List.compare_length_with keys 1 > 0) in + (* do not change state for reflexive edges where the key is not assigned to (e.g. *$p = _) *) + let change_state = not (old_a=b && SC.get_lval c <> Some `Var) in + M.debug ~category:Analyzer "GOTO ~may:%B ~change_state:%B. %s -> %s: %s" may change_state a b (SC.stmt_to_string c); + let new_m = goto ~may:may ~change_state:change_state var b m ws in + (new_m,n+1) + in + (* do check for each varinfo and return the resulting domain if there has been at least one matching constraint *) + let new_m,n = List.fold_left check_key (m,0) keys in (* start with original domain and #transitions=0 *) + if n==0 then None (* no constraint matched the current state *) + else Some (new_m,fwd,new_a,Some key) (* return new domain and forwarding info *) + + let check ctx get_key matches = + let m = ctx.local in + (* go through constraints and return resulting domain for the first match *) + (* if no constraint matches, the unchanged domain is returned *) + (* repeat for target node if it is a forwarding edge *) + (* TODO what should be done if multiple constraints would match? *) + (* TODO ^^ for May-Sets multiple constraints could match and should be taken! *) + try + let rec check_fwd_loop m new_a old_key = (* TODO cycle detection? *) + let new_m,fwd,new_a,key = List.find_map (check_constraint ctx get_key matches m new_a old_key) !edges in + (* List.iter (fun x -> M.debug ~category:Analyzer (x^"\n")) (D.string_of_map new_m); *) + if fwd then M.debug ~category:Analyzer "FWD: %B, new_a: %s, old_key: %s" fwd (dump new_a) (dump old_key); + if fwd then check_fwd_loop new_m new_a key else new_m,key + in + (* now we get the new domain and the latest key that was used *) + let new_m,key = check_fwd_loop m None None in + (* List.iter (fun x -> M.debug ~category:Analyzer (x^"\n")) (D.string_of_map new_m); *) + (* next we have to check if there is a branch() transition we could take *) + let branch_edges = List.filter (fun (a,ws,fwd,b,c) -> SC.is_branch c) !edges in + (* just for the compiler: key is initialized with None, but changes once some constaint matches. If none match, we wouldn't be here but at catch Not_found. *) + match key with + | Some key -> + (* we need to pass the key to the branch function. There is no scheme for getting the key from the constraint, but we should have been forwarded and can use the old key. *) + let check_branch branches var = + (* only keep those branch_edges for which our key might be in the right state *) + let branch_edges = List.filter (fun (a,ws,fwd,b,c) -> D.may_in_state var a new_m) branch_edges in + (* M.debug ~category:Analyzer @@ D.string_of_entry var new_m^" -> branch_edges: "^String.concat "\n " @@ List.map (fun x -> SC.def_to_string (SC.Edge x)) branch_edges; *) + (* count should be a multiple of 2 (true/false), otherwise the spec is malformed *) + if List.length branch_edges mod 2 <> 0 then failwith "Spec is malformed: branch-transitions always need a true and a false case!" else + (* if nothing matches, just return new_m without branching *) + (* if List.is_empty branch_edges then Set.of_list new_m else *) + if List.is_empty branch_edges then Set.of_list ([new_m, Cil.integer 1, true]) else (* XX *) + (* unique set of (dom,exp,tv) used in branch *) + let do_branch branches (a,ws,fwd,b,c) = + let c_str = match SC.branch_exp c with Some (exp,tv) -> SC.exp_to_string exp | _ -> "" in + let c_str = Str.global_replace (Str.regexp_string "$key") "%e:key" c_str in (* TODO what should be used to specify the key? *) + (* TODO this somehow also prints the expression!? why?? *) + let c_exp = Formatcil.cExp c_str [("key", Fe (D.K.to_cil_exp var))] in (* use Fl for Lval instead? *) + (* TODO encode key in exp somehow *) + (* ignore(printf "BRANCH %a\n" d_plainexp c_exp); *) + ctx.split new_m [Events.SplitBranch (c_exp, true)]; + Set.add (new_m,c_exp,true) (Set.add (new_m,c_exp,false) branches) + in + List.fold_left do_branch branches branch_edges + in + let keys = D.keys_from_lval key (Analyses.ask_of_ctx ctx) in + let new_set = List.fold_left check_branch Set.empty keys in ignore(new_set); (* TODO refactor *) + (* List.of_enum (Set.enum new_set) *) + new_m (* XX *) + | None -> new_m + with Not_found -> m (* nothing matched -> no change *) + end + + (* queries *) + let query ctx (type a) (q: a Queries.t) = + match q with + | _ -> Queries.Result.top q + + let query_addrs ask exp = + match ask (Queries.MayPointTo exp) with + | ad when not (Queries.AD.is_top ad) -> Queries.AD.elements ad + | _ -> [] + + let eval_fv ask exp: varinfo option = + match query_addrs ask exp with + | [addr] -> Queries.AD.Addr.to_var_may addr + | _ -> None + + + (* transfer functions *) + let assign ctx (lval:lval) (rval:exp) : D.t = + (* ignore(printf "%a = %a\n" d_plainlval lval d_plainexp rval); *) + let get_key c = match SC.get_key_variant c with + | `Lval s -> + M.debug ~category:Analyzer "Key variant assign `Lval %s; %s" s (SC.stmt_to_string c); + (match SC.get_lval c, lval with + | Some `Var, _ -> Some lval + | Some `Ptr, (Mem Lval x, o) -> Some x (* TODO offset? *) + | _ -> None) + | _ -> None + in + let matches (a,ws,fwd,b,c) = + SC.equal_form (Some lval) c && + (* check for constraints *p = _ where p is the key *) + match lval, SC.get_lval c with + | (Mem Lval x, o), Some `Ptr when SpecCheck.equal_exp ctx (SC.get_rval c) rval -> + let keys = D.keys_from_lval x (Analyses.ask_of_ctx ctx) in + if List.compare_length_with keys 1 <> 0 then failwith "not implemented" + else true + | _ -> false (* nothing to do *) + in + let m = SpecCheck.check ctx get_key matches in + let key_from_exp = function + | Lval (Var v,o) -> Some (v, Offset.Exp.of_cil o) + | _ -> None + in + match key_from_exp (Lval lval), key_from_exp (stripCasts rval) with (* TODO for now we just care about Lval assignments -> should use Queries.MayPointTo *) + | Some k1, Some k2 when k1=k2 -> m (* do nothing on self-assignment *) + | Some k1, Some k2 when D.mem k1 m && D.mem k2 m -> (* both in D *) + M.debug ~category:Analyzer "assign (both in D): %s = %s" (D.string_of_key k1) (D.string_of_key k2); + (* saveOpened k1 *) m |> D.remove' k1 |> D.alias k1 k2 + | Some k1, Some k2 when D.mem k1 m -> (* only k1 in D *) + M.debug ~category:Analyzer "assign (only k1 in D): %s = %s" (D.string_of_key k1) (D.string_of_key k2); + (* saveOpened k1 *) m |> D.remove' k1 + | Some k1, Some k2 when D.mem k2 m -> (* only k2 in D *) + M.debug ~category:Analyzer "assign (only k2 in D): %s = %s" (D.string_of_key k1) (D.string_of_key k2); + let m = D.alias k1 k2 m in (* point k1 to k2 *) + if Basetype.Variables.to_group (fst k2) = Temp (* check if k2 is a temporary Lval introduced by CIL *) + then D.remove' k2 m (* if yes we need to remove it from our map *) + else m (* otherwise no change *) + | Some k1, _ when D.mem k1 m -> (* k1 in D and assign something unknown *) + M.debug ~category:Analyzer "assign (only k1 in D): %s = %a" (D.string_of_key k1) d_exp rval; + D.warn @@ "changed pointer "^D.string_of_key k1^" (no longer safe)"; + (* saveOpened ~unknown:true k1 *) m |> D.unknown k1 + | _ -> (* no change in D for other things *) + M.debug ~category:Analyzer "assign (none in D): %a = %a [%a]" d_lval lval d_exp rval d_plainexp rval; + m + + (* + - branch-transitions in the spec-file come in pairs: e.g. true-branch goes to node a, false-branch to node b + - branch is called for both possibilities + - TODO query the exp and take/don't take the transition + - in case of `Top we take the transition + - both branches get joined after (e.g. for fopen: May [open; error]) + - if there is a branch in the code, branch is also called + -> get the key from exp and backtrack to the corresponding branch-transitions + -> reevaluate with current exp and meet domain with result + *) + (* + - get key from exp + - ask EvalInt + - if result is `Top and we are in a state that is the starting node of a branch edge, we have to: + - go to target node and modify the state in specDomain + - find out which value of key makes exp equal to tv + - save this value and answer queries for EvalInt with it + - if not, compare it with tv and take the corresponding branch + *) + let branch ctx (exp:exp) (tv:bool) : D.t = + let m = ctx.local in + (* ignore(printf "if %a = %B (line %i)\n" d_plainexp exp tv (!Tracing.current_loc).line); *) + let check a b tv = + (* ignore(printf "check: %a = %a\n" d_plainexp a d_plainexp b); *) + match a, b with + | Const (CInt(i, kind, str)), Lval lval + | Lval lval, Const (CInt(i, kind, str)) -> + (* let binop = BinOp (Eq, a, b, Cil.intType) in *) + (* standardize the format of the expression to 'lval==i'. -> spec needs to follow that format, the code is mapped to it. *) + let binop = BinOp (Eq, Lval lval, Const (CInt(i, kind, str)), Cil.intType) in + let key = D.key_from_lval lval in + let value = D.find key m in + if Z.equal i Z.zero && tv then ( + M.debug ~category:Analyzer "error-branch"; + (* D.remove key m *) + )else( + M.debug ~category:Analyzer "success-branch"; + (* m *) + ); + (* there should always be an entry in our domain for key *) + if not (D.mem key m) then m else + (* TODO for now we just assume that a Binop is used and Lval is the key *) + (* get the state(s) that key is/might be in *) + let states = D.get_states key m in + (* compare SC.exp with Cil.exp and tv *) + let branch_exp_eq c exp tv = + (* let c_str = match SC.branch_exp c with Some (exp,tv) -> SC.exp_to_string exp | _ -> "" in + let c_str = Str.global_replace (Str.regexp_string "$key") "%e:key" c_str in + let c_exp = Formatcil.cExp c_str [("key", Fe (D.K.to_exp key))] in *) + (* c_exp=exp *) (* leads to Out_of_memory *) + match SC.branch_exp c with + | Some (c_exp,c_tv) -> + (* let exp_str = CilType.Exp.show exp in *) (* contains too many casts, so that matching fails *) + let exp_str = CilType.Exp.show binop in + let c_str = SC.exp_to_string c_exp in + let c_str = Str.global_replace (Str.regexp_string "$key") (D.string_of_key key) c_str in + (* ignore(printf "branch_exp_eq: '%s' '%s' -> %B\n" c_str exp_str (c_str=exp_str)); *) + c_str=exp_str && c_tv=tv + | _ -> false + in + (* filter those edges that are branches, start with a state from states and have the same branch expression and the same tv *) + let branch_edges = List.filter (fun (a,ws,fwd,b,c) -> SC.is_branch c && List.mem a states && branch_exp_eq c exp tv) !edges in + (* there should be only one such edge or none *) + if List.compare_length_with branch_edges 1 <> 0 then ( (* call of branch for an actual branch *) + M.debug ~category:Analyzer "branch: branch_edges length is not 1! -> actual branch"; + M.debug ~category:Analyzer "%s -> branch_edges1: %a" (D.string_of_entry key m) (Pretty.d_list "\n " (fun () x -> Pretty.text (SC.def_to_string (SC.Edge x)))) branch_edges; + (* filter those edges that are branches, end with a state from states have the same branch expression and the same tv *) + (* TODO they should end with any predecessor of the current state, not only the direct predecessor *) + let branch_edges = List.filter (fun (a,ws,fwd,b,c) -> SC.is_branch c && List.mem b states && branch_exp_eq c exp tv) !edges in + M.debug ~category:Analyzer "%s -> branch_edges2: %a" (D.string_of_entry key m) (Pretty.d_list "\n " (fun () x -> Pretty.text (SC.def_to_string (SC.Edge x)))) branch_edges; + if List.compare_length_with branch_edges 1 <> 0 then m else + (* meet current value with the target state. this is tricky: we can not simply take the target state, since there might have been more than one element already before the branching. + -> find out what the alternative branch target was and remove it *) + let (a,ws,fwd,b,c) = List.hd branch_edges in + (* the alternative branch has the same start node, the same branch expression and the negated tv *) + let (a,ws,fwd,b,c) = List.find (fun (a2,ws,fwd,b,c) -> SC.is_branch c && a2=a && branch_exp_eq c exp (not tv)) !edges in + (* now b is the state the alternative branch goes to -> remove it *) + (* TODO may etc. *) + (* being explicit: check how many records there are. if the value is Must b, then we're sure that it is so and we don't remove anything. *) + if D.V.length value = (1,1) then m else (* XX *) + (* there are multiple possible states -> remove b *) + let v2 = D.V.remove_state b value in + (* M.debug ~category:Analyzer @@ "branch: changed state from "^D.V.string_of value^" to "^D.V.string_of v2; *) + D.add key v2 m + ) else (* call of branch directly after splitting *) + let (a,ws,fwd,b,c) = List.hd branch_edges in + (* TODO may etc. *) + let v2 = D.V.set_state b value in + (* M.debug ~category:Analyzer @@ "branch: changed state from "^D.V.string_of value^" to "^D.V.string_of v2; *) + D.add key v2 m + | _ -> M.debug ~category:Analyzer "nothing matched the given BinOp: %a = %a" d_plainexp a d_plainexp b; m + in + match stripCasts (constFold true exp) with + (* somehow there are a lot of casts inside the BinOp which stripCasts only removes when called on the subparts + -> matching as in flagMode didn't work *) + | BinOp (Eq, a, b, _) -> check (stripCasts a) (stripCasts b) tv + | BinOp (Ne, a, b, _) -> check (stripCasts a) (stripCasts b) (not tv) + | UnOp (LNot, a, _) -> check (stripCasts a) (integer 0) tv + (* TODO makes 2 tests fail. probably check changes something it shouldn't *) + (* | Lval _ as a -> check (stripCasts a) (integer 0) (not tv) *) + | e -> M.debug ~category:Analyzer "branch: nothing matched the given exp: %a" d_plainexp e; m + + let body ctx (f:fundec) : D.t = + ctx.local + + let return ctx (exp:exp option) (f:fundec) : D.t = + let m = ctx.local in + (* M.debug ~category:Analyzer @@ "return: ctx.local="^D.short 50 m^D.string_of_callstack m; *) + (* if f.svar.vname <> "main" && BatList.is_empty (D.callstack m) then M.debug ~category:Analyzer @@ "\n\t!!! call stack is empty for function "^f.svar.vname^" !!!"; *) + if f.svar.vname = "main" then ( + let warn_main msg_loc msg_end = (* there is an end warning for local, return or both *) + (* find edges that have 'end' as a target *) + (* we ignore the constraint, TODO maybe find a better syntax for declaring end states *) + let end_states = BatList.filter_map (fun (a,ws,fwd,b,c) -> if b="end" then Some a else None) !edges in + let must_not, may_not = D.filter_values (fun r -> not @@ List.exists (fun end_state -> D.V.in_state end_state r) end_states) m in + let may_not = Set.diff may_not must_not in + (match msg_loc with (* local warnings for entries that must/may not be in an end state *) + | Some msg -> + Set.iter (fun r -> D.warn ~loc:(D.V.loc r) msg) must_not; + Set.iter (fun r -> D.warn ~may:true ~loc:(D.V.loc r) msg) may_not + | None -> ()); + (match msg_end with + | Some msg -> (* warnings at return for entries that must/may not be in an end state *) + let f msg rs = Str.global_replace (Str.regexp_string "$") (D.string_of_keys rs) msg in + if Set.cardinal must_not > 0 then D.warn (f msg must_not); + if Set.cardinal may_not > 0 then D.warn ~may:true (f msg may_not) + | _ -> ()) + in + (* check if there is a warning for entries that are not in an end state *) + match SC.warning "_end" !nodes, SC.warning "_END" !nodes with + | None, None -> () (* nothing to do here *) + | msg_loc,msg_end -> warn_main msg_loc msg_end + ); + (* take care of return value *) + let au = match exp with + | Some(Lval lval) when D.mem (D.key_from_lval lval) m -> (* we return a var in D *) + let k = D.key_from_lval lval in + let varinfo,offset = k in + if varinfo.vglob then + D.alias return_var k m (* if var is global, we alias it *) + else + D.add return_var (D.find' k m) m (* if var is local, we make a copy *) + | _ -> m + in + (* remove formals and locals *) + (* TODO only keep globals like in fileUse *) + List.fold_left (fun m var -> D.remove' (var, `NoOffset) m) au (f.sformals @ f.slocals) + + let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = + (* M.debug ~category:Analyzer @@ "entering function "^f.vname^D.string_of_callstack ctx.local; *) + if f.svar.vname = "main" then load_specfile (); + let m = if f.svar.vname <> "main" then + D.edit_callstack (BatList.cons (Option.get !Node.current_node)) ctx.local + else ctx.local in [m, m] + + let combine_env ctx lval fexp f args fc au f_ask = + (* M.debug ~category:Analyzer @@ "leaving function "^f.vname^D.string_of_callstack au; *) + let au = D.edit_callstack List.tl au in + (* remove special return var *) + D.remove' return_var au + + let combine_assign ctx (lval:lval option) fexp (f:fundec) (args:exp list) fc (au:D.t) (f_ask: Queries.ask) : D.t = + let return_val = D.find_option return_var au in + match lval, return_val with + | Some lval, Some v -> + let k = D.key_from_lval lval in + (* handle potential overwrites *) + (* |> check_overwrite_open k *) + (* if v.key is still in D, then it must be a global and we need to alias instead of rebind *) + (* TODO what if there is a local with the same name as the global? *) + if D.V.is_top v then (* returned a local that was top -> just add k as top *) + D.add' k v ctx.local + else (* v is now a local which is not top or a global which is aliased *) + let vvar = D.V.get_alias v in (* this is also ok if v is not an alias since it chooses an element from the May-Set which is never empty (global top gets aliased) *) + if D.mem vvar au then (* returned variable was a global TODO what if local had the same name? -> seems to work *) + (* let _ = M.debug ~category:Analyzer @@ vvar.vname^" was a global -> alias" in *) + D.alias k vvar ctx.local + else (* returned variable was a local *) + let v = D.V.set_key k v in (* adjust var-field to lval *) + (* M.debug ~category:Analyzer @@ vvar.vname^" was a local -> rebind"; *) + D.add' k v ctx.local + | _ -> ctx.local + + let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) : D.t = + let arglist = List.map (Cil.stripCasts) arglist in (* remove casts, TODO safe? *) + let get_key c = match SC.get_key_variant c with + | `Lval s -> + M.debug ~category:Analyzer "Key variant special `Lval %s; %s" s (SC.stmt_to_string c); + lval + | `Arg(s, i) -> + M.debug ~category:Analyzer "Key variant special `Arg(%s, %d). %s" s i (SC.stmt_to_string c); + (try + let arg = List.at arglist i in + match arg with + | Lval x -> Some x (* TODO enough to just assume the arg is already there as a Lval? *) + | AddrOf x -> Some x + | _ -> None + with Invalid_argument s -> + M.debug ~category:Analyzer "Key out of bounds! Msg: %s" s; (* TODO what to do if spec says that there should be more args... *) + None + ) + | _ -> None (* `Rval or `None *) + in + let matches (a,ws,fwd,b,c) = + let equal_args spec_args cil_args = + if List.compare_length_with spec_args 1 = 0 && List.hd spec_args = `Free then + true (* wildcard as an argument matches everything *) + else if List.compare_lengths arglist spec_args <> 0 then ( + M.debug ~category:Analyzer "SKIP the number of arguments doesn't match the specification!"; + false + )else + List.for_all2 (SpecCheck.equal_exp ctx) spec_args cil_args (* TODO Cil.constFold true arg. Test: Spec and c-file: 1+1 *) + in + (* function name must fit the constraint *) + SC.fname_is f.vname c && + (* right form (assignment or not) *) + SC.equal_form lval c && + (* function arguments match those of the constraint *) + equal_args (SC.get_fun_args c) arglist + in + SpecCheck.check ctx get_key matches + + + let startstate v = D.bot () + let threadenter ctx lval f args = [D.bot ()] + let threadspawn ctx lval f args fctx = ctx.local + let exitstate v = D.bot () +end + +let _ = + MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/analyses/stackTrace.ml b/src/analyses/stackTrace.ml index dd2cedf871b..4dc62f18736 100644 --- a/src/analyses/stackTrace.ml +++ b/src/analyses/stackTrace.ml @@ -21,7 +21,7 @@ struct ctx.local (* keep local as opposed to IdentitySpec *) let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.bot ()] + let threadenter ctx lval f args = [D.bot ()] let exitstate v = D.top () end @@ -36,7 +36,7 @@ struct (* transfer functions *) let enter ctx (lval: lval option) (f:fundec) (args:exp list) : (D.t * D.t) list = - [ctx.local, D.push !Goblint_tracing.current_loc ctx.local] + [ctx.local, D.push !Tracing.current_loc ctx.local] let combine_env ctx lval fexp f args fc au f_ask = ctx.local (* keep local as opposed to IdentitySpec *) @@ -45,8 +45,8 @@ struct let startstate v = D.bot () let exitstate v = D.top () - let threadenter ctx ~multiple lval f args = - [D.push !Goblint_tracing.current_loc ctx.local] + let threadenter ctx lval f args = + [D.push !Tracing.current_loc ctx.local] end diff --git a/src/analyses/symbLocks.ml b/src/analyses/symbLocks.ml index c237967a7ae..d8cebf51d22 100644 --- a/src/analyses/symbLocks.ml +++ b/src/analyses/symbLocks.ml @@ -29,8 +29,8 @@ struct let name () = "symb_locks" let startstate v = D.top () - let threadenter ctx ~multiple lval f args = [D.top ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.top ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.top () let branch ctx exp tv = ctx.local @@ -106,12 +106,13 @@ struct module A = struct - module PLock = - struct - include CilType.Offset - let name () = "p-lock" + module E = struct + include Printable.Either (CilType.Offset) (ILock) + + let pretty () = function + | `Left o -> Pretty.dprintf "p-lock:%a" (d_offset (text "*")) o + | `Right addr -> Pretty.dprintf "i-lock:%a" ILock.pretty addr - let pretty = d_offset (text "*") include Printable.SimplePretty ( struct type nonrec t = t @@ -119,7 +120,6 @@ struct end ) end - module E = Printable.Either (PLock) (ILock) include SetDomain.Make (E) let name () = "symblock" diff --git a/src/analyses/taintPartialContexts.ml b/src/analyses/taintPartialContexts.ml index 85dabd1c9db..feb9599977b 100644 --- a/src/analyses/taintPartialContexts.ml +++ b/src/analyses/taintPartialContexts.ml @@ -88,9 +88,9 @@ struct d let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = [D.bot ()] - let threadspawn ctx ~multiple lval f args fctx = + let threadspawn ctx lval f args fctx = match lval with | Some lv -> taint_lval ctx lv | None -> ctx.local diff --git a/src/analyses/termination.ml b/src/analyses/termination.ml new file mode 100644 index 00000000000..6da9225d3f5 --- /dev/null +++ b/src/analyses/termination.ml @@ -0,0 +1,239 @@ +(** Termination analysis of loops using counter variables ([term]). *) + +open Batteries +open GoblintCil +open Analyses + +module M = Messages +let (||?) a b = match a,b with Some x,_ | _, Some x -> Some x | _ -> None + +module TermDomain = struct + include SetDomain.ToppedSet (Basetype.Variables) (struct let topname = "All Variables" end) +end + +(* some kind of location string suitable for variable names? *) +let show_location_id l = + string_of_int l.line ^ "_" ^ string_of_int l.column + +class loopCounterVisitor (fd : fundec) = object(self) + inherit nopCilVisitor + method! vstmt s = + let action s = match s.skind with + | Loop (b, loc, eloc, _, _) -> + (* insert loop counter variable *) + let name = "term"^show_location_id loc in + let typ = intType in (* TODO the type should be the same as the one of the original loop counter *) + let v = Cilfacade.create_var (makeLocalVar fd name ~init:(SingleInit zero) typ) in + (* make an init stmt since the init above is apparently ignored *) + let init_stmt = mkStmtOneInstr @@ Set (var v, zero, loc, eloc) in + (* increment it every iteration *) + let inc_stmt = mkStmtOneInstr @@ Set (var v, increm (Lval (var v)) 1, loc, eloc) in + b.bstmts <- inc_stmt :: b.bstmts; + let nb = mkBlock [init_stmt; mkStmt s.skind] in + s.skind <- Block nb; + s + | _ -> s + in ChangeDoChildrenPost (s, action) +end + +let loopBreaks : (int, location) Hashtbl.t = Hashtbl.create 13 (* break stmt sid -> corresponding loop *) +class loopBreaksVisitor (fd : fundec) = object(self) + inherit nopCilVisitor + method! vstmt s = + (match s.skind with + | Loop (b, loc, eloc, Some continue, Some break) -> Hashtbl.add loopBreaks break.sid loc (* TODO: use eloc? *) + | Loop _ -> failwith "Termination.preprocess: every loop should have a break and continue stmt after prepareCFG" + | _ -> ()); + DoChildren +end + +(* if the given block contains a goto while_break.* we have the termination condition for a loop *) +let exits = function + | { bstmts = [{ skind = Goto (stmt, loc); _ }]; _ } -> Hashtbl.find_option loopBreaks !stmt.sid + | _ -> None (* TODO handle return (need to find out what loop we are in) *) + +let lvals_of_expr = + let rec f a = function + | Const _ | SizeOf _ | SizeOfStr _ | AlignOf _ | AddrOfLabel _ -> a + | Lval l | AddrOf l | StartOf l -> l :: a + | SizeOfE e | AlignOfE e | UnOp (_,e,_) | CastE (_,e) | Imag e | Real e -> f a e + | BinOp (_,e1,e2,_) -> f a e1 @ f a e2 + | Question (c,t,e,_) -> f a c @ f a t @ f a e + in f [] + +let loopVars : (location, lval) Hashtbl.t = Hashtbl.create 13 (* loop location -> lval used for exit *) +class loopVarsVisitor (fd : fundec) = object + inherit nopCilVisitor + method! vstmt s = + let add_exit_cond e loc = + match lvals_of_expr e with + | [lval] when Cilfacade.typeOf e |> isArithmeticType -> Hashtbl.add loopVars loc lval + | _ -> () + in + (match s.skind with + | If (e, tb, fb, loc, eloc) -> Option.map_default (add_exit_cond e) () (exits tb ||? exits fb) + | _ -> ()); + DoChildren +end + +let stripCastsDeep e = + let v = object + inherit nopCilVisitor + method! vexpr e = ChangeTo (stripCasts e) + end + in visitCilExpr v e + +(* keep the enclosing loop for statements *) +let cur_loop = ref None (* current loop *) +let cur_loop' = ref None (* for nested loops *) +let makeVar fd loc name = + let id = name ^ "__" ^ show_location_id loc in + try List.find (fun v -> v.vname = id) fd.slocals + with Not_found -> + let typ = intType in (* TODO the type should be the same as the one of the original loop counter *) + Cilfacade.create_var (makeLocalVar fd id ~init:(SingleInit zero) typ) +let f_assume = Lval (var (emptyFunction "__goblint_assume").svar) +let f_check = Lval (var (emptyFunction "__goblint_check").svar) +class loopInstrVisitor (fd : fundec) = object(self) + inherit nopCilVisitor + method! vstmt s = + (* TODO: use Loop eloc? *) + (match s.skind with + | Loop (_, loc, eloc, _, _) -> + cur_loop' := !cur_loop; + cur_loop := Some loc + | _ -> ()); + let action s = + (* first, restore old cur_loop *) + (match s.skind with + | Loop (_, loc, eloc, _, _) -> + cur_loop := !cur_loop'; + | _ -> ()); + let in_loop () = Option.is_some !cur_loop && Hashtbl.mem loopVars (Option.get !cur_loop) in + match s.skind with + | Loop (b, loc, eloc, Some continue, Some break) when Hashtbl.mem loopVars loc -> + (* find loop var for current loop *) + let x = Hashtbl.find loopVars loc in + (* insert loop counter and diff to loop var *) + let t = var @@ makeVar fd loc "t" in + let d1 = var @@ makeVar fd loc "d1" in + let d2 = var @@ makeVar fd loc "d2" in + (* make init stmts *) + let t_init = mkStmtOneInstr @@ Set (t, zero, loc, eloc) in + let d1_init = mkStmtOneInstr @@ Set (d1, Lval x, loc, eloc) in + let d2_init = mkStmtOneInstr @@ Set (d2, Lval x, loc, eloc) in + (* increment/decrement in every iteration *) + let t_inc = mkStmtOneInstr @@ Set (t, increm (Lval t) 1, loc, eloc) in + let d1_inc = mkStmtOneInstr @@ Set (d1, increm (Lval d1) (-1), loc, eloc) in + let d2_inc = mkStmtOneInstr @@ Set (d2, increm (Lval d2) 1 , loc, eloc) in + let typ = intType in + let e1 = BinOp (Eq, Lval t, BinOp (MinusA, Lval x, Lval d1, typ), typ) in + let e2 = BinOp (Eq, Lval t, BinOp (MinusA, Lval d2, Lval x, typ), typ) in + let inv1 = mkStmtOneInstr @@ Call (None, f_assume, [e1], loc, eloc) in + let inv2 = mkStmtOneInstr @@ Call (None, f_assume, [e2], loc, eloc) in + (match b.bstmts with + | cont :: cond :: ss -> + (* changing succs/preds directly doesn't work -> need to replace whole stmts *) + b.bstmts <- cont :: cond :: inv1 :: inv2 :: d1_inc :: d2_inc :: t_inc :: ss; + let nb = mkBlock [t_init; d1_init; d2_init; mkStmt s.skind] in + s.skind <- Block nb; + | _ -> ()); + s + | Loop (b, loc, eloc, Some continue, Some break) -> + print_endline @@ "WARN: Could not determine loop variable for loop at " ^ CilType.Location.show loc; + s + | _ when Hashtbl.mem loopBreaks s.sid -> (* after a loop, we check that t is bounded/positive (no overflow happened) *) + let loc = Hashtbl.find loopBreaks s.sid in + let t = var @@ makeVar fd loc "t" in + let e3 = BinOp (Ge, Lval t, zero, intType) in + let inv3 = mkStmtOneInstr @@ Call (None, f_check, [e3], loc, locUnknown) in + let nb = mkBlock [mkStmt s.skind; inv3] in + s.skind <- Block nb; + s + | Instr [Set (lval, e, loc, eloc)] when in_loop () -> + (* find loop var for current loop *) + let cur_loop = Option.get !cur_loop in + let x = Hashtbl.find loopVars cur_loop in + if x <> lval then + s + else (* we only care about the loop var *) + let d1 = makeVar fd cur_loop "d1" in + let d2 = makeVar fd cur_loop "d2" in + (match stripCastsDeep e with + | BinOp (op, Lval x', e2, typ) when (op = PlusA || op = MinusA) && x' = x && isArithmeticType typ -> (* TODO x = 1 + x, MinusA! *) + (* increase diff by same expr *) + let d1_inc = mkStmtOneInstr @@ Set (var d1, BinOp (PlusA, Lval (var d1), e2, typ), loc, eloc) in + let d2_inc = mkStmtOneInstr @@ Set (var d2, BinOp (PlusA, Lval (var d2), e2, typ), loc, eloc) in + let nb = mkBlock [d1_inc; d2_inc; mkStmt s.skind] in + s.skind <- Block nb; + s + | _ -> + (* otherwise diff is e - counter *) + let t = makeVar fd cur_loop "t" in + let te = Cilfacade.typeOf e in + let dt1 = mkStmtOneInstr @@ Set (var d1, BinOp (MinusA, Lval x, Lval (var t), te), loc, eloc) in + let dt2 = mkStmtOneInstr @@ Set (var d2, BinOp (MinusA, Lval x, Lval (var t), te), loc, eloc) in + let nb = mkBlock [mkStmt s.skind; dt1; dt2] in + s.skind <- Block nb; + s + ) + | _ -> s + in + ChangeDoChildrenPost (s, action) +end + + +module Spec = +struct + include Analyses.IdentitySpec + + let name () = "term" + module D = TermDomain + module C = TermDomain + + (* queries *) + (*let query ctx (q:Queries.t) : Queries.Result.t =*) + (*match q with*) + (*| Queries.MustTerm loc -> `Bool (D.mem v ctx.local)*) + (*| _ -> Queries.Result.top ()*) + + (* transfer functions *) + + let branch ctx (exp:exp) (tv:bool) : D.t = + ctx.local + (* if the then-block contains a goto while_break.* we have the termination condition for a loop *) + (* match !MyCFG.current_node with *) + (* | Some (MyCFG.Statement({ skind = If (e, tb, fb, loc) })) -> *) + (* let str_exit b = match exits b with Some loc -> string_of_int loc.line | None -> "None" in *) + (* M.debug @@ *) + (* "\nCil-exp: " ^ sprint d_exp e *) + (* (*^ "; Goblint-exp: " ^ sprint d_exp exp*) *) + (* ^ "; Goblint: " ^ sprint Queries.Result.pretty (ctx.ask (Queries.EvalInt exp)) *) + (* ^ "\nCurrent block: " ^ (if tv then "Then" else "Else") *) + (* ^ "\nThen block (exits " ^ str_exit tb ^ "): " ^ sprint d_block tb *) + (* ^ "\nElse block (exits " ^ str_exit fb ^ "): " ^ sprint d_block fb *) + (* ; *) + (* ctx.local *) + (* | _ -> ctx.local *) + + let startstate v = D.bot () + let threadenter ctx lval f args = [D.bot ()] + let exitstate v = D.bot () +end + +class recomputeVisitor (fd : fundec) = object(self) + inherit nopCilVisitor + method! vfunc fd = + computeCFGInfo fd true; + SkipChildren +end + +let _ = + (* Cilfacade.register_preprocess Spec.name (new loopCounterVisitor); *) + Cilfacade.register_preprocess (Spec.name ()) (new loopBreaksVisitor); + Cilfacade.register_preprocess (Spec.name ()) (new loopVarsVisitor); + Cilfacade.register_preprocess (Spec.name ()) (new loopInstrVisitor); + Cilfacade.register_preprocess (Spec.name ()) (new recomputeVisitor); + Hashtbl.clear loopBreaks; (* because the sids are now different *) + Cilfacade.register_preprocess (Spec.name ()) (new loopBreaksVisitor); + MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/analyses/threadAnalysis.ml b/src/analyses/threadAnalysis.ml index ed30e3633e0..1e679a4707b 100644 --- a/src/analyses/threadAnalysis.ml +++ b/src/analyses/threadAnalysis.ml @@ -22,15 +22,12 @@ struct module P = IdentityP (D) (* transfer functions *) - let handle_thread_return ctx (exp: exp option) = + let return ctx (exp:exp option) (f:fundec) : D.t = let tid = ThreadId.get_current (Analyses.ask_of_ctx ctx) in - match tid with + begin match tid with | `Lifted tid -> ctx.sideg tid (false, TS.bot (), not (D.is_empty ctx.local)) | _ -> () - - let return ctx (exp:exp option) _ : D.t = - if ctx.ask Queries.MayBeThreadReturn then - handle_thread_return ctx exp; + end; ctx.local let rec is_not_unique ctx tid = @@ -57,21 +54,15 @@ struct | ThreadJoin { thread = id; ret_var } -> (* TODO: generalize ThreadJoin like ThreadCreate *) (let has_clean_exit tid = not (BatTuple.Tuple3.third (ctx.global tid)) in - let tids = ctx.ask (Queries.EvalThread id) in let join_thread s tid = if has_clean_exit tid && not (is_not_unique ctx tid) then D.remove tid s else s in - if TS.is_top tids - then ctx.local - else match TS.elements tids with - | [t] -> join_thread ctx.local t (* single thread *) - | _ -> ctx.local (* if several possible threads are may-joined, none are must-joined *)) - | ThreadExit { ret_val } -> - handle_thread_return ctx (Some ret_val); - ctx.local + match TS.elements (ctx.ask (Queries.EvalThread id)) with + | threads -> List.fold_left join_thread ctx.local threads + | exception SetDomain.Unsupported _ -> ctx.local) | _ -> ctx.local let query ctx (type a) (q: a Queries.t): a Queries.result = @@ -93,14 +84,8 @@ struct | _ -> Queries.Result.top q let startstate v = D.bot () - - let threadenter ctx ~multiple lval f args = - if multiple then - (let tid = ThreadId.get_current_unlift (Analyses.ask_of_ctx ctx) in - ctx.sideg tid (true, TS.bot (), false)); - [D.bot ()] - - let threadspawn ctx ~multiple lval f args fctx = + let threadenter ctx lval f args = [D.bot ()] + let threadspawn ctx lval f args fctx = let creator = ThreadId.get_current (Analyses.ask_of_ctx ctx) in let tid = ThreadId.get_current_unlift (Analyses.ask_of_ctx fctx) in let repeated = D.mem tid ctx.local in diff --git a/src/analyses/threadEscape.ml b/src/analyses/threadEscape.ml index f5ff3dc50ae..9ed62e74228 100644 --- a/src/analyses/threadEscape.ml +++ b/src/analyses/threadEscape.ml @@ -117,7 +117,8 @@ struct end | _ -> Queries.Result.top q - let escape_rval ctx ask (rval:exp) = + let escape_rval ctx (rval:exp) = + let ask = Analyses.ask_of_ctx ctx in let escaped = reachable ask rval in let escaped = D.filter (fun v -> not v.vglob) escaped in @@ -132,36 +133,27 @@ struct let ask = Analyses.ask_of_ctx ctx in let vs = mpt ask (AddrOf lval) in if D.exists (fun v -> v.vglob || has_escaped ask v) vs then ( - let escaped = escape_rval ctx ask rval in + let escaped = escape_rval ctx rval in D.join ctx.local escaped ) else begin ctx.local end - let combine_assign ctx (lval:lval option) (fexp:exp) f args fc au f_ask : D.t = - let ask = Analyses.ask_of_ctx ctx in - match lval with - | Some lval when D.exists (fun v -> v.vglob || has_escaped ask v) (mpt ask (AddrOf lval)) -> - let rval = Lval (ReturnUtil.return_lval ()) in - let escaped = escape_rval ctx f_ask rval in (* Using f_ask because the return value is only accessible in the context of that function at this point *) - D.join ctx.local escaped - | _ -> ctx.local - let special ctx (lval: lval option) (f:varinfo) (args:exp list) : D.t = let desc = LibraryFunctions.find f in match desc.special args, f.vname, args with | _, "pthread_setspecific" , [key; pt_value] -> - let escaped = escape_rval ctx (Analyses.ask_of_ctx ctx) pt_value in + let escaped = escape_rval ctx pt_value in D.join ctx.local escaped | _ -> ctx.local let startstate v = D.bot () let exitstate v = D.bot () - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = [D.bot ()] - let threadspawn ctx ~multiple lval f args fctx = + let threadspawn ctx lval f args fctx = D.join ctx.local @@ match args with | [ptc_arg] -> diff --git a/src/analyses/threadFlag.ml b/src/analyses/threadFlag.ml index a751ae074ae..f2ebf82be14 100644 --- a/src/analyses/threadFlag.ml +++ b/src/analyses/threadFlag.ml @@ -21,8 +21,6 @@ struct module D = Flag module C = Flag module P = IdentityP (D) - module V = UnitV - module G = BoolDomain.MayBool let name () = "threadflag" @@ -46,7 +44,6 @@ struct match x with | Queries.MustBeSingleThreaded _ -> not (Flag.is_multi ctx.local) (* If this analysis can tell, it is the case since the start *) | Queries.MustBeUniqueThread -> not (Flag.is_not_main ctx.local) - | Queries.IsEverMultiThreaded -> (ctx.global () : bool) (* requires annotation to compile *) (* This used to be in base but also commented out. *) (* | Queries.MayBePublic _ -> Flag.is_multi ctx.local *) | _ -> Queries.Result.top x @@ -61,13 +58,12 @@ struct let access ctx _ = is_currently_multi (Analyses.ask_of_ctx ctx) - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = if not (has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ctx.emit Events.EnterMultiThreaded; [create_tid f] - let threadspawn ctx ~multiple lval f args fctx = - ctx.sideg () true; + let threadspawn ctx lval f args fctx = if not (has_ever_been_multi (Analyses.ask_of_ctx ctx)) then ctx.emit Events.EnterMultiThreaded; D.join ctx.local (Flag.get_main ()) diff --git a/src/analyses/threadId.ml b/src/analyses/threadId.ml index 86e7f770a89..8144aea507d 100644 --- a/src/analyses/threadId.ml +++ b/src/analyses/threadId.ml @@ -31,7 +31,7 @@ struct module N = struct - include Lattice.FlatConf (struct include Printable.DefaultConf let bot_name = "unknown node" let top_name = "unknown node" end) (VNI) + include Lattice.Flat (VNI) (struct let bot_name = "unknown node" let top_name = "unknown node" end) let name () = "wrapper call" end module TD = Thread.D @@ -75,10 +75,10 @@ struct Hashtbl.replace !tids tid (); (N.bot (), `Lifted (tid), (TD.bot (), TD.bot ())) - let create_tid ?(multiple=false) (_, current, (td, _)) ((node, index): Node.t * int option) v = + let create_tid (_, current, (td, _)) ((node, index): Node.t * int option) v = match current with | `Lifted current -> - let+ tid = Thread.threadenter ~multiple (current, td) node index v in + let+ tid = Thread.threadenter (current, td) node index v in if GobConfig.get_bool "dbg.print_tids" then Hashtbl.replace !tids tid (); `Lifted tid @@ -152,15 +152,15 @@ struct | `Lifted node, count -> node, Some count | (`Bot | `Top), _ -> ctx.prev_node, None - let threadenter ctx ~multiple lval f args:D.t list = + let threadenter ctx lval f args:D.t list = let n, i = indexed_node_for_ctx ctx in - let+ tid = create_tid ~multiple ctx.local (n, i) f in + let+ tid = create_tid ctx.local (n, i) f in (`Lifted (f, n, i), tid, (TD.bot (), TD.bot ())) - let threadspawn ctx ~multiple lval f args fctx = + let threadspawn ctx lval f args fctx = let (current_n, current, (td,tdl)) = ctx.local in let v, n, i = match fctx.local with `Lifted vni, _, _ -> vni | _ -> failwith "ThreadId.threadspawn" in - (current_n, current, (Thread.threadspawn ~multiple td n i v, Thread.threadspawn ~multiple tdl n i v)) + (current_n, current, (Thread.threadspawn td n i v, Thread.threadspawn tdl n i v)) type marshal = (Thread.t,unit) Hashtbl.t (* TODO: don't use polymorphic Hashtbl *) let init (m:marshal option): unit = diff --git a/src/analyses/threadJoins.ml b/src/analyses/threadJoins.ml index 160b123e783..f2cd36619fe 100644 --- a/src/analyses/threadJoins.ml +++ b/src/analyses/threadJoins.ml @@ -52,7 +52,7 @@ struct if TIDs.is_top threads then ctx.local else ( - (* all elements are known *) + (* elements throws if the thread set is top *) let threads = TIDs.elements threads in match threads with | [tid] when TID.is_unique tid-> @@ -70,7 +70,7 @@ struct (MustTIDs.bot(), true) (* consider everything joined, MustTIDs is reversed so bot is All threads *) ) else ( - (* all elements are known *) + (* elements throws if the thread set is top *) let threads = TIDs.elements threads in if List.compare_length_with threads 1 > 0 then M.info ~category:Unsound "Ambiguous thread ID assume-joined, assuming all of those threads must-joined."; @@ -81,7 +81,7 @@ struct ) | _, _ -> ctx.local - let threadspawn ctx ~multiple lval f args fctx = + let threadspawn ctx lval f args fctx = if D.is_bot ctx.local then ( (* bot is All threads *) M.info ~category:Imprecise "Thread created while ALL threads must-joined, continuing with no threads joined."; D.top () (* top is no threads *) diff --git a/src/analyses/threadReturn.ml b/src/analyses/threadReturn.ml index 0aed06851ad..470c4ceaa81 100644 --- a/src/analyses/threadReturn.ml +++ b/src/analyses/threadReturn.ml @@ -28,7 +28,7 @@ struct ctx.local (* keep local as opposed to IdentitySpec *) let startstate v = true - let threadenter ctx ~multiple lval f args = [true] + let threadenter ctx lval f args = [true] let exitstate v = D.top () let query (ctx: (D.t, _, _, _) ctx) (type a) (x: a Queries.t): a Queries.result = diff --git a/src/analyses/tmpSpecial.ml b/src/analyses/tmpSpecial.ml index 9ed6da7c60e..2d38972d7a0 100644 --- a/src/analyses/tmpSpecial.ml +++ b/src/analyses/tmpSpecial.ml @@ -88,8 +88,8 @@ struct | _ -> Queries.Result.top q let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.bot ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.bot ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.bot () end diff --git a/src/analyses/tutorials/signs.ml b/src/analyses/tutorials/signs.ml index e25a9542dfc..9ae48f8626c 100644 --- a/src/analyses/tutorials/signs.ml +++ b/src/analyses/tutorials/signs.ml @@ -36,7 +36,7 @@ end * We then lift the above operations to the lattice. *) module SL = struct - include Lattice.Flat (Signs) + include Lattice.Flat (Signs) (Printable.DefaultNames) let of_int i = `Lifted (Signs.of_int i) let lt x y = match x, y with diff --git a/src/analyses/tutorials/taint.ml b/src/analyses/tutorials/taint.ml index a978d0faf4b..3067449e313 100644 --- a/src/analyses/tutorials/taint.ml +++ b/src/analyses/tutorials/taint.ml @@ -129,8 +129,8 @@ struct (* You may leave these alone *) let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.top ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.top ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.top () end diff --git a/src/analyses/tutorials/unitAnalysis.ml b/src/analyses/tutorials/unitAnalysis.ml index dc377cdd97d..d3b8c69bfdf 100644 --- a/src/analyses/tutorials/unitAnalysis.ml +++ b/src/analyses/tutorials/unitAnalysis.ml @@ -39,8 +39,8 @@ struct ctx.local let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.top ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.top ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.top () end diff --git a/src/analyses/unassumeAnalysis.ml b/src/analyses/unassumeAnalysis.ml index 5895f242c9f..43707acd1e0 100644 --- a/src/analyses/unassumeAnalysis.ml +++ b/src/analyses/unassumeAnalysis.ml @@ -200,46 +200,6 @@ struct M.warn ~category:Witness ~loc:msgLoc "couldn't locate invariant: %s" inv in - 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 inv = location_invariant.value in - let msgLoc: M.Location.t = CilLocation loc in - - match Locator.find_opt locator loc with - | Some nodes -> - unassume_nodes_invariant ~loc ~nodes inv - | None -> - M.warn ~category:Witness ~loc:msgLoc "couldn't locate invariant: %s" inv - in - - let unassume_loop_invariant (loop_invariant: YamlWitnessType.InvariantSet.LoopInvariant.t) = - let loc = loc_of_location loop_invariant.location in - let inv = loop_invariant.value in - let msgLoc: M.Location.t = CilLocation loc in - - match Locator.find_opt loop_locator loc with - | Some nodes -> - unassume_nodes_invariant ~loc ~nodes inv - | None -> - M.warn ~category:Witness ~loc:msgLoc "couldn't locate invariant: %s" inv - in - - let validate_invariant (invariant: YamlWitnessType.InvariantSet.Invariant.t) = - let target_type = YamlWitnessType.InvariantSet.InvariantType.invariant_type invariant.invariant_type in - match YamlWitness.invariant_type_enabled target_type, invariant.invariant_type with - | true, LocationInvariant x -> - unassume_location_invariant x - | true, LoopInvariant x -> - unassume_loop_invariant x - | false, (LocationInvariant _ | LoopInvariant _) -> - M.info_noloc ~category:Witness "disabled invariant of type %s" target_type - in - - List.iter validate_invariant invariant_set.content - in - match YamlWitness.entry_type_enabled target_type, entry.entry_type with | true, LocationInvariant x -> unassume_location_invariant x @@ -247,9 +207,7 @@ struct unassume_loop_invariant x | true, PreconditionLoopInvariant x -> unassume_precondition_loop_invariant x - | true, InvariantSet x -> - unassume_invariant_set x - | false, (LocationInvariant _ | LoopInvariant _ | PreconditionLoopInvariant _ | InvariantSet _) -> + | false, (LocationInvariant _ | LoopInvariant _ | PreconditionLoopInvariant _) -> M.info_noloc ~category:Witness "disabled entry of type %s" target_type | _ -> M.info_noloc ~category:Witness "cannot unassume entry of type %s" target_type diff --git a/src/analyses/uninit.ml b/src/analyses/uninit.ml index 8693599a4db..f8759d9134b 100644 --- a/src/analyses/uninit.ml +++ b/src/analyses/uninit.ml @@ -25,8 +25,8 @@ struct let name () = "uninit" let startstate v : D.t = D.empty () - let threadenter ctx ~multiple lval f args = [D.empty ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.empty ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v : D.t = D.empty () let access_address (ask: Queries.ask) write lv = diff --git a/src/analyses/useAfterFree.ml b/src/analyses/useAfterFree.ml index 69db6b4bfad..ef63ab3e91d 100644 --- a/src/analyses/useAfterFree.ml +++ b/src/analyses/useAfterFree.ml @@ -76,7 +76,7 @@ struct end else if HeapVars.mem heap_var (snd ctx.local) then begin if is_double_free then set_mem_safety_flag InvalidFree else set_mem_safety_flag InvalidDeref; - M.warn ~category:(Behavior behavior) ~tags:[CWE cwe_number] "%s might occur in current unique thread %a for heap variable %a" bug_name ThreadIdDomain.Thread.pretty current CilType.Varinfo.pretty heap_var + M.warn ~category:(Behavior behavior) ~tags:[CWE cwe_number] "%s might occur in current unique thread %a for heap variable %a" bug_name ThreadIdDomain.FlagConfiguredTID.pretty current CilType.Varinfo.pretty heap_var end end | `Top -> @@ -243,4 +243,4 @@ struct end let _ = - MCP.register_analysis (module Spec : MCPSpec) + MCP.register_analysis (module Spec : MCPSpec) \ No newline at end of file diff --git a/src/analyses/varEq.ml b/src/analyses/varEq.ml index 30b36404af8..dcd49c9f02f 100644 --- a/src/analyses/varEq.ml +++ b/src/analyses/varEq.ml @@ -43,8 +43,8 @@ struct let name () = "var_eq" let startstate v = D.top () - let threadenter ctx ~multiple lval f args = [D.top ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.top ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.top () let typ_equal = CilType.Typ.equal (* TODO: Used to have equality checking, which ignores attributes. Is that needed? *) diff --git a/src/analyses/vla.ml b/src/analyses/vla.ml index 665612aa99d..865f22b20a2 100644 --- a/src/analyses/vla.ml +++ b/src/analyses/vla.ml @@ -33,7 +33,7 @@ struct ctx.local || Cilfacade.isVLAType v.vtype let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = [D.top ()] + let threadenter ctx lval f args = [D.top ()] let exitstate v = D.top () end diff --git a/src/analyses/wrapperFunctionAnalysis.ml b/src/analyses/wrapperFunctionAnalysis.ml index 944dd6a3cba..a291c8a244b 100644 --- a/src/analyses/wrapperFunctionAnalysis.ml +++ b/src/analyses/wrapperFunctionAnalysis.ml @@ -96,7 +96,7 @@ struct let startstate v = D.bot () - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = (* The new thread receives a fresh counter *) [D.bot ()] diff --git a/src/cdomain/value/analyses/wrapperFunctionAnalysis0.ml b/src/analyses/wrapperFunctionAnalysis0.ml similarity index 93% rename from src/cdomain/value/analyses/wrapperFunctionAnalysis0.ml rename to src/analyses/wrapperFunctionAnalysis0.ml index cd5940011e1..9ea9c0c9aa9 100644 --- a/src/cdomain/value/analyses/wrapperFunctionAnalysis0.ml +++ b/src/analyses/wrapperFunctionAnalysis0.ml @@ -36,8 +36,7 @@ module ThreadCreateUniqueCount = MakeUniqueCount (val unique_count_args_from_config "ana.thread.unique_thread_id_count") (* since the query also references NodeFlatLattice, it also needs to reside here *) -module NodeFlatLattice = Lattice.FlatConf (struct - include Printable.DefaultConf +module NodeFlatLattice = Lattice.Flat (Node) (struct let top_name = "Unknown node" let bot_name = "Unreachable node" - end) (Node) + end) diff --git a/src/autoTune.ml b/src/autoTune.ml index 3cda36a302a..186d9301892 100644 --- a/src/autoTune.ml +++ b/src/autoTune.ml @@ -99,9 +99,7 @@ let rec setCongruenceRecursive fd depth neigbourFunction = FunctionSet.iter (fun vinfo -> print_endline (" " ^ vinfo.vname); - match Cilfacade.find_varinfo_fundec vinfo with - | fd -> setCongruenceRecursive fd (depth -1) neigbourFunction - | exception Not_found -> () (* Happens for __goblint_bounded *) + setCongruenceRecursive (Cilfacade.find_varinfo_fundec vinfo) (depth -1) neigbourFunction ) (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")) @@ -182,11 +180,11 @@ let enableAnalyses anas = List.iter (GobConfig.set_auto "ana.activated[+]") anas (*If only one thread is used in the program, we can disable most thread analyses*) -(*The exceptions are analyses that are depended on by others: base -> mutex -> mutexEvents, access; termination -> threadflag *) +(*The exceptions are analyses that are depended on by others: base -> mutex -> mutexEvents, access*) (*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"] let reduceThreadAnalyses () = let isThreadCreate = function | LibraryDesc.ThreadCreate _ -> true @@ -200,7 +198,7 @@ let reduceThreadAnalyses () = (* This is run independent of the autotuner being enabled or not to be sound in the presence of setjmp/longjmp *) (* It is done this way around to allow enabling some of these analyses also for programs without longjmp *) -let longjmpAnalyses = ["activeLongjmp"; "activeSetjmp"; "taintPartialContexts"; "modifiedSinceSetjmp"; "poisonVariables"; "expsplit"; "vla"] +let longjmpAnalyses = ["activeLongjmp"; "activeSetjmp"; "taintPartialContexts"; "modifiedSinceLongjmp"; "poisonVariables"; "expsplit"; "vla"] let activateLongjmpAnalysesWhenRequired () = let isLongjmp = function @@ -212,50 +210,40 @@ let activateLongjmpAnalysesWhenRequired () = enableAnalyses longjmpAnalyses; ) -let focusOnMemSafetySpecification (spec: Svcomp.Specification.t) = - match spec with +let focusOnMemSafetySpecification () = + match Svcomp.Specification.of_option () with | ValidFree -> (* Enable the useAfterFree analysis *) let uafAna = ["useAfterFree"] in print_endline @@ "Specification: ValidFree -> enabling useAfterFree analysis \"" ^ (String.concat ", " uafAna) ^ "\""; enableAnalyses uafAna | ValidDeref -> (* Enable the memOutOfBounds analysis *) let memOobAna = ["memOutOfBounds"] in - set_bool "ana.arrayoob" true; print_endline "Setting \"cil.addNestedScopeAttr\" to true"; set_bool "cil.addNestedScopeAttr" true; print_endline @@ "Specification: ValidDeref -> enabling memOutOfBounds analysis \"" ^ (String.concat ", " memOobAna) ^ "\""; - enableAnalyses memOobAna; + enableAnalyses memOobAna | ValidMemtrack | ValidMemcleanup -> (* Enable the memLeak analysis *) let memLeakAna = ["memLeak"] in if (get_int "ana.malloc.unique_address_count") < 1 then ( - print_endline "Setting \"ana.malloc.unique_address_count\" to 5"; - set_int "ana.malloc.unique_address_count" 5; + print_endline "Setting \"ana.malloc.unique_address_count\" to 1"; + set_int "ana.malloc.unique_address_count" 1; ); print_endline @@ "Specification: ValidMemtrack and ValidMemcleanup -> enabling memLeak analysis \"" ^ (String.concat ", " memLeakAna) ^ "\""; enableAnalyses memLeakAna + | MemorySafety -> (* TODO: This is a temporary solution for the memory safety category *) + (print_endline "Setting \"cil.addNestedScopeAttr\" to true"; + set_bool "cil.addNestedScopeAttr" true; + if (get_int "ana.malloc.unique_address_count") < 1 then ( + print_endline "Setting \"ana.malloc.unique_address_count\" to 1"; + set_int "ana.malloc.unique_address_count" 1; + ); + let memSafetyAnas = ["memOutOfBounds"; "memLeak"; "useAfterFree";] in + enableAnalyses memSafetyAnas) | _ -> () -let focusOnMemSafetySpecification () = - List.iter focusOnMemSafetySpecification (Svcomp.Specification.of_option ()) - -let focusOnTermination (spec: Svcomp.Specification.t) = - match spec with - | Termination -> - let terminationAnas = ["termination"; "threadflag"; "apron"] in - print_endline @@ "Specification: Termination -> enabling termination analyses \"" ^ (String.concat ", " terminationAnas) ^ "\""; - enableAnalyses terminationAnas; - set_string "sem.int.signed_overflow" "assume_none"; - set_bool "ana.int.interval" true; - set_string "ana.apron.domain" "polyhedra"; (* TODO: Needed? *) - () - | _ -> () - -let focusOnTermination () = - List.iter focusOnTermination (Svcomp.Specification.of_option ()) - -let focusOnSpecification (spec: Svcomp.Specification.t) = - match spec with +let focusOnSpecification () = + match Svcomp.Specification.of_option () with | UnreachCall s -> () | NoDataRace -> (*enable all thread analyses*) print_endline @@ "Specification: NoDataRace -> enabling thread analyses \"" ^ (String.concat ", " notNeccessaryThreadAnalyses) ^ "\""; @@ -265,9 +253,6 @@ let focusOnSpecification (spec: Svcomp.Specification.t) = set_bool "ana.int.interval" true | _ -> () -let focusOnSpecification () = - List.iter focusOnSpecification (Svcomp.Specification.of_option ()) - (*Detect enumerations and enable the "ana.int.enums" option*) exception EnumFound class enumVisitor = object @@ -424,10 +409,9 @@ let congruenceOption factors file = let apronOctagonOption factors file = let locals = if List.mem "specification" (get_string_list "ana.autotune.activated" ) && get_string "ana.specification" <> "" then - if List.mem Svcomp.Specification.NoOverflow (Svcomp.Specification.of_option ()) then - 12 - else - 8 + match Svcomp.Specification.of_option () with + | NoOverflow -> 12 + | _ -> 8 else 8 in let globals = 2 in let selectedLocals = @@ -475,17 +459,6 @@ let wideningOption factors file = print_endline "Enabled widening thresholds"; } -let activateTmpSpecialAnalysis () = - let isMathFun = function - | LibraryDesc.Math _ -> true - | _ -> false - in - let hasMathFunctions = hasFunction isMathFun in - if hasMathFunctions then ( - print_endline @@ "math function -> enabling tmpSpecial analysis and floating-point domain"; - enableAnalyses ["tmpSpecial"]; - set_bool "ana.float.interval" true; - ) let estimateComplexity factors file = let pathsEstimate = factors.loops + factors.controlFlowStatements / 90 in @@ -515,14 +488,6 @@ let chooseFromOptions costTarget options = let isActivated a = get_bool "ana.autotune.enabled" && List.mem a @@ get_string_list "ana.autotune.activated" -let isTerminationTask () = List.mem Svcomp.Specification.Termination (Svcomp.Specification.of_option ()) - -let specificationIsActivated () = - isActivated "specification" && get_string "ana.specification" <> "" - -let specificationTerminationIsActivated () = - isActivated "termination" - let chooseConfig file = let factors = collectFactors visitCilFileSameGlobals file in let fileCompplexity = estimateComplexity factors file in @@ -542,7 +507,7 @@ let chooseConfig file = if isActivated "mallocWrappers" then findMallocWrappers (); - if specificationIsActivated () then + if isActivated "specification" && get_string "ana.specification" <> "" then focusOnSpecification (); if isActivated "enums" && hasEnums file then @@ -554,15 +519,12 @@ let chooseConfig file = if isActivated "arrayDomain" then selectArrayDomains file; - if isActivated "tmpSpecialAnalysis" then - activateTmpSpecialAnalysis (); - let options = [] in let options = if isActivated "congruence" then (congruenceOption factors file)::options else options in - (* Termination analysis uses apron in a different configuration. *) - let options = if isActivated "octagon" && not (isTerminationTask ()) then (apronOctagonOption factors file)::options else options in + let options = if isActivated "octagon" then (apronOctagonOption factors file)::options else options in let options = if isActivated "wideningThresholds" then (wideningOption factors file)::options else options in List.iter (fun o -> o.activate ()) @@ chooseFromOptions (totalTarget - fileCompplexity) options + let reset_lazy () = ResettableLazy.reset functionCallMaps diff --git a/src/build-info/dune b/src/build-info/dune index ff8d68671b5..c1de250263f 100644 --- a/src/build-info/dune +++ b/src/build-info/dune @@ -27,6 +27,3 @@ (mode (promote (until-clean) (only configOcaml.ml))) ; replace existing file in source tree, even if releasing (only overrides) (action (write-file %{target} "(* Automatically regenerated, changes do not persist! *)\nlet flambda = \"%{ocaml-config:flambda}\""))) -(env - (_ - (flags (:standard -w -no-cmx-file)))) ; suppress warning from flambda compiler bug: https://github.com/ocaml/dune/issues/3277 diff --git a/src/cdomain/value/cdomain_value.mld b/src/cdomain/value/cdomain_value.mld deleted file mode 100644 index 668bbfa0ca8..00000000000 --- a/src/cdomain/value/cdomain_value.mld +++ /dev/null @@ -1,71 +0,0 @@ -{0 Library goblint.cdomain.value} -This library is unwrapped and provides the following top-level modules. -For better context, see {!Goblint_lib} which also documents these modules. - - -{1 Domains} - -{2 Analysis-specific} - -{3 Value} - -{4 Non-relational} - -{5 Numeric} -{!modules: -IntDomain -FloatDomain -} - -{5 Addresses} -{!modules: -Mval -Offset -StringDomain -AddressDomain -} - -{5 Complex} -{!modules: -StructDomain -UnionDomain -ArrayDomain -NullByteSet -JmpBufDomain -} - -{5 Combined} -{!modules: -ValueDomain -ValueDomainQueries -} - -{3 Concurrency} -{!modules: -MutexAttrDomain -ThreadIdDomain -ConcDomain -} - -{3 Other} -{!modules: -Lval -} - - -{1 I/O} - -{2 Witnesses} -{!modules: -Invariant -InvariantCil -} - - -{1 Utilities} - -{2 Analysis-specific} -{!modules: -PrecisionUtil -WideningThresholds -} diff --git a/src/cdomain/value/cdomains/nullByteSet.ml b/src/cdomain/value/cdomains/nullByteSet.ml deleted file mode 100644 index ff5d0270e0d..00000000000 --- a/src/cdomain/value/cdomains/nullByteSet.ml +++ /dev/null @@ -1,202 +0,0 @@ -(** Abstract domains for tracking [NULL] bytes in C arrays. *) - -module MustSet = struct - module M = SetDomain.Reverse (SetDomain.ToppedSet (IntDomain.BigInt) (struct let topname = "All Null" end)) - include M - - let compute_set len = - List.init (Z.to_int len) Z.of_int - |> of_list - - let remove i must_nulls_set min_size = - if M.is_bot must_nulls_set then - M.remove i (compute_set min_size) - else - M.remove i must_nulls_set - - let filter ?min_size cond must_nulls_set = - if M.is_bot must_nulls_set then - match min_size with - | Some min_size -> M.filter cond (compute_set min_size) - | _ -> M.empty () - else - M.filter cond must_nulls_set - - let min_elt must_nulls_set = - if M.is_bot must_nulls_set then - Z.zero - else - M.min_elt must_nulls_set - - let interval_mem (l,u) set = - if M.is_bot set then - true - else if Z.lt (Z.of_int (M.cardinal set)) (Z.sub u l) then - false - else - let rec check_all_indexes i = - if Z.gt i u then - true - else if M.mem i set then - check_all_indexes (Z.succ i) - else - false in - check_all_indexes l -end - -module MaySet = struct - module M = SetDomain.ToppedSet (IntDomain.BigInt) (struct let topname = "All Null" end) - include M - - let elements ?max_size may_nulls_set = - if M.is_top may_nulls_set then - match max_size with - | Some max_size -> M.elements @@ MustSet.compute_set max_size - | _ -> failwith "top and no max size supplied" - else - M.elements may_nulls_set - - let remove i may_nulls_set max_size = - if M.is_top may_nulls_set then - M.remove i (MustSet.compute_set max_size) - else - M.remove i may_nulls_set - - let filter ?max_size cond may_nulls_set = - if M.is_top may_nulls_set then - match max_size with - | Some max_size -> M.filter cond (MustSet.compute_set max_size) - | _ -> may_nulls_set - else - M.filter cond may_nulls_set - - let min_elt may_nulls_set = - if M.is_top may_nulls_set then - Z.zero - else - M.min_elt may_nulls_set -end - -module MustMaySet = struct - include Lattice.Prod (MustSet) (MaySet) - - module Set = SetDomain.Make (IntDomain.BigInt) - - type mode = Definitely | Possibly - - let empty () = (MustSet.top (), MaySet.bot ()) - - let full_set () = (MustSet.bot (), MaySet.top ()) - - let is_empty mode (musts, mays) = - match mode with - | Definitely -> MaySet.is_empty mays - | Possibly -> MustSet.is_empty musts - - let min_elem mode (musts, mays) = - match mode with - | Definitely -> MustSet.min_elt musts - | Possibly -> MaySet.min_elt mays - - let min_elem_precise x = - Z.equal (min_elem Definitely x) (min_elem Possibly x) - - let mem mode i (musts, mays) = - match mode with - | Definitely -> MustSet.mem i musts - | Possibly -> MaySet.mem i mays - - let interval_mem mode (l,u) (musts, mays) = - match mode with - | Definitely -> MustSet.interval_mem (l,u) musts - | Possibly -> failwith "not implemented" - - let remove mode i (musts, mays) min_size = - match mode with - | Definitely -> (MustSet.remove i musts min_size, MaySet.remove i mays min_size) - | Possibly -> (MustSet.remove i musts min_size, mays) - - let add mode i (musts, mays) = - match mode with - | Definitely -> (MustSet.add i musts, MaySet.add i mays) - | Possibly -> (musts, MaySet.add i mays) - - let add_list mode l (musts, mays) = - match mode with - | Definitely -> failwith "todo" - | Possibly -> (musts, MaySet.union (MaySet.of_list l) mays) - - let add_interval ?maxfull mode (l,u) (musts, mays) = - let rec add_indexes i max set = - if Z.gt i max then - set - else - add_indexes (Z.succ i) max (MaySet.add i set) - in - let mays = - match maxfull with - | Some Some maxfull when Z.equal l Z.zero && Z.geq u maxfull -> - MaySet.top () - | _ -> - add_indexes l u mays - in - match mode with - | Definitely -> (add_indexes l u musts, mays) - | Possibly -> (musts, mays) - - let remove_interval mode (l,u) min_size (musts, mays) = - match mode with - | Definitely -> failwith "todo" - | Possibly -> - if Z.equal l Z.zero && Z.geq u min_size then - (MustSet.top (), mays) - else - (MustSet.filter ~min_size (fun x -> (Z.lt x l || Z.gt x u) && Z.lt x min_size) musts, mays) - - let add_all mode (musts, mays) = - match mode with - | Definitely -> failwith "todo" - | Possibly -> (musts, MaySet.top ()) - - let remove_all mode (musts, mays) = - match mode with - | Possibly -> (MustSet.top (), mays) - | Definitely -> empty () - - let is_full_set mode (musts, mays) = - match mode with - | Definitely -> MustSet.is_bot musts - | Possibly -> MaySet.is_top mays - - let get_set mode (musts, mays) = - match mode with - | Definitely -> musts - | Possibly -> mays - - let elements ?max_size ?min_size mode (musts, mays) = - match mode with - | Definitely ->failwith "todo" - | Possibly -> MaySet.elements ?max_size mays - - let union_mays (must,mays) (_,mays2) = (must, MaySet.join mays mays2) - - - let precise_singleton i = - (MustSet.singleton i, MaySet.singleton i) - - let precise_set (s:Set.t):t = (`Lifted s,`Lifted s) - - let make_all_must () = (MustSet.bot (), MaySet.top ()) - - let may_can_benefit_from_filter (musts, mays) = not (MaySet.is_top mays) - - let exists mode f (musts, mays) = - match mode with - | Definitely -> MustSet.exists f musts - | Possibly -> MaySet.exists f mays - - let filter ?min_size ?max_size f (must, mays):t = - (MustSet.filter ?min_size f must, MaySet.filter ?max_size f mays) - - let filter_musts f min_size (musts, mays) = (MustSet.filter ~min_size f musts, mays) -end diff --git a/src/cdomain/value/cdomains/stringDomain.ml b/src/cdomain/value/cdomains/stringDomain.ml deleted file mode 100644 index 0621f37eb6d..00000000000 --- a/src/cdomain/value/cdomains/stringDomain.ml +++ /dev/null @@ -1,114 +0,0 @@ -include Printable.StdLeaf - -let name () = "string" - -type string_domain = Unit | Disjoint | Flat - -let string_domain: string_domain ResettableLazy.t = - ResettableLazy.from_fun (fun () -> - match GobConfig.get_string "ana.base.strings.domain" with - | "unit" -> Unit - | "disjoint" -> Disjoint - | "flat" -> Flat - | _ -> failwith "ana.base.strings.domain: illegal value" - ) - -let get_string_domain () = ResettableLazy.force string_domain - -let reset_lazy () = - ResettableLazy.reset string_domain - - -type t = string option [@@deriving eq, ord, hash] - -let hash x = - if get_string_domain () = Disjoint then - hash x - else - 13859 - -let show = function - | Some x -> "\"" ^ x ^ "\"" - | None -> "(unknown string)" - -include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) - -let of_string x = - if get_string_domain () = Unit then - None - else - Some x -let to_string x = x - -(* only keep part before first null byte *) -let to_c_string = function - | Some x -> - begin match String.split_on_char '\x00' x with - | s::_ -> Some s - | [] -> None - end - | None -> None - -let to_n_c_string n x = - match to_c_string x with - | Some x -> - if n > String.length x then - Some x - else if n < 0 then - None - else - Some (String.sub x 0 n) - | None -> None - -let to_string_length x = - match to_c_string x with - | Some x -> Some (String.length x) - | None -> None - -let to_exp = function - | Some x -> GoblintCil.mkString x - | None -> raise (Lattice.Unsupported "Cannot express unknown string pointer as expression.") - -let semantic_equal x y = - match x, y with - | None, _ - | _, None -> Some true - | Some a, Some b -> if a = b then None else Some false - -let leq x y = - match x, y with - | _, None -> true - | a, b -> a = b - -let join x y = - match x, y with - | None, _ - | _, None -> None - | Some a, Some b when a = b -> Some a - | Some a, Some b (* when a <> b *) -> - if get_string_domain () = Disjoint then - raise Lattice.Uncomparable - else - None - -let meet x y = - match x, y with - | None, a - | a, None -> a - | Some a, Some b when a = b -> Some a - | Some a, Some b (* when a <> b *) -> - if get_string_domain () = Disjoint then - raise Lattice.Uncomparable - else - raise Lattice.BotValue - -let repr x = - if get_string_domain () = Disjoint then - x (* everything else is kept separate, including strings if not limited *) - else - None (* all strings together if limited *) diff --git a/src/cdomain/value/cdomains/stringDomain.mli b/src/cdomain/value/cdomains/stringDomain.mli deleted file mode 100644 index 66423caa0bb..00000000000 --- a/src/cdomain/value/cdomains/stringDomain.mli +++ /dev/null @@ -1,40 +0,0 @@ -(** String literals domain. *) - -include Printable.S - -val reset_lazy: unit -> unit -(** Reset the cached configuration of the string domain. *) - -val of_string: string -> t -(** Convert from string. *) - -val to_string: t -> string option -(** Convert to string if possible. *) - -(** C strings are different from OCaml strings as they are not processed after the first [NUL] byte, even though the OCaml string (and a C string literal) may be longer. *) - -val to_c_string: t -> string option -(** Convert to C string if possible. *) - -val to_n_c_string: int -> t -> string option -(** Convert to C string of given maximum length if possible. *) - -val to_string_length: t -> int option -(** Find length of C string if possible. *) - -val to_exp: t -> GoblintCil.exp -(** Convert to CIL expression. *) - -val semantic_equal: t -> t -> bool option -(** Check semantic equality of two strings. - - @return [Some true] if definitely equal, [Some false] if definitely not equal, [None] if unknown. *) - -(** Some {!Lattice.S} operations. *) - -val leq: t -> t -> bool -val join: t -> t -> t -val meet: t -> t -> t - -val repr : t -> t -(** Representative for address lattice. *) diff --git a/src/cdomain/value/dune b/src/cdomain/value/dune deleted file mode 100644 index c89d5be04d2..00000000000 --- a/src/cdomain/value/dune +++ /dev/null @@ -1,24 +0,0 @@ -(include_subdirs unqualified) - -(library - (name goblint_cdomain_value) - (public_name goblint.cdomain.value) - (wrapped false) ; TODO: wrap - (libraries - batteries.unthreaded - goblint_std - goblint_common - goblint_config - goblint_library - goblint_domain - goblint_incremental - goblint-cil) - (flags :standard -open Goblint_std) - (preprocess - (pps - ppx_deriving.std - ppx_deriving_hash - ppx_deriving_yojson)) - (instrumentation (backend bisect_ppx))) - -(documentation) diff --git a/src/cdomain/value/cdomains/addressDomain.ml b/src/cdomains/addressDomain.ml similarity index 83% rename from src/cdomain/value/cdomains/addressDomain.ml rename to src/cdomains/addressDomain.ml index 55b1aceefcf..5981caf9ea3 100644 --- a/src/cdomain/value/cdomains/addressDomain.ml +++ b/src/cdomains/addressDomain.ml @@ -5,7 +5,6 @@ open IntOps module M = Messages module Mval_outer = Mval -module SD = StringDomain module AddressBase (Mval: Printable.S) = @@ -15,14 +14,23 @@ struct | Addr of Mval.t | NullPtr | UnknownPtr - | StrPtr of SD.t + | StrPtr of string option [@@deriving eq, ord, hash] (* TODO: StrPtr equal problematic if the same literal appears more than once *) let name () = Format.sprintf "address (%s)" (Mval.name ()) + let hash x = match x with + | StrPtr _ -> + if GobConfig.get_bool "ana.base.limit-string-addresses" then + 13859 + else + hash x + | _ -> hash x + let show = function | Addr m -> Mval.show m - | StrPtr s -> StringDomain.show s + | StrPtr (Some x) -> "\"" ^ x ^ "\"" + | StrPtr None -> "(unknown string)" | UnknownPtr -> "?" | NullPtr -> "NULL" @@ -34,18 +42,31 @@ struct ) (* strings *) - let of_string x = StrPtr (SD.of_string x) + let of_string x = StrPtr (Some x) let to_string = function - | StrPtr s -> SD.to_string s + | StrPtr (Some x) -> Some x | _ -> None + (* only keep part before first null byte *) let to_c_string = function - | StrPtr s -> SD.to_c_string s + | StrPtr (Some x) -> + begin match String.split_on_char '\x00' x with + | s::_ -> Some s + | [] -> None + end | _ -> None - let to_n_c_string n = function - | StrPtr s -> SD.to_n_c_string n s + let to_n_c_string n x = + match to_c_string x with + | Some x -> + if n > String.length x then + Some x + else if n < 0 then + None + else + Some (String.sub x 0 n) | _ -> None - let to_string_length = function - | StrPtr s -> SD.to_string_length s + let to_string_length x = + match to_c_string x with + | Some x -> Some (String.length x) | _ -> None let arbitrary () = QCheck.always UnknownPtr (* S TODO: non-unknown *) @@ -80,7 +101,8 @@ struct (* TODO: seems to be unused *) let to_exp = function | Addr m -> AddrOf (Mval.to_cil m) - | StrPtr s -> SD.to_exp s + | StrPtr (Some x) -> mkString x + | StrPtr None -> raise (Lattice.Unsupported "Cannot express unknown string pointer as expression.") | NullPtr -> integer 0 | UnknownPtr -> raise Lattice.TopValue (* TODO: unused *) @@ -101,7 +123,9 @@ struct let semantic_equal x y = match x, y with | Addr x, Addr y -> Mval.semantic_equal x y - | StrPtr s1, StrPtr s2 -> SD.semantic_equal s1 s2 + | StrPtr None, StrPtr _ + | StrPtr _, StrPtr None -> Some true + | StrPtr (Some a), StrPtr (Some b) -> if a = b then None else Some false | NullPtr, NullPtr -> Some true | UnknownPtr, UnknownPtr | UnknownPtr, Addr _ @@ -111,7 +135,8 @@ struct | _, _ -> Some false let leq x y = match x, y with - | StrPtr s1, StrPtr s2 -> SD.leq s1 s2 + | StrPtr _, StrPtr None -> true + | StrPtr a, StrPtr b -> a = b | Addr x, Addr y -> Mval.leq x y | _ -> x = y @@ -119,6 +144,26 @@ struct | Addr x -> Addr (Mval.top_indices x) | x -> x + let join_string_ptr x y = match x, y with + | None, _ + | _, None -> None + | Some a, Some b when a = b -> Some a + | Some a, Some b (* when a <> b *) -> + if GobConfig.get_bool "ana.base.limit-string-addresses" then + None + else + raise Lattice.Uncomparable + + let meet_string_ptr x y = match x, y with + | None, a + | a, None -> a + | Some a, Some b when a = b -> Some a + | Some a, Some b (* when a <> b *) -> + if GobConfig.get_bool "ana.base.limit-string-addresses" then + raise Lattice.BotValue + else + raise Lattice.Uncomparable + let merge mop sop x y = match x, y with | UnknownPtr, UnknownPtr -> UnknownPtr @@ -127,10 +172,10 @@ struct | Addr x, Addr y -> Addr (mop x y) | _ -> raise Lattice.Uncomparable - let join = merge Mval.join SD.join - let widen = merge Mval.widen SD.join - let meet = merge Mval.meet SD.meet - let narrow = merge Mval.narrow SD.meet + let join = merge Mval.join join_string_ptr + let widen = merge Mval.widen join_string_ptr + let meet = merge Mval.meet meet_string_ptr + let narrow = merge Mval.narrow meet_string_ptr include Lattice.NoBotTop @@ -149,7 +194,8 @@ struct let of_elt (x: elt): t = match x with | Addr (v, o) -> Addr v - | StrPtr s -> StrPtr (SD.repr s) + | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) + | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) | NullPtr -> NullPtr | UnknownPtr -> UnknownPtr end @@ -165,7 +211,8 @@ struct let of_elt (x: elt): t = match x with | Addr (v, o) -> Addr (v, Offset.Unit.of_offs o) (* addrs grouped by var and part of offset *) - | StrPtr s -> StrPtr (SD.repr s) + | StrPtr _ when GobConfig.get_bool "ana.base.limit-string-addresses" -> StrPtr None (* all strings together if limited *) + | StrPtr x -> StrPtr x (* everything else is kept separate, including strings if not limited *) | NullPtr -> NullPtr | UnknownPtr -> UnknownPtr end diff --git a/src/cdomain/value/cdomains/addressDomain.mli b/src/cdomains/addressDomain.mli similarity index 100% rename from src/cdomain/value/cdomains/addressDomain.mli rename to src/cdomains/addressDomain.mli diff --git a/src/cdomain/value/cdomains/addressDomain_intf.ml b/src/cdomains/addressDomain_intf.ml similarity index 91% rename from src/cdomain/value/cdomains/addressDomain_intf.ml rename to src/cdomains/addressDomain_intf.ml index f65b2977c4a..0ef3d6dd8d8 100644 --- a/src/cdomain/value/cdomains/addressDomain_intf.ml +++ b/src/cdomains/addressDomain_intf.ml @@ -7,7 +7,7 @@ sig | Addr of Mval.t (** Pointer to mvalue. *) | NullPtr (** NULL pointer. *) | UnknownPtr (** Unknown pointer. Could point to globals, heap and escaped variables. *) - | StrPtr of StringDomain.t (** String literal pointer. [StrPtr None] abstracts any string pointer *) + | StrPtr of string option (** String literal pointer. [StrPtr None] abstracts any string pointer *) include Printable.S with type t := t (** @closed *) val of_string: string -> t @@ -16,6 +16,8 @@ sig val to_string: t -> string option (** Convert {!StrPtr} to string if possible. *) + (** C strings are different from OCaml strings as they are not processed after the first [NUL] byte, even though the OCaml string (and a C string literal) may be longer. *) + val to_c_string: t -> string option (** Convert {!StrPtr} to C string if possible. *) @@ -69,7 +71,7 @@ sig - Each {!Addr}, modulo precise index expressions in the offset, is a sublattice with ordering induced by {!Mval}. - {!NullPtr} is a singleton sublattice. - {!UnknownPtr} is a singleton sublattice. - - If [ana.base.strings.domain] is disjoint, then each {!StrPtr} is a singleton sublattice. Otherwise, all {!StrPtr} are together in one sublattice with flat ordering. *) + - If [ana.base.limit-string-addresses] is enabled, then all {!StrPtr} are together in one sublattice with flat ordering. If [ana.base.limit-string-addresses] is disabled, then each {!StrPtr} is a singleton sublattice. *) module AddressLattice (Mval: Mval.Lattice): sig include module type of AddressPrintable (Mval) diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 55937a323d3..a6f00fdba07 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -10,7 +10,7 @@ open Batteries open GoblintCil open Pretty module M = Messages -open GobApron +open Apron open VectorMatrix module Mpqf = struct @@ -26,12 +26,14 @@ module Mpqf = struct let hash x = 31 * (Z.hash (get_den x)) + Z.hash (get_num x) end -module V = RelationDomain.V +module Var = SharedFunctions.Var +module V = RelationDomain.V(Var) (** It defines the type t of the affine equality domain (a struct that contains an optional matrix and an apron environment) and provides the functions needed for handling variables (which are defined by RelationDomain.D2) such as add_vars remove_vars. Furthermore, it provides the function get_coeff_vec that parses an apron expression into a vector of coefficients if the apron expression has an affine form. *) module VarManagement (Vec: AbstractVector) (Mx: AbstractMatrix)= struct + include SharedFunctions.EnvOps module Vector = Vec (Mpqf) module Matrix = Mx(Mpqf) (Vec) @@ -53,50 +55,39 @@ struct let copy t = {t with d = Option.map Matrix.copy t.d} let dim_add (ch: Apron.Dim.change) m = - Array.modifyi (fun i x -> x + i) ch.dim; (* could be written Array.modifyi (+) ch.dim; but that's too smart *) + Array.iteri (fun i x -> ch.dim.(i) <- x + i) ch.dim; Matrix.add_empty_columns m ch.dim let dim_add ch m = timing_wrap "dim add" (dim_add ch) m let dim_remove (ch: Apron.Dim.change) m del = - if Array.length ch.dim = 0 || Matrix.is_empty m then - m - else ( - Array.modifyi (fun i x -> x + i) ch.dim; + if Array.length ch.dim = 0 || Matrix.is_empty m then m else ( + Array.iteri (fun i x-> ch.dim.(i) <- x + i) ch.dim; let m' = if not del then let m = Matrix.copy m in Array.fold_left (fun y x -> Matrix.reduce_col_with y x; y) m ch.dim else m in Matrix.remove_zero_rows @@ Matrix.del_cols m' ch.dim) let dim_remove ch m del = timing_wrap "dim remove" (dim_remove ch m) del let change_d t new_env add del = - if Environment.equal t.env new_env then - t - else - match t.d with + if Environment.equal t.env new_env then t else + let dim_change = if add then Environment.dimchange t.env new_env + else Environment.dimchange new_env t.env + in match t.d with | None -> bot_env - | Some m -> - let dim_change = - if add then - Environment.dimchange t.env new_env - else - Environment.dimchange new_env t.env - in - {d = Some (if add then dim_add dim_change m else dim_remove dim_change m del); env = new_env} + | Some m -> {d = Some (if add then dim_add dim_change m else dim_remove dim_change m del); env = new_env} let change_d t new_env add del = timing_wrap "dimension change" (change_d t new_env add) del - let vars x = Environment.ivars_only x.env - let add_vars t vars = let t = copy t in - let env' = Environment.add_vars t.env vars in + let env' = add_vars t.env vars in change_d t env' true false let add_vars t vars = timing_wrap "add_vars" (add_vars t) vars let drop_vars t vars del = let t = copy t in - let env' = Environment.remove_vars t.env vars in + let env' = remove_vars t.env vars in change_d t env' false del let drop_vars t vars = timing_wrap "drop_vars" (drop_vars t) vars @@ -111,7 +102,7 @@ struct t.env <- t'.env let remove_filter t f = - let env' = Environment.remove_filter t.env f in + let env' = remove_filter t.env f in change_d t env' false false let remove_filter t f = timing_wrap "remove_filter" (remove_filter t) f @@ -123,25 +114,25 @@ struct let keep_filter t f = let t = copy t in - let env' = Environment.keep_filter t.env f in + let env' = keep_filter t.env f in change_d t env' false false let keep_filter t f = timing_wrap "keep_filter" (keep_filter t) f let keep_vars t vs = let t = copy t in - let env' = Environment.keep_vars t.env vs in + let env' = keep_vars t.env vs in change_d t env' false false let keep_vars t vs = timing_wrap "keep_vars" (keep_vars t) vs + let vars t = vars t.env let mem_var t var = Environment.mem_var t.env var include ConvenienceOps(Mpqf) - (** Get the constant from the vector if it is a constant *) - let to_constant_opt v = match Vector.findi ((<>:) Mpqf.zero) v with + let get_c v = match Vector.findi (fun x -> x <>: Mpqf.zero) v with | exception Not_found -> Some Mpqf.zero | i when Vector.compare_length_with v (i + 1) = 0 -> Some (Vector.nth v i) | _ -> None @@ -152,56 +143,51 @@ struct let open Apron.Texpr1 in let exception NotLinear in let zero_vec = Vector.zero_vec @@ Environment.size t.env + 1 in - let neg v = Vector.map_with Mpqf.neg v; v in + let neg v = Vector.map_with (fun x -> Mpqf.mone *: x) v; v in let is_const_vec v = Vector.compare_length_with (Vector.filteri (fun i x -> (*Inefficient*) Vector.compare_length_with v (i + 1) > 0 && x <>: Mpqf.zero) v) 1 = 0 in - let rec convert_texpr = function - (*If x is a constant, replace it with its const. val. immediately*) - | Cst x -> - let of_union = function - | Coeff.Interval _ -> failwith "Not a constant" - | Scalar Float x -> Mpqf.of_float x - | Scalar Mpqf x -> x - | Scalar Mpfrf x -> Mpfr.to_mpq x - in - Vector.set_val zero_vec ((Vector.length zero_vec) - 1) (of_union x) - | Var x -> - let zero_vec_cp = Vector.copy zero_vec in - let entry_only v = Vector.set_val_with v (Environment.dim_of_var t.env x) Mpqf.one; v in - begin match t.d with - | Some m -> - let row = Matrix.find_opt (fun r -> Vector.nth r (Environment.dim_of_var t.env x) =: Mpqf.one) m in - begin match row with - | Some v when is_const_vec v -> - Vector.set_val_with zero_vec_cp ((Vector.length zero_vec) - 1) (Vector.nth v (Vector.length v - 1)); zero_vec_cp - | _ -> entry_only zero_vec_cp - end - | None -> entry_only zero_vec_cp end - | Unop (Neg, e, _, _) -> neg @@ convert_texpr e - | Unop (Cast, e, _, _) -> convert_texpr e (*Ignore since casts in apron are used for floating point nums and rounding in contrast to CIL casts*) - | Unop (Sqrt, e, _, _) -> raise NotLinear - | Binop (Add, e1, e2, _, _) -> - let v1 = convert_texpr e1 in - let v2 = convert_texpr e2 in - Vector.map2_with (+:) v1 v2; v1 - | Binop (Sub, e1, e2, _, _) -> - let v1 = convert_texpr e1 in - let v2 = convert_texpr e2 in - Vector.map2_with (+:) v1 (neg @@ v2); v1 - | Binop (Mul, e1, e2, _, _) -> - let v1 = convert_texpr e1 in - let v2 = convert_texpr e2 in - begin match to_constant_opt v1, to_constant_opt v2 with - | _, Some c -> Vector.apply_with_c_with ( *:) c v1; v1 - | Some c, _ -> Vector.apply_with_c_with ( *:) c v2; v2 - | _, _ -> raise NotLinear - end - | Binop _ -> raise NotLinear - in - try - Some (convert_texpr texp) - with NotLinear -> None + let rec convert_texpr texp = + begin match texp with + (*If x is a constant, replace it with its const. val. immediately*) + | Cst x -> let of_union union = + let open Coeff in + match union with + | Interval _ -> failwith "Not a constant" + | Scalar x -> (match x with + | Float x -> Mpqf.of_float x + | Mpqf x -> x + | Mpfrf x -> Mpfr.to_mpq x) in Vector.set_val zero_vec ((Vector.length zero_vec) - 1) (of_union x) + | Var x -> + let zero_vec_cp = Vector.copy zero_vec in + let entry_only v = Vector.set_val_with v (Environment.dim_of_var t.env x) Mpqf.one; v in + begin match t.d with + | Some m -> let row = Matrix.find_opt (fun r -> Vector.nth r (Environment.dim_of_var t.env x) =: Mpqf.one) m in + begin match row with + | Some v when is_const_vec v -> + Vector.set_val_with zero_vec_cp ((Vector.length zero_vec) - 1) (Vector.nth v (Vector.length v - 1)); zero_vec_cp + | _ -> entry_only zero_vec_cp end + | None -> entry_only zero_vec_cp end + | Unop (u, e, _, _) -> + begin match u with + | Neg -> neg @@ convert_texpr e + | Cast -> convert_texpr e (*Ignore since casts in apron are used for floating point nums and rounding in contrast to CIL casts*) + | Sqrt -> raise NotLinear end + | Binop (b, e1, e2, _, _) -> + begin match b with + | Add -> let v1 = convert_texpr e1 in Vector.map2_with (+:) v1 (convert_texpr e2); v1 + | Sub -> let v1 = convert_texpr e1 in Vector.map2_with (+:) v1 (neg @@ convert_texpr e2); v1 + | Mul -> + let x1, x2 = convert_texpr e1, convert_texpr e2 in + begin match get_c x1, get_c x2 with + | _, Some c -> Vector.apply_with_c_with ( *:) c x1; x1 + | Some c, _ -> Vector.apply_with_c_with ( *:) c x2; x2 + | _, _ -> raise NotLinear end + | _ -> raise NotLinear end + end + in match convert_texpr texp with + | exception NotLinear -> None + | x -> Some(x) let get_coeff_vec t texp = timing_wrap "coeff_vec" (get_coeff_vec t) texp end @@ -213,22 +199,20 @@ struct let bound_texpr t texpr = let texpr = Texpr1.to_expr texpr in - match Option.bind (get_coeff_vec t texpr) to_constant_opt with - | Some c when Mpqf.get_den c = IntOps.BigIntOps.one -> - let int_val = Mpqf.get_num c in - Some int_val, Some int_val + match get_coeff_vec t texpr with + | Some v -> begin match get_c v with + | Some c when Mpqf.get_den c = IntOps.BigIntOps.one -> + let int_val = Mpqf.get_num c + in Some int_val, Some int_val + | _ -> None, None end | _ -> None, None let bound_texpr d texpr1 = let res = bound_texpr d texpr1 in - (if M.tracing then - match res with - | Some min, Some max -> M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string min) (IntOps.BigIntOps.to_string max) - | _ -> () - ); - res - + match res with + | Some min, Some max -> if M.tracing then M.tracel "bounds" "min: %s max: %s" (IntOps.BigIntOps.to_string min) (IntOps.BigIntOps.to_string max); res + | _ -> res let bound_texpr d texpr1 = timing_wrap "bounds calculation" (bound_texpr d) texpr1 end @@ -247,51 +231,44 @@ struct let show t = let conv_to_ints row = - let row = Array.copy @@ Vector.to_array row in - let mpqf_of_z x = Mpqf.of_mpz @@ Z_mlgmpidl.mpzf_of_z x in - let lcm = mpqf_of_z @@ Array.fold_left (fun x y -> Z.lcm x (Mpqf.get_den y)) Z.one row in - Array.modify (( *:) lcm) row; - let int_arr = Array.map Mpqf.get_num row in - let div = Array.fold_left Z.gcd int_arr.(0) int_arr in - Array.modify (fun x -> Z.div x div) int_arr; - int_arr + let module BI = IntOps.BigIntOps in + let row = Array.copy @@ Vector.to_array row + in + for i = 0 to Array.length row -1 do + let val_i = Mpqf.of_mpz @@ Z_mlgmpidl.mpzf_of_z @@ Mpqf.get_den row.(i) + in Array.iteri(fun j x -> row.(j) <- val_i *: x) row + done; + let int_arr = Array.init (Array.length row) (fun i -> Mpqf.get_num row.(i)) + in let div = Mpqf.of_mpz @@ Z_mlgmpidl.mpzf_of_z @@ Array.fold_left BI.gcd int_arr.(0) int_arr + in Array.iteri (fun i x -> row.(i) <- x /: div) row; + Vector.of_array @@ row in - let vec_to_constraint arr env = - let vars, _ = Environment.vars env in - let dim_to_str var = - let coeff = arr.(Environment.dim_of_var env var) in - if Z.equal coeff Z.zero then - "" - else - let coeff_str = - if Z.equal coeff Z.one then "+" - else if Z.equal coeff Z.minus_one then "-" - 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 + let vec_to_constraint vec env = + let vars, _ = Environment.vars env + in let dim_to_str var = + let vl = Vector.nth vec (Environment.dim_of_var env var) + in let var_str = Var.to_string var + in if vl =: Mpqf.one then "+" ^ var_str + else if vl =: Mpqf.mone then "-" ^ var_str + else if vl <: Mpqf.mone then Mpqf.to_string vl ^ var_str + else if vl >: Mpqf.one then Format.asprintf "+%s" (Mpqf.to_string vl) ^ var_str + else "" in - let const_to_str vl = - if Z.equal vl Z.zero then - "" - else - let negated = Z.neg vl in - if Z.gt negated Z.zero then "+" ^ Z.to_string negated - else Z.to_string negated + let c_to_str vl = + if vl >: Mpqf.zero then "-" ^ Mpqf.to_string vl + else if vl <: Mpqf.zero then "+" ^ Mpqf.to_string vl + else "" 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 - String.sub res 1 (String.length res - 1) - else - res + ^ (c_to_str @@ Vector.nth vec (Vector.length vec - 1)) ^ "=0" + in if String.starts_with res "+" then String.sub res 1 (String.length res - 1) else res in match t.d with | None -> "Bottom Env" | 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) ^"|]") + 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) ^"|]") 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))) @@ -315,21 +292,15 @@ struct let meet t1 t2 = let sup_env = Environment.lce t1.env t2.env in - let t1, t2 = change_d t1 sup_env true false, change_d t2 sup_env true false in - if is_bot t1 || is_bot t2 then - bot () - else - (* TODO: Why can I be sure that m1 && m2 are all Some here? *) + let t1, t2 = change_d t1 sup_env true false, change_d t2 sup_env true false + in if is_bot t1 || is_bot t2 then bot() else let m1, m2 = Option.get t1.d, Option.get t2.d in - if is_top_env t1 then - {d = Some (dim_add (Environment.dimchange t2.env sup_env) m2); env = sup_env} - else if is_top_env t2 then - {d = Some (dim_add (Environment.dimchange t1.env sup_env) m1); env = sup_env} - else - let rref_matr = Matrix.rref_matrix_with (Matrix.copy m1) (Matrix.copy m2) in - if Option.is_none rref_matr then - bot () - else + match m1, m2 with + | x, y when is_top_env t1-> {d = Some (dim_add (Environment.dimchange t2.env sup_env) y); env = sup_env} + | x, y when is_top_env t2 -> {d = Some (dim_add (Environment.dimchange t1.env sup_env) x); env = sup_env} + | x, y -> + let rref_matr = Matrix.rref_matrix_with (Matrix.copy x) (Matrix.copy y) in + if Option.is_none rref_matr then bot () else {d = rref_matr; env = sup_env} @@ -342,20 +313,12 @@ struct let leq t1 t2 = let env_comp = Environment.compare t1.env t2.env in (* Apron's Environment.compare 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) *) - (* 0: if equality, (OK) *) - (* +1: if env1 is a superset of env2, and +2 otherwise (the lce exists and is a strict superset of both) *) - false - else if is_bot t1 || is_top_env t2 then - true - else if is_bot t2 || is_top_env t1 then - false - else + if env_comp = -2 || env_comp > 0 then false else + if is_bot t1 || is_top_env t2 then true else + if is_bot t2 || is_top_env t1 then false else ( let m1, m2 = Option.get t1.d, Option.get t2.d in let m1' = if env_comp = 0 then m1 else dim_add (Environment.dimchange t1.env t2.env) m1 in - Matrix.is_covered_by m2 m1' + Matrix.is_covered_by m2 m1') let leq a b = timing_wrap "leq" (leq a) b @@ -376,25 +339,23 @@ struct let case_three a b col_a col_b max = let col_a, col_b = Vector.copy col_a, Vector.copy col_b in let col_a, col_b = Vector.keep_vals col_a max, Vector.keep_vals col_b max in - if Vector.equal col_a col_b then - (a, b, max) - else - ( - Vector.rev_with col_a; - Vector.rev_with col_b; - let i = Vector.find2i (<>:) col_a col_b in - let (x, y) = Vector.nth col_a i, Vector.nth col_b i in - let r, diff = Vector.length col_a - (i + 1), x -: y in - let a_r, b_r = Matrix.get_row a r, Matrix.get_row b r in - Vector.map2_with (-:) col_a col_b; - Vector.rev_with col_a; - let multiply_by_t m t = - Matrix.map2i_with (fun i' x c -> if i' <= max then (let beta = c /: diff in - Vector.map2_with (fun u j -> u -: (beta *: j)) x t); x) m col_a; - m - in - Matrix.remove_row (multiply_by_t a a_r) r, Matrix.remove_row (multiply_by_t b b_r) r, (max - 1) - ) + if Vector.equal col_a col_b then (a, b, max) else + let a_rev, b_rev = (Vector.rev_with col_a; col_a), (Vector.rev_with col_b; col_b) in + let i = Vector.find2i (fun x y -> x <>: y) a_rev b_rev in + let (x, y) = Vector.nth a_rev i, Vector.nth b_rev i in + let r, diff = Vector.length a_rev - (i + 1), x -: y in + let a_r, b_r = Matrix.get_row a r, Matrix.get_row b r in + let sub_col = + Vector.map2_with (fun x y -> x -: y) a_rev b_rev; + Vector.rev_with a_rev; + a_rev + in + let multiply_by_t m t = + Matrix.map2i_with (fun i' x c -> if i' <= max then (let beta = c /: diff in + Vector.map2_with (fun u j -> u -: (beta *: j)) x t); x) m sub_col; + m + in + Matrix.remove_row (multiply_by_t a a_r) r, Matrix.remove_row (multiply_by_t b b_r) r, (max - 1) in let col_a, col_b = Matrix.get_col a s, Matrix.get_col b s in let nth_zero v i = match Vector.nth v i with @@ -411,11 +372,7 @@ struct lin_disjunc new_r (s + 1) new_a new_b | _ -> failwith "Matrix not in rref form" end in - if is_bot a then - b - else if is_bot b then - a - else + if is_bot a then b else if is_bot b then a 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) -> @@ -432,34 +389,33 @@ struct let res = join a b in if M.tracing then M.tracel "join" "join a: %s b: %s -> %s \n" (show a) (show b) (show res) ; res - let widen a b = - if Environment.equal a.env b.env then + let a_env = a.env in + let b_env = b.env in + if Environment.equal a_env b_env then join a b - else - b + else b let narrow a b = a - let pretty_diff () (x, y) = dprintf "%s: %a not leq %a" (name ()) pretty x pretty y - let remove_rels_with_var x var env inplace = + let remove_rels_with_var x var env imp = let j0 = Environment.dim_of_var env var in - if inplace then - (Matrix.reduce_col_with x j0; x) - else - Matrix.reduce_col x j0 + if imp then (Matrix.reduce_col_with x j0; x) else Matrix.reduce_col x j0 - let remove_rels_with_var x var env inplace = timing_wrap "remove_rels_with_var" (remove_rels_with_var x var env) inplace + let remove_rels_with_var x var env imp = timing_wrap "remove_rels_with_var" (remove_rels_with_var x var env) imp let forget_vars t vars = - if is_bot t || is_top_env t || List.is_empty vars then - t + if is_bot t || is_top_env t then t else let m = Option.get t.d in - let rem_from m = List.fold_left (fun m' x -> remove_rels_with_var m' x t.env true) m vars in - {d = Some (Matrix.remove_zero_rows @@ rem_from (Matrix.copy m)); env = t.env} + if List.is_empty vars then t else + let rec rem_vars m vars' = + begin match vars' with + | [] -> m + | x :: xs -> rem_vars (remove_rels_with_var m x t.env true) xs end + in {d = Some (Matrix.remove_zero_rows @@ rem_vars (Matrix.copy m) vars); env = t.env} let forget_vars t vars = let res = forget_vars t vars in @@ -485,7 +441,7 @@ struct let assign_invertible_rels x var b env = timing_wrap "assign_invertible" (assign_invertible_rels x var b) env in let assign_uninvertible_rel x var b env = let b_length = Vector.length b in - Vector.mapi_with (fun i z -> if i < b_length - 1 then Mpqf.neg z else z) b; + Vector.mapi_with (fun i z -> if i < b_length - 1 then Mpqf.mone *: z else z) b; Vector.set_val_with b (Environment.dim_of_var env var) Mpqf.one; let opt_m = Matrix.rref_vec_with x b in if Option.is_none opt_m then bot () else @@ -506,7 +462,6 @@ struct let assign_exp (t: VarManagement(Vc)(Mx).t) var exp (no_ov: bool Lazy.t) = let t = if not @@ Environment.mem_var t.env var then add_vars t [var] else t in - (* TODO: Do we need to do a constant folding here? It happens for texpr1_of_cil_exp *) match Convert.texpr1_expr_of_cil_exp t t.env exp (Lazy.force no_ov) with | exp -> assign_texpr t var exp | exception Convert.Unsupported_CilExp _ -> @@ -517,7 +472,6 @@ struct if M.tracing then M.tracel "ops" "assign_exp t:\n %s \n var: %s \n exp: %a\n no_ov: %b -> \n %s\n" (show t) (Var.to_string var) d_exp exp (Lazy.force no_ov) (show res) ; res - let assign_var (t: VarManagement(Vc)(Mx).t) v v' = let t = add_vars t [v; v'] in let texpr1 = Texpr1.of_expr (t.env) (Var v') in @@ -529,26 +483,20 @@ struct res let assign_var_parallel t vv's = - let assigned_vars = List.map fst vv's in + let assigned_vars = List.map (function (v, _) -> v) vv's in let t = add_vars t assigned_vars in let primed_vars = List.init (List.length assigned_vars) (fun i -> Var.of_string (Int.to_string i ^"'")) in (* TODO: we use primed vars in analysis, conflict? *) let t_primed = add_vars t primed_vars in let multi_t = List.fold_left2 (fun t' v_prime (_,v') -> assign_var t' v_prime v') t_primed primed_vars vv's in match multi_t.d with - | Some m when not @@ is_top_env multi_t -> - let replace_col m x y = - let dim_x, dim_y = Environment.dim_of_var multi_t.env x, Environment.dim_of_var multi_t.env y in - let col_x = Matrix.get_col m dim_x in - Matrix.set_col_with m col_x dim_y - in + | Some m when not @@ is_top_env multi_t -> let replace_col m x y = let dim_x, dim_y = Environment.dim_of_var multi_t.env x, Environment.dim_of_var multi_t.env y in + let col_x = Matrix.get_col m dim_x in + Matrix.set_col_with m col_x dim_y in let m_cp = Matrix.copy m in - let switched_m = List.fold_left2 replace_col m_cp primed_vars assigned_vars in + let switched_m = List.fold_left2 (fun m' x y -> replace_col m' x y) m_cp primed_vars assigned_vars in let res = drop_vars {d = Some switched_m; env = multi_t.env} primed_vars true in let x = Option.get res.d in - if Matrix.normalize_with x then - {d = Some x; env = res.env} - else - bot () + if Matrix.normalize_with x then {d = Some x; env = res.env} else bot () | _ -> t let assign_var_parallel t vv's = @@ -582,8 +530,8 @@ struct forget_vars res [var] let substitute_exp t var exp ov = - let res = substitute_exp t var exp ov in - if M.tracing then M.tracel "ops" "Substitute_expr t: \n %s \n var: %s \n exp: %a \n -> \n %s\n" (show t) (Var.to_string var) d_exp exp (show res); + let res = substitute_exp t var exp ov + in if M.tracing then M.tracel "ops" "Substitute_expr t: \n %s \n var: %s \n exp: %a \n -> \n %s\n" (show t) (Var.to_string var) d_exp exp (show res); res let substitute_exp t var exp ov = timing_wrap "substitution" (substitute_exp t var exp) ov @@ -601,61 +549,49 @@ struct | None -> overflow_res res | Some v -> let ik = Cilfacade.get_ikind v.vtype in - if not (Cil.isSigned ik) then - raise NotRefinable - else - match Bounds.bound_texpr res (Convert.texpr1_of_cil_exp res res.env (Lval (Cil.var v)) true) with - | Some min, Some max -> - assert (Z.equal min max); (* other bounds impossible in affeq *) - let (min_ik, max_ik) = IntDomain.Size.range ik in - if Z.lt min min_ik || Z.gt max max_ik then - if IntDomain.should_ignore_overflow ik then - bot () - else - raise NotRefinable - else res - | exception Convert.Unsupported_CilExp _ - | _ -> overflow_res res + match Bounds.bound_texpr res (Convert.texpr1_of_cil_exp res res.env (Lval (Cil.var v)) true) with + | Some _, Some _ when not (Cil.isSigned ik) -> raise NotRefinable (* TODO: unsigned w/o bounds handled differently? *) + | Some min, Some max -> + assert (Z.equal min max); (* other bounds impossible in affeq *) + let (min_ik, max_ik) = IntDomain.Size.range ik in + if Z.compare min min_ik < 0 || Z.compare max max_ik > 0 then + if IntDomain.should_ignore_overflow ik then bot () else raise NotRefinable + else res + | exception Convert.Unsupported_CilExp _ + | _, _ -> overflow_res res let meet_tcons t tcons expr = - let check_const cmp c = if cmp c Mpqf.zero then bot_env else t in + let check_const cmp c = if cmp c Mpqf.zero then bot_env else t + in let meet_vec e = - (* Flip the sign of the const. val in coeff vec *) - let coeff = Vector.nth e (Vector.length e - 1) in - Vector.set_val_with e (Vector.length e - 1) (Mpqf.neg coeff); - let res = - if is_bot t then - bot () - else - let opt_m = Matrix.rref_vec_with (Matrix.copy @@ Option.get t.d) e in - if Option.is_none opt_m then bot () else {d = opt_m; env = t.env} - in + (*Flip the sign of the const. val in coeff vec*) + Vector.mapi_with (fun i x -> if Vector.compare_length_with e (i + 1) = 0 then Mpqf.mone *: x else x) e; + let res = if is_bot t then bot () else + let opt_m = Matrix.rref_vec_with (Matrix.copy @@ Option.get t.d) e + in if Option.is_none opt_m then bot () else {d = opt_m; env = t.env} in meet_tcons_one_var_eq res expr in - try - match get_coeff_vec t (Texpr1.to_expr @@ Tcons1.get_texpr1 tcons) with - | Some v -> - begin match to_constant_opt v, Tcons1.get_typ tcons with - | Some c, DISEQ -> check_const (=:) c - | Some c, SUP -> check_const (<=:) c - | Some c, EQ -> check_const (<>:) c - | Some c, SUPEQ -> check_const (<:) c - | None, DISEQ - | None, SUP -> - if equal (meet_vec v) t then - bot_env - else - t - | None, EQ -> - let res = meet_vec v in - if is_bot res then - bot_env - else - res - | _ -> t - end - | None -> t - with NotRefinable -> t + match get_coeff_vec t (Texpr1.to_expr @@ Tcons1.get_texpr1 tcons) with + | Some v -> + begin match get_c v, Tcons1.get_typ tcons with + | Some c, DISEQ -> check_const (=:) c + | Some c, SUP -> check_const (<=:) c + | Some c, EQ -> check_const (<>:) c + | Some c, SUPEQ -> check_const (<:) c + | None, DISEQ + | None, SUP -> + begin match meet_vec v with + | exception NotRefinable -> t + | res -> if equal res t then bot_env else t + end + | None, EQ -> + begin match meet_vec v with + | exception NotRefinable -> t + | res -> if is_bot res then bot_env else res + end + | _, _ -> t + end + | None -> t let meet_tcons t tcons expr = timing_wrap "meet_tcons" (meet_tcons t tcons) expr @@ -679,18 +615,22 @@ struct let relift t = t let invariant t = - let invariant m = - let one_constraint i = + match t.d with + | None -> [] + | Some m -> + let earray = Lincons1.array_make t.env (Matrix.num_rows m) in + for i = 0 to Lincons1.array_length earray do let row = Matrix.get_row m i in let coeff_vars = List.map (fun x -> Coeff.s_of_mpqf @@ Vector.nth row (Environment.dim_of_var t.env x), x) (vars t) in let cst = Coeff.s_of_mpqf @@ Vector.nth row (Vector.length row - 1) in - let e1 = Linexpr1.make t.env in - Linexpr1.set_list e1 coeff_vars (Some cst); - Lincons1.make e1 EQ - in - List.init (Matrix.num_rows m) one_constraint - in - BatOption.map_default invariant [] t.d + Lincons1.set_list (Lincons1.array_get earray i) coeff_vars (Some cst) + done; + let {lincons0_array; array_env}: Lincons1.earray = earray in + Array.enum lincons0_array + |> Enum.map (fun (lincons0: Lincons0.t) -> + Lincons1.{lincons0; env = array_env} + ) + |> List.of_enum let cil_exp_of_lincons1 = Convert.cil_exp_of_lincons1 diff --git a/src/cdomains/apron/apronDomain.apron.ml b/src/cdomains/apron/apronDomain.apron.ml index 8927d5ca007..801c10c5824 100644 --- a/src/cdomains/apron/apronDomain.apron.ml +++ b/src/cdomains/apron/apronDomain.apron.ml @@ -4,7 +4,7 @@ open Batteries open GoblintCil open Pretty (* A binding to a selection of Apron-Domains *) -open GobApron +open Apron open RelationDomain open SharedFunctions @@ -29,7 +29,8 @@ let widening_thresholds_apron = ResettableLazy.from_fun (fun () -> let reset_lazy () = ResettableLazy.reset widening_thresholds_apron -module V = RelationDomain.V +module Var = SharedFunctions.Var +module V = RelationDomain.V(Var) module type Manager = @@ -208,6 +209,7 @@ module type AOpsExtra = sig type t val copy : t -> t + val vars_as_array : t -> Var.t array val vars : t -> Var.t list type marshal val unmarshal : marshal -> t @@ -246,6 +248,15 @@ struct let copy = A.copy Man.mgr + let vars_as_array d = + let ivs, fvs = Environment.vars (A.env d) in + assert (Array.length fvs = 0); (* shouldn't ever contain floats *) + ivs + + let vars d = + let ivs = vars_as_array d in + List.of_enum (Array.enum ivs) + (* marshal type: Abstract0.t and an array of var names *) type marshal = Man.mt Abstract0.t * string array @@ -255,24 +266,31 @@ struct let env = Environment.make vars [||] in {abstract0; env} - let vars x = Environment.ivars_only @@ A.env x - let marshal (x: t): marshal = - let vars = Array.map Var.to_string (Array.of_list (vars x)) in + let vars = Array.map Var.to_string (vars_as_array x) in x.abstract0, vars let mem_var d v = Environment.mem_var (A.env d) v - let envop f nd a = - let env' = f (A.env nd) a in + let add_vars_with nd vs = + let env' = EnvOps.add_vars (A.env nd) vs in A.change_environment_with Man.mgr nd env' false - let add_vars_with = envop Environment.add_vars - let remove_vars_with = envop Environment.remove_vars - let remove_filter_with = envop Environment.remove_filter - let keep_vars_with = envop Environment.keep_vars - let keep_filter_with = envop Environment.keep_filter + let remove_vars_with nd vs = + let env' = EnvOps.remove_vars (A.env nd) vs in + A.change_environment_with Man.mgr nd env' false + let remove_filter_with nd f = + let env' = EnvOps.remove_filter (A.env nd) f in + A.change_environment_with Man.mgr nd env' false + + let keep_vars_with nd vs = + let env' = EnvOps.keep_vars (A.env nd) vs in + A.change_environment_with Man.mgr nd env' false + + let keep_filter_with nd f = + let env' = EnvOps.keep_filter (A.env nd) f in + A.change_environment_with Man.mgr nd env' false let forget_vars_with nd vs = (* Unlike keep_vars_with, this doesn't check mem_var, but assumes valid vars, like assigns *) @@ -479,9 +497,9 @@ struct let to_yojson (x: t) = let constraints = A.to_lincons_array Man.mgr x - |> Lincons1Set.of_earray - |> Lincons1Set.elements - |> List.map (fun lincons1 -> `String (Lincons1.show lincons1)) + |> SharedFunctions.Lincons1Set.of_earray + |> SharedFunctions.Lincons1Set.elements + |> List.map (fun lincons1 -> `String (SharedFunctions.Lincons1.show lincons1)) in let env = `String (Format.asprintf "%a" (Environment.print: Format.formatter -> Environment.t -> unit) (A.env x)) in @@ -867,6 +885,7 @@ struct let unmarshal (b, d) = (BoxD.unmarshal b, D.unmarshal d) let mem_var (_, d) v = D.mem_var d v + let vars_as_array (_, d) = D.vars_as_array d let vars (_, d) = D.vars d let pretty_diff () ((_, d1), (_, d2)) = D.pretty_diff () (d1, d2) diff --git a/src/cdomains/apron/gobApron.apron.ml b/src/cdomains/apron/gobApron.apron.ml deleted file mode 100644 index c39a3e42db1..00000000000 --- a/src/cdomains/apron/gobApron.apron.ml +++ /dev/null @@ -1,98 +0,0 @@ -open Batteries -include Apron - -module Var = -struct - include Var - let equal x y = Var.compare x y = 0 -end - -module Lincons1 = -struct - include Lincons1 - - let show = Format.asprintf "%a" print - let compare x y = String.compare (show x) (show y) (* HACK *) - - let num_vars x = - (* Apron.Linexpr0.get_size returns some internal nonsense, so we count ourselves. *) - let size = ref 0 in - Lincons1.iter (fun coeff var -> - if not (Apron.Coeff.is_zero coeff) then - incr size - ) x; - !size -end - -module Lincons1Set = -struct - include Set.Make (Lincons1) - - let of_earray ({lincons0_array; array_env}: Lincons1.earray): t = - Array.enum lincons0_array - |> Enum.map (fun (lincons0: Lincons0.t) -> - Lincons1.{lincons0; env = array_env} - ) - |> of_enum -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 ivars_only env = - let ivs, fvs = Environment.vars env in - assert (Array.length fvs = 0); (* shouldn't ever contain floats *) - List.of_enum (Array.enum ivs) - - let add_vars env vs = - let vs' = - vs - |> List.enum - |> Enum.filter (fun v -> not (Environment.mem_var env v)) - |> Array.of_enum - in - Environment.add env vs' [||] - - let remove_vars env vs = - let vs' = - vs - |> List.enum - |> Enum.filter (fun v -> Environment.mem_var env v) - |> Array.of_enum - in - Environment.remove env vs' - - let remove_filter env f = - let vs' = - ivars_only env - |> List.enum - |> Enum.filter f - |> Array.of_enum - in - Environment.remove env vs' - - let keep_vars env vs = - (* Instead of iterating over all vars in env and doing a linear lookup in vs just to remove them, - make a new env with just the desired vs. *) - let vs' = - vs - |> List.enum - |> Enum.filter (fun v -> Environment.mem_var env v) - |> Array.of_enum - in - Environment.make vs' [||] - - let keep_filter env f = - (* Instead of removing undesired vars, - make a new env with just the desired vars. *) - let vs' = - ivars_only env - |> List.enum - |> Enum.filter f - |> Array.of_enum - in - Environment.make vs' [||] -end diff --git a/src/cdomains/apron/gobApron.no-apron.ml b/src/cdomains/apron/gobApron.no-apron.ml deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/src/cdomains/apron/relationDomain.apron.ml b/src/cdomains/apron/relationDomain.apron.ml index 48720b03821..c5b6a0a89bb 100644 --- a/src/cdomains/apron/relationDomain.apron.ml +++ b/src/cdomains/apron/relationDomain.apron.ml @@ -2,16 +2,42 @@ See {!ApronDomain} and {!AffineEqualityDomain}. *) -open GobApron open Batteries open GoblintCil +(** Abstracts the extended apron Var. *) +module type Var = +sig + type t + val compare : t -> t -> int + val of_string : string -> t + val to_string : t -> string + val hash : t -> int + val equal : t -> t -> bool +end + module type VarMetadata = sig type t val var_name: t -> string end +module VarMetadataTbl (VM: VarMetadata) (Var: Var) = +struct + module VH = Hashtbl.Make (Var) + + let vh = VH.create 113 + + let make_var ?name metadata = + let name = Option.default_delayed (fun () -> VM.var_name metadata) name in + let var = Var.of_string name in + VH.replace vh var metadata; + var + + let find_metadata (var: Var.t) = + VH.find_option vh var +end + module VM = struct type t = @@ -29,26 +55,10 @@ struct | Global g -> g.vname end -module VarMetadataTbl (VM: VarMetadata) = -struct - module VH = Hashtbl.Make (Var) - - let vh = VH.create 113 - - let make_var ?name metadata = - let name = Option.default_delayed (fun () -> VM.var_name metadata) name in - let var = Var.of_string name in - VH.replace vh var metadata; - var - - let find_metadata (var: Var.t) = - VH.find_option vh var -end - module type RV = sig - type t = Var.t - type vartable = VM.t VarMetadataTbl (VM).VH.t + type t + type vartable val vh: vartable val make_var: ?name:string -> VM.t -> t @@ -60,13 +70,12 @@ sig val to_cil_varinfo: t -> varinfo Option.t end -module V: RV = +module V (Var: Var): (RV with type t = Var.t and type vartable = VM.t VarMetadataTbl (VM) (Var).VH.t) = struct - open VM - type t = Var.t - module VMT = VarMetadataTbl (VM) + module VMT = VarMetadataTbl (VM) (Var) include VMT + open VM type vartable = VM.t VMT.VH.t @@ -81,6 +90,12 @@ struct | _ -> None end +module type LinCons = +sig + type t + val num_vars: t -> int +end + module type Tracked = sig val type_tracked: typ -> bool @@ -90,7 +105,7 @@ end module type S2 = sig type t - type var = Var.t + type var type marshal module Tracked: Tracked @@ -129,8 +144,8 @@ module type S3 = sig include S2 - val cil_exp_of_lincons1: Lincons1.t -> exp option - val invariant: t -> Lincons1.t list + val cil_exp_of_lincons1: Apron.Lincons1.t -> exp option + val invariant: t -> Apron.Lincons1.t list end type ('a, 'b) relcomponents_t = { @@ -169,9 +184,10 @@ struct let name () = RD.name () ^ " * " ^ PrivD.name () + let of_tuple(rel, priv):t = {rel; priv} + let to_tuple r = (r.rel, r.priv) + let arbitrary () = - let to_tuple r = (r.rel, r.priv) in - let of_tuple (rel, priv) = {rel; priv} in let tr = QCheck.pair (RD.arbitrary ()) (PrivD.arbitrary ()) in QCheck.map ~rev:to_tuple of_tuple tr @@ -200,6 +216,7 @@ end module type RD = sig - module V : RV - include S3 + module Var : Var + module V : module type of struct include V(Var) end + include S3 with type var = Var.t end diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 093a9490be9..a568998d17f 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -8,6 +8,42 @@ module M = Messages module BI = IntOps.BigIntOps +module Var = +struct + include Var + + let equal x y = Var.compare x y = 0 +end + +module Lincons1 = +struct + include Lincons1 + + let show = Format.asprintf "%a" print + let compare x y = String.compare (show x) (show y) (* HACK *) + + let num_vars x = + (* Apron.Linexpr0.get_size returns some internal nonsense, so we count ourselves. *) + let size = ref 0 in + Lincons1.iter (fun coeff var -> + if not (Apron.Coeff.is_zero coeff) then + incr size + ) x; + !size +end + +module Lincons1Set = +struct + include Set.Make (Lincons1) + + let of_earray ({lincons0_array; array_env}: Lincons1.earray): t = + Array.enum lincons0_array + |> Enum.map (fun (lincons0: Lincons0.t) -> + Lincons1.{lincons0; env = array_env} + ) + |> of_enum +end + let int_of_scalar ?round (scalar: Scalar.t) = if Scalar.is_infty scalar <> 0 then (* infinity means unbounded *) None @@ -255,6 +291,66 @@ struct include CilOfApron (V) 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 EnvOps = +struct + let vars env = + let ivs, fvs = Environment.vars env in + assert (Array.length fvs = 0); (* shouldn't ever contain floats *) + List.of_enum (Array.enum ivs) + + let add_vars env vs = + let vs' = + vs + |> List.enum + |> Enum.filter (fun v -> not (Environment.mem_var env v)) + |> Array.of_enum + in + Environment.add env vs' [||] + + let remove_vars env vs = + let vs' = + vs + |> List.enum + |> Enum.filter (fun v -> Environment.mem_var env v) + |> Array.of_enum + in + Environment.remove env vs' + + let remove_filter env f = + let vs' = + vars env + |> List.enum + |> Enum.filter f + |> Array.of_enum + in + Environment.remove env vs' + + let keep_vars env vs = + (* Instead of iterating over all vars in env and doing a linear lookup in vs just to remove them, + make a new env with just the desired vs. *) + let vs' = + vs + |> List.enum + |> Enum.filter (fun v -> Environment.mem_var env v) + |> Array.of_enum + in + Environment.make vs' [||] + + let keep_filter env f = + (* Instead of removing undesired vars, + make a new env with just the desired vars. *) + let vs' = + vars env + |> List.enum + |> Enum.filter f + |> Array.of_enum + in + Environment.make vs' [||] + +end + (** A more specific module type for RelationDomain.RelD2 with ConvBounds integrated and various apron elements. It is designed to be the interface for the D2 modules in affineEqualityDomain and apronDomain and serves as a functor argument for AssertionModule. *) module type AssertionRelS = diff --git a/src/cdomain/value/cdomains/arrayDomain.ml b/src/cdomains/arrayDomain.ml similarity index 54% rename from src/cdomain/value/cdomains/arrayDomain.ml rename to src/cdomains/arrayDomain.ml index b3365c41254..f6186900e2d 100644 --- a/src/cdomain/value/cdomains/arrayDomain.ml +++ b/src/cdomains/arrayDomain.ml @@ -39,12 +39,15 @@ let get_domain ~varAttr ~typAttr = let can_recover_from_top x = x <> TrivialDomain -module type S0 = +module type S = sig include Lattice.S type idx type value + val domain_of_t: t -> domain + + val get: ?checkBounds:bool -> VDQ.t -> t -> Basetype.CilExp.t option * idx -> (lval option * int) option -> value val set: VDQ.t -> t -> Basetype.CilExp.t option * idx -> value -> t val make: ?varAttr:attributes -> ?typAttr:attributes -> idx -> value -> t val length: t -> idx option @@ -57,76 +60,20 @@ sig val smart_widen: (exp -> BI.t option) -> (exp -> BI.t option) -> t -> t -> t val smart_leq: (exp -> BI.t option) -> (exp -> BI.t option) -> t -> t -> bool val update_length: idx -> t -> t - val project: ?varAttr:attributes -> ?typAttr:attributes -> VDQ.t -> t -> t val invariant: value_invariant:(offset:Cil.offset -> lval:Cil.lval -> value -> Invariant.t) -> offset:Cil.offset -> lval:Cil.lval -> t -> Invariant.t end -module type S = -sig - include S0 - - val domain_of_t: t -> domain - val get: ?checkBounds:bool -> VDQ.t -> t -> Basetype.CilExp.t option * idx -> (lval option * int) option -> value -end - -module type Str = -sig - include S0 - - type ret = Null | NotNull | Maybe - type substr = IsNotSubstr | IsSubstrAtIndex0 | IsMaybeSubstr - - val get: VDQ.t -> t -> Basetype.CilExp.t option * idx -> ret - - val to_null_byte_domain: string -> t - val to_string_length: t -> idx - val string_copy: t -> t -> int option -> t - val string_concat: t -> t -> int option -> t - val substring_extraction: t -> t -> substr - val string_comparison: t -> t -> int option -> idx -end - -module type StrWithDomain = -sig - include Str - include S with type t := t and type idx := idx -end - -module type LatticeWithInvalidate = -sig - include Lattice.S - val invalidate_abstract_value: t -> t -end - module type LatticeWithSmartOps = sig - include LatticeWithInvalidate + include Lattice.S val smart_join: (Cil.exp -> BI.t option) -> (Cil.exp -> BI.t option) -> t -> t -> t val smart_widen: (Cil.exp -> BI.t option) -> (Cil.exp -> BI.t option) -> t -> t -> t val smart_leq: (Cil.exp -> BI.t option) -> (Cil.exp -> BI.t option) -> t -> t -> bool end -module type Null = -sig - type t - type retnull = Null | NotNull | Maybe - - val null: unit -> t - val is_null: t -> retnull - - val get_ikind: t -> Cil.ikind option - val zero_of_ikind: Cil.ikind -> t - val not_zero_of_ikind: Cil.ikind -> t -end - -module type LatticeWithNull = -sig - include LatticeWithSmartOps - include Null with type t := t -end -module Trivial (Val: LatticeWithInvalidate) (Idx: Lattice.S): S with type value = Val.t and type idx = Idx.t = +module Trivial (Val: Lattice.S) (Idx: Lattice.S): S with type value = Val.t and type idx = Idx.t = struct include Val let name () = "trivial arrays" @@ -158,7 +105,6 @@ struct let smart_widen _ _ = widen let smart_leq _ _ = leq let update_length _ x = x - let project ?(varAttr=[]) ?(typAttr=[]) _ t = t let invariant ~value_invariant ~offset ~lval x = @@ -182,7 +128,7 @@ let factor () = | 0 -> failwith "ArrayDomain: ana.base.arrays.unrolling-factor needs to be set when using the unroll domain" | x -> x -module Unroll (Val: LatticeWithInvalidate) (Idx:IntDomain.Z): S with type value = Val.t and type idx = Idx.t = +module Unroll (Val: Lattice.S) (Idx:IntDomain.Z): S with type value = Val.t and type idx = Idx.t = struct module Factor = struct let x () = (get_int "ana.base.arrays.unrolling-factor") end module Base = Lattice.ProdList (Val) (Factor) @@ -206,7 +152,7 @@ struct let extract x default = match x with | Some c -> c | None -> default - let get ?(checkBounds=true) (ask: VDQ.t) (xl, xr) (_,i) _ = + let get ?(checkBounds=true) (ask: VDQ.t) (xl, xr) (_,i) arr = let search_unrolled_values min_i max_i = let rec subjoin l i = match l with | [] -> Val.bot () @@ -400,7 +346,7 @@ struct ("m", Val.to_yojson xm); ("r", Val.to_yojson xr) ] - let get ?(checkBounds=true) (ask:VDQ.t) (x:t) (i,_) _= + let get ?(checkBounds=true) (ask:VDQ.t) (x:t) (i,_) _ = match x, i with | Joint v, _ -> v | Partitioned (e, (xl, xm, xr)), Some i' -> @@ -870,7 +816,7 @@ let array_oob_check ( type a ) (module Idx: IntDomain.Z with type t = a) (x, l) else () -module TrivialWithLength (Val: LatticeWithInvalidate) (Idx: IntDomain.Z): S with type value = Val.t and type idx = Idx.t = +module TrivialWithLength (Val: Lattice.S) (Idx: IntDomain.Z): S with type value = Val.t and type idx = Idx.t = struct module Base = Trivial (Val) (Idx) include Lattice.Prod (Base) (Idx) @@ -968,7 +914,7 @@ struct let to_yojson (x, y) = `Assoc [ (Base.name (), Base.to_yojson x); ("length", Idx.to_yojson y) ] end -module UnrollWithLength (Val: LatticeWithInvalidate) (Idx: IntDomain.Z): S with type value = Val.t and type idx = Idx.t = +module UnrollWithLength (Val: Lattice.S) (Idx: IntDomain.Z): S with type value = Val.t and type idx = Idx.t = struct module Base = Unroll (Val) (Idx) include Lattice.Prod (Base) (Idx) @@ -1012,674 +958,6 @@ struct let to_yojson (x, y) = `Assoc [ (Base.name (), Base.to_yojson x); ("length", Idx.to_yojson y) ] end -module NullByte (Val: LatticeWithNull) (Idx: IntDomain.Z): Str with type value = Val.t and type idx = Idx.t = -struct - module MustSet = NullByteSet.MustSet - module MaySet = NullByteSet.MaySet - module Nulls = NullByteSet.MustMaySet - - let (<.) = Z.lt - let (<=.) = Z.leq - let (>.) = Z.gt - let (>=.) = Z.geq - let (=.) = Z.equal - let (+.) = Z.add - - (* (Must Null Set, May Null Set, Array Size) *) - include Lattice.Prod (Nulls) (Idx) - - let name () = "arrays containing null bytes" - type idx = Idx.t - type value = Val.t - - type ret = Null | NotNull | Maybe - - type substr = IsNotSubstr | IsSubstrAtIndex0 | IsMaybeSubstr - - module ArrayOobMessage = M.Category.Behavior.Undefined.ArrayOutOfBounds - let warn_past_end = M.error ~category:ArrayOobMessage.past_end - - let min_nat_of_idx i = Z.max Z.zero (BatOption.default Z.zero (Idx.minimal i)) - - let get (ask: VDQ.t) (nulls, size) (e, i) = - let min_i = min_nat_of_idx i in - let max_i = Idx.maximal i in - let min_size = min_nat_of_idx size in - - match max_i, Idx.maximal size with - (* if there is no maximum value in index interval *) - | None, _ when not (Nulls.exists Possibly ((<=.) min_i) nulls) -> - (* ... return NotNull if no i >= min_i in may_nulls_set *) - NotNull - | None, _ -> - (* ... else return Top *) - Maybe - (* if there is no maximum size *) - | Some max_i, None when max_i >=. Z.zero -> - (* ... and maximum value in index interval < minimal size, return Null if all numbers in index interval are in must_nulls_set *) - if max_i <. min_size && Nulls.interval_mem Definitely (min_i,max_i) nulls then - Null - (* ... return NotNull if no number in index interval is in may_nulls_set *) - else if not (Nulls.exists Possibly (fun x -> x >=. min_i && x <=. max_i) nulls) then - NotNull - else - Maybe - | Some max_i, Some max_size when max_i >=. Z.zero -> - (* if maximum value in index interval < minimal size, return Null if all numbers in index interval are in must_nulls_set *) - if max_i <. min_size && Nulls.interval_mem Definitely (min_i, max_i) nulls then - Null - (* if maximum value in index interval < maximal size, return NotNull if no number in index interval is in may_nulls_set *) - else if max_i <. max_size && not (Nulls.exists Possibly (fun x -> x >=. min_i && x <=. max_i) nulls) then - NotNull - else - Maybe - (* if maximum number in interval is invalid, i.e. negative, return Top of value *) - | _ -> Maybe - - let set (ask: VDQ.t) (nulls, size) (e, i) v = - let min_size = min_nat_of_idx size in - let min_i = min_nat_of_idx i in - let max_i = Idx.maximal i in - - let set_exact_nulls i = - match Idx.maximal size with - (* if size has no upper limit *) - | None -> - (match Val.is_null v with - | NotNull -> - Nulls.remove (if Nulls.is_full_set Possibly nulls then Possibly else Definitely) i nulls min_size - (* ... and value <> null, remove i from must_nulls_set and also from may_nulls_set if not top *) - | Null -> - Nulls.add (if i <. min_size then Definitely else Possibly) i nulls - (* i < minimal size and value = null, add i to must_nulls_set and may_nulls_set *) - (* i >= minimal size and value = null, add i only to may_nulls_set *) - | Maybe -> - let removed = Nulls.remove Possibly i nulls min_size in - Nulls.add Possibly i removed) - | Some max_size -> - (match Val.is_null v with - | NotNull -> - Nulls.remove Definitely i nulls min_size - (* if value <> null, remove i from must_nulls_set and may_nulls_set *) - | Null when i <. min_size -> - Nulls.add Definitely i nulls - | Null when i <. max_size -> - Nulls.add Possibly i nulls - | Maybe when i <. max_size -> - let removed = Nulls.remove Possibly i nulls min_size in - Nulls.add Possibly i removed - | _ -> nulls - ) - in - - let set_interval min_i max_i = - (* Update max_i so it is capped at the maximum size *) - let max_i = BatOption.map_default (fun x -> Z.min max_i @@ Z.pred x) max_i (Idx.maximal size) in - match Val.is_null v with - | NotNull -> Nulls.remove_interval Possibly (min_i, max_i) min_size nulls - | Null -> Nulls.add_interval ~maxfull:(Idx.maximal size) Possibly (min_i, max_i) nulls - | Maybe -> - let nulls = Nulls.add_interval ~maxfull:(Idx.maximal size) Possibly (min_i, max_i) nulls in - Nulls.remove_interval Possibly (min_i, max_i) min_size nulls - in - - (* warn if index is (potentially) out of bounds *) - array_oob_check (module Idx) (Nulls.get_set Possibly, size) (e, i) None ask; - let nulls = match max_i with - (* if no maximum number in index interval *) - | None -> - (* ..., value = null *) - (if Val.is_null v = Null && Idx.maximal size = None then - match Idx.maximal size with - (* ... and there is no maximal size, modify may_nulls_set to top *) - | None -> Nulls.add_all Possibly nulls - (* ... and there is a maximal size, add all i from minimal index to maximal size to may_nulls_set *) - | Some max_size -> Nulls.add_interval Possibly (min_i, Z.pred max_size) nulls - (* ... and value <> null, only keep indexes < minimal index in must_nulls_set *) - else if Val.is_null v = NotNull then - Nulls.filter_musts (Z.gt min_i) min_size nulls - (*..., value unknown *) - else - match Idx.minimal size, Idx.maximal size with - (* ... and size unknown, modify both sets to top *) - | None, None -> Nulls.top () - (* ... and only minimal size known, remove all indexes < minimal size from must_nulls_set and modify may_nulls_set to top *) - | Some min_size, None -> - let nulls = Nulls.add_all Possibly nulls in - Nulls.filter_musts (Z.gt min_size) min_size nulls - (* ... and only maximal size known, modify must_nulls_set to top and add all i from minimal index to maximal size to may_nulls_set *) - | None, Some max_size -> - let nulls = Nulls.remove_all Possibly nulls in - Nulls.add_interval Possibly (min_i, Z.pred max_size) nulls - (* ... and size is known, remove all indexes < minimal size from must_nulls_set and add all i from minimal index to maximal size to may_nulls_set *) - | Some min_size, Some max_size -> - let nulls = Nulls.filter_musts (Z.gt min_size) min_size nulls in - Nulls.add_interval Possibly (min_i, Z.pred max_size) nulls - ) - | Some max_i when max_i >=. Z.zero -> - if min_i =. max_i then - set_exact_nulls min_i - else - set_interval min_i max_i - (* if maximum number in interval is invalid, i.e. negative, return tuple unmodified *) - | _ -> nulls - in - (nulls, size) - - - let make ?(varAttr=[]) ?(typAttr=[]) i v = - let min_i, max_i = match Idx.minimal i, Idx.maximal i with - | Some min_i, Some max_i -> - if min_i <. Z.zero && max_i <. Z.zero then - (M.error ~category:ArrayOobMessage.before_start "Tries to create an array of negative size"; - Z.zero, Some Z.zero) - else if min_i <. Z.zero then - (M.warn ~category:ArrayOobMessage.before_start "May try to create an array of negative size"; - Z.zero, Some max_i) - else - min_i, Some max_i - | None, Some max_i -> - if max_i <. Z.zero then - (M.error ~category:ArrayOobMessage.before_start "Tries to create an array of negative size"; - Z.zero, Some Z.zero) - else - Z.zero, Some max_i - | Some min_i, None -> - if min_i <. Z.zero then - (M.warn ~category:ArrayOobMessage.before_start "May try to create an array of negative size"; - Z.zero, None) - else - min_i, None - | None, None -> Z.zero, None - in - let size = BatOption.map_default (fun max -> Idx.of_interval ILong (min_i, max)) (Idx.starting ILong min_i) max_i in - match Val.is_null v with - | Null -> (Nulls.make_all_must (), size) - | NotNull -> (Nulls.empty (), size) - | Maybe -> (Nulls.top (), size) - - - let length (_, size) = Some size - - let move_if_affected ?(replace_with_const=false) _ x _ _ = x - - let get_vars_in_e _ = [] - - let map f (nulls, size) = - (* if f(null) = null, all values in must_nulls_set still are surely null; - * assume top for may_nulls_set as checking effect of f for every possible value is unfeasbile *) - match Val.is_null (f (Val.null ())) with - | Null -> (Nulls.add_all Possibly nulls, size) - | _ -> (Nulls.top (), size) (* else also return top for must_nulls_set *) - - let fold_left f acc _ = f acc (Val.top ()) - - let smart_join _ _ = join - let smart_widen _ _ = widen - let smart_leq _ _ = leq - - (* string functions *) - - let to_null_byte_domain s = - let last_null = Z.of_int (String.length s) in - let rec build_set i set = - if (Z.of_int i) >=. last_null then - Nulls.Set.add last_null set - else - match String.index_from_opt s i '\x00' with - | Some i -> build_set (i + 1) (Nulls.Set.add (Z.of_int i) set) - | None -> Nulls.Set.add last_null set in - let set = build_set 0 (Nulls.Set.empty ()) in - (Nulls.precise_set set, Idx.of_int ILong (Z.succ last_null)) - - (** Returns an abstract value with at most one null byte marking the end of the string *) - let to_string ((nulls, size) as x:t):t = - (* if must_nulls_set and min_nulls_set empty, definitely no null byte in array => warn about certain buffer overflow and return tuple unchanged *) - if Nulls.is_empty Definitely nulls then - (warn_past_end "Array access past end: buffer overflow"; x) - (* if only must_nulls_set empty, no certainty about array containing null byte => warn about potential buffer overflow and return tuple unchanged *) - else if Nulls.is_empty Possibly nulls then - (warn_past_end "May access array past end: potential buffer overflow"; x) - else - let min_must_null = Nulls.min_elem Definitely nulls in - let new_size = Idx.of_int ILong (Z.succ min_must_null) in - let min_may_null = Nulls.min_elem Possibly nulls in - (* if smallest index in sets coincides, only this null byte is kept in both sets *) - let nulls = - if min_must_null =. min_may_null then - Nulls.precise_singleton min_must_null - (* else return empty must_nulls_set and keep every index up to smallest index of must_nulls_set included in may_nulls_set *) - else - match Idx.maximal size with - | Some max_size -> - let nulls' = Nulls.remove_all Possibly nulls in - Nulls.filter ~max_size (Z.leq min_must_null) nulls' - | None when not (Nulls.may_can_benefit_from_filter nulls) -> - Nulls.add_interval Possibly (Z.zero, min_must_null) (Nulls.empty ()) - | None -> - let nulls' = Nulls.remove_all Possibly nulls in - Nulls.filter (Z.leq min_must_null) nulls' - in - (nulls, new_size) - - (** [to_n_string index_set n] returns an abstract value with a potential null byte - * marking the end of the string and if needed followed by further null bytes to obtain - * an n bytes string. *) - let to_n_string (nulls, size) n:t = - if n < 0 then - (Nulls.top (), Idx.top_of ILong) - else - let n = Z.of_int n in - let warn_no_null min_must_null min_may_null = - if Z.geq min_may_null n then - M.warn "Resulting string might not be null-terminated because src doesn't contain a null byte in the first n bytes" - else - (match min_must_null with - | Some min_must_null when not (min_must_null >=. n || min_must_null >. min_may_null) -> () - | _ -> - M.warn "Resulting string might not be null-terminated because src might not contain a null byte in the first n bytes" - ) - in - (match Idx.minimal size, Idx.maximal size with - | Some min_size, Some max_size -> - if n >. max_size then - warn_past_end "Array size is smaller than n bytes; can cause a buffer overflow" - else if n >. min_size then - warn_past_end "Array size might be smaller than n bytes; can cause a buffer overflow" - | Some min_size, None -> - if n >. min_size then - warn_past_end "Array size might be smaller than n bytes; can cause a buffer overflow" - | None, Some max_size -> - if n >. max_size then - warn_past_end "Array size is smaller than n bytes; can cause a buffer overflow" - | None, None -> ()); - let nulls = - (* if definitely no null byte in array, i.e. must_nulls_set = may_nulls_set = empty set *) - if Nulls.is_empty Definitely nulls then - (warn_past_end - "Resulting string might not be null-terminated because src doesn't contain a null byte"; - match Idx.maximal size with - (* ... there *may* be null bytes from maximal size to n - 1 if maximal size < n (i.e. past end) *) - | Some max_size when Z.geq max_size Z.zero -> Nulls.add_interval Possibly (max_size, Z.pred n) nulls - | _ -> nulls) - (* if only must_nulls_set empty, remove indexes >= n from may_nulls_set and add all indexes from minimal may null index to n - 1; - * warn as in any case, resulting array not guaranteed to contain null byte *) - else if Nulls.is_empty Possibly nulls then - let min_may_null = Nulls.min_elem Possibly nulls in - warn_no_null None min_may_null; - if min_may_null =. Z.zero then - Nulls.add_all Possibly nulls - else - let nulls = Nulls.add_interval Possibly (min_may_null, Z.pred n) nulls in - Nulls.filter (fun x -> x <. n) nulls - else - let min_must_null = Nulls.min_elem Definitely nulls in - let min_may_null = Nulls.min_elem Possibly nulls in - (* warn if resulting array may not contain null byte *) - warn_no_null (Some min_must_null) min_may_null; - (* if min_must_null = min_may_null, remove indexes >= n and add all indexes from minimal must/may null to n - 1 in the sets *) - if min_must_null =. min_may_null then - if min_must_null =. Z.zero then - Nulls.full_set () - else - let nulls = Nulls.add_interval Definitely (min_must_null, Z.pred n) nulls in - let nulls = Nulls.add_interval Possibly (min_may_null, Z.pred n) nulls in - Nulls.filter (fun x -> x <. n) nulls - else if min_may_null =. Z.zero then - Nulls.top () - else - let nulls = Nulls.remove_all Possibly nulls in - let nulls = Nulls.add_interval Possibly (min_may_null, Z.pred n) nulls in - Nulls.filter (fun x -> x <. n) nulls - in - (nulls, Idx.of_int ILong n) - - let to_string_length (nulls, size) = - (* if must_nulls_set and min_nulls_set empty, definitely no null byte in array => return interval [size, inf) and warn *) - if Nulls.is_empty Definitely nulls then - (warn_past_end "Array doesn't contain a null byte: buffer overflow"; - Idx.starting !Cil.kindOfSizeOf (BatOption.default Z.zero (Idx.minimal size)) - ) - (* if only must_nulls_set empty, no guarantee that null ever encountered in array => return interval [minimal may null, inf) and *) - else if Nulls.is_empty Possibly nulls then - (warn_past_end "Array might not contain a null byte: potential buffer overflow"; - Idx.starting !Cil.kindOfSizeOf (Nulls.min_elem Possibly nulls)) - (* else return interval [minimal may null, minimal must null] *) - else - Idx.of_interval !Cil.kindOfSizeOf (Nulls.min_elem Possibly nulls, Nulls.min_elem Definitely nulls) - - let string_copy (dstnulls, dstsize) ((srcnulls, srcsize) as src) n = - let must_nulls_set1, may_nulls_set1 = dstnulls in - (* filter out indexes before strlen(src) from dest sets and after strlen(src) from src sets and build union, keep size of dest *) - let update_sets (truncatednulls, truncatedsize) len2 = - let must_nulls_set2',may_nulls_set2' = truncatednulls in - match Idx.minimal dstsize, Idx.maximal dstsize, Idx.minimal len2, Idx.maximal len2 with - | Some min_dstsize, Some max_dstsize, Some min_srclen, Some max_srclen -> - (if max_dstsize <. min_srclen then - warn_past_end "The length of string src is greater than the allocated size for dest" - else if min_dstsize <. max_srclen then - warn_past_end "The length of string src may be greater than the allocated size for dest"); - let must_nulls_set_result = - let min_size2 = BatOption.default Z.zero (Idx.minimal truncatedsize) in - (* get must nulls from src string < minimal size of dest *) - MustSet.filter ~min_size:min_size2 (Z.gt min_dstsize) must_nulls_set2' - (* and keep indexes of dest >= maximal strlen of src *) - |> MustSet.union (MustSet.filter ~min_size:min_dstsize (Z.leq max_srclen) must_nulls_set1) in - let may_nulls_set_result = - let max_size2 = BatOption.default max_dstsize (Idx.maximal truncatedsize) in - (* get may nulls from src string < maximal size of dest *) - MaySet.filter ~max_size:max_size2 (Z.gt max_dstsize) may_nulls_set2' - (* and keep indexes of dest >= minimal strlen of src *) - |> MaySet.union (MaySet.filter ~max_size:max_dstsize (Z.leq min_srclen) may_nulls_set1) in - ((must_nulls_set_result, may_nulls_set_result), dstsize) - - - | Some min_size1, None, Some min_len2, Some max_len2 -> - (if min_size1 <. max_len2 then - warn_past_end "The length of string src may be greater than the allocated size for dest"); - let must_nulls_set_result = - let min_size2 = BatOption.default Z.zero (Idx.minimal truncatedsize) in - MustSet.filter ~min_size: min_size2 (Z.gt min_size1) must_nulls_set2' - |> MustSet.union (MustSet.filter ~min_size:min_size1 (Z.leq max_len2) must_nulls_set1) in - let may_nulls_set_result = - (* get all may nulls from src string as no maximal size of dest *) - may_nulls_set2' - |> MaySet.union (MaySet.filter ~max_size:(Z.succ min_len2) (Z.leq min_len2) may_nulls_set1) in - ((must_nulls_set_result, may_nulls_set_result), dstsize) - | Some min_size1, Some max_size1, Some min_len2, None -> - (if max_size1 <. min_len2 then - warn_past_end "The length of string src is greater than the allocated size for dest" - else if min_size1 <. min_len2 then - warn_past_end"The length of string src may be greater than the allocated size for dest"); - (* do not keep any index of dest as no maximal strlen of src *) - let must_nulls_set_result = - let min_size2 = BatOption.default Z.zero (Idx.minimal truncatedsize) in - MustSet.filter ~min_size:min_size2 (Z.gt min_size1) must_nulls_set2' in - let may_nulls_set_result = - let max_size2 = BatOption.default max_size1 (Idx.maximal truncatedsize) in - MaySet.filter ~max_size:max_size2 (Z.gt max_size1) may_nulls_set2' - |> MaySet.union (MaySet.filter ~max_size:max_size1 (Z.leq min_len2) may_nulls_set1) in - ((must_nulls_set_result, may_nulls_set_result), dstsize) - | Some min_size1, None, Some min_len2, None -> - (if min_size1 <. min_len2 then - warn_past_end "The length of string src may be greater than the allocated size for dest"); - (* do not keep any index of dest as no maximal strlen of src *) - let min_size2 = BatOption.default Z.zero (Idx.minimal truncatedsize) in - let truncatednulls = Nulls.remove_interval Possibly (Z.zero, min_size1) min_size2 truncatednulls in - let filtered_dst = Nulls.filter ~max_size:(Z.succ min_len2) (Z.leq min_len2) dstnulls in - (* get all may nulls from src string as no maximal size of dest *) - (Nulls.union_mays truncatednulls filtered_dst, dstsize) - (* any other case shouldn't happen as minimal index is always >= 0 *) - | _ -> (Nulls.top (), dstsize) in - - (* warn if size of dest is (potentially) smaller than size of src and the latter (potentially) has no null byte at index < size of dest *) - let sizes_warning srcsize = - (match Idx.minimal dstsize, Idx.maximal dstsize, Idx.minimal srcsize, Idx.maximal srcsize with - | Some min_dstsize, _, Some min_srcsize, _ when min_dstsize <. min_srcsize -> - if not (Nulls.exists Possibly (Z.gt min_dstsize) srcnulls) then - warn_past_end "src doesn't contain a null byte at an index smaller than the size of dest" - else if not (Nulls.exists Definitely (Z.gt min_dstsize) srcnulls) then - warn_past_end "src may not contain a null byte at an index smaller than the size of dest" - | Some min_dstsize, _, _, Some max_srcsize when min_dstsize <. max_srcsize -> - if not (Nulls.exists Possibly (Z.gt min_dstsize) srcnulls) then - warn_past_end "src doesn't contain a null byte at an index smaller than the size of dest" - else if not (Nulls.exists Definitely (Z.gt min_dstsize) srcnulls) then - warn_past_end "src may not contain a null byte at an index smaller than the size of dest" - | Some min_dstsize, _, _, None -> - if not (Nulls.exists Definitely (Z.gt min_dstsize) srcnulls) then - warn_past_end "src may not contain a null byte at an index smaller than the size of dest" - | _, Some mac_dstsize, _, Some max_srcsize when mac_dstsize <. max_srcsize -> - if not (Nulls.exists Definitely (Z.gt mac_dstsize) srcnulls) then - warn_past_end "src may not contain a null byte at an index smaller than the size of dest" - |_, Some max_dstsize, _, None -> - if not (Nulls.exists Definitely (Z.gt max_dstsize) srcnulls) then - warn_past_end "src may not contain a null byte at an index smaller than the size of dest" - | _ -> ()) in - - match n with - (* strcpy *) - | None -> - sizes_warning srcsize; - let truncated = to_string src in - update_sets truncated (to_string_length src) - (* strncpy = exactly n bytes from src are copied to dest *) - | Some n when n >= 0 -> - sizes_warning (Idx.of_int ILong (Z.of_int n)); - let truncated = to_n_string src n in - update_sets truncated (Idx.of_int !Cil.kindOfSizeOf (Z.of_int n)) - | _ -> (Nulls.top (), dstsize) - - let string_concat (nulls1, size1) (nulls2, size2) n = - let update_sets min_size1 max_size1 minlen1 maxlen1 minlen2 (maxlen2: Z.t option) nulls2' = - (* track any potential buffer overflow and issue warning if needed *) - (if GobOption.exists (fun x -> x <=. (minlen1 +. minlen2)) max_size1 then - warn_past_end - "The length of the concatenation of the strings in src and dest is greater than the allocated size for dest" - else - (match maxlen1, maxlen2 with - | Some maxlen1, Some maxlen2 when min_size1 >. (maxlen1 +. maxlen2) -> () - | _ -> warn_past_end - "The length of the concatenation of the strings in src and dest may be greater than the allocated size for dest") - ); - (* if any must_nulls_set empty, result must_nulls_set also empty; - * for all i1, i2 in may_nulls_set1, may_nulls_set2: add i1 + i2 if it is <= strlen(dest) + strlen(src) to new may_nulls_set - * and keep indexes > minimal strlen(dest) + strlen(src) of may_nulls_set *) - if Nulls.is_empty Possibly nulls1 || Nulls.is_empty Possibly nulls2 then - match max_size1 with - | Some max_size1 -> - let nulls1_no_must = Nulls.remove_all Possibly nulls1 in - let pred = match maxlen1, maxlen2 with - | Some maxlen1, Some maxlen2 -> (fun x -> x <=. (maxlen1 +. maxlen2)) - | _ -> (fun _ -> true) - in - let r = - nulls1_no_must - (* filter ensures we have the concete representation *) - |> Nulls.filter ~max_size:max_size1 pred - |> Nulls.elements ~max_size:max_size1 Possibly - |> BatList.cartesian_product (Nulls.elements ~max_size:max_size1 Possibly nulls2') - |> List.map (fun (i1, i2) -> i1 +. i2) - |> (fun x -> Nulls.add_list Possibly x (Nulls.filter ~max_size:max_size1 (Z.lt (minlen1 +. minlen2)) nulls1_no_must)) - |> Nulls.filter (Z.gt max_size1) - in - (r, size1) - | None when Nulls.may_can_benefit_from_filter nulls1 && Nulls.may_can_benefit_from_filter nulls2 -> - (match maxlen1, maxlen2 with - | Some maxlen1, Some maxlen2-> - let nulls1_no_must = Nulls.remove_all Possibly nulls1 in - let r = - nulls1_no_must - (* filter ensures we have the concete representation *) - |> Nulls.filter (fun x -> x <=. (maxlen1 +. maxlen2)) - |> Nulls.elements Possibly - |> BatList.cartesian_product (Nulls.elements Possibly nulls2') - |> List.map (fun (i1, i2) -> i1 +. i2) - |> (fun x -> Nulls.add_list Possibly x (Nulls.filter (Z.lt (minlen1 +. minlen2)) nulls1_no_must)) - in - (r, size1) - | _ -> (Nulls.top (), size1)) - | _ -> (Nulls.top (), size1) - (* if minimal must null = minimal may null in ar1 and ar2, add them together and keep indexes > strlen(dest) + strlen(src) of ar1 *) - else if Nulls.min_elem_precise nulls1 && Nulls.min_elem_precise nulls2' then - let min_i1 = Nulls.min_elem Definitely nulls1 in - let min_i2 = Nulls.min_elem Definitely nulls2' in - let min_i = min_i1 +. min_i2 in - let (must_nulls_set1, may_nulls_set1) = nulls1 in - let must_nulls_set_result = - MustSet.filter ~min_size:min_size1 (Z.lt min_i) must_nulls_set1 - |> MustSet.add min_i - |> MustSet.M.filter (Z.gt min_size1) in - let may_nulls_set_result = - match max_size1 with - | Some max_size1 -> - MaySet.filter ~max_size:max_size1 (Z.lt min_i) may_nulls_set1 - |> MaySet.add min_i - |> MaySet.M.filter (fun x -> max_size1 >. x) - | _ -> MaySet.top () - in - ((must_nulls_set_result, may_nulls_set_result), size1) - (* else only add all may nulls together <= strlen(dest) + strlen(src) *) - else - let min_i2 = Nulls.min_elem Definitely nulls2' in - let (must_nulls_set1, may_nulls_set1) = nulls1 in - let (must_nulls_set2', may_nulls_set2') = nulls2' in - let may_nulls_set2'_until_min_i2 = - match Idx.maximal size2 with - | Some max_size2 -> MaySet.filter ~max_size:max_size2 (Z.geq min_i2) may_nulls_set2' - | None -> MaySet.filter ~max_size:(Z.succ min_i2) (Z.geq min_i2) may_nulls_set2' in - let must_nulls_set_result = - let pred = match maxlen1, maxlen2 with - | Some maxlen1, Some maxlen2 -> (fun x -> (maxlen1 +. maxlen2) <. x) - | _ -> (fun _ -> false) - in - MustSet.filter ~min_size:min_size1 pred must_nulls_set1 - in - let may_nulls_set_result = - let pred = match maxlen1, maxlen2 with - | Some maxlen1, Some maxlen2 -> (fun x -> x <=. (maxlen1 +. maxlen2)) - | _ -> (fun _ -> true) - in - match max_size1 with - | Some max_size1 -> - MaySet.filter ~max_size:max_size1 pred may_nulls_set1 - |> MaySet.elements - |> BatList.cartesian_product (MaySet.elements may_nulls_set2'_until_min_i2) - |> List.map (fun (i1, i2) -> i1 +. i2) - |> MaySet.of_list - |> MaySet.union (MaySet.filter ~max_size:max_size1 (Z.lt (minlen1 +. minlen2)) may_nulls_set1) - |> MaySet.M.filter (fun x -> max_size1 >. x) - | None when not (MaySet.is_top may_nulls_set1) -> - MaySet.M.filter pred may_nulls_set1 - |> MaySet.elements - |> BatList.cartesian_product (MaySet.elements may_nulls_set2'_until_min_i2) - |> List.map (fun (i1, i2) -> i1 +. i2) - |> MaySet.of_list - |> MaySet.union (MaySet.M.filter (Z.lt (minlen1 +. minlen2)) may_nulls_set1) - | _ -> - MaySet.top () in - ((must_nulls_set_result, may_nulls_set_result), size1) in - - let compute_concat nulls2' = - let strlen1 = to_string_length (nulls1, size1) in - let strlen2 = to_string_length (nulls2', size2) in - match Idx.minimal size1, Idx.minimal strlen1, Idx.minimal strlen2 with - | Some min_size1, Some minlen1, Some minlen2 -> - begin - let f = update_sets min_size1 (Idx.maximal size1) minlen1 in - match Idx.maximal strlen1, Idx.maximal strlen2 with - | (Some _ as maxlen1), (Some _ as maxlen2) -> f maxlen1 minlen2 maxlen2 nulls2' - | _ -> f None minlen2 None nulls2' - end - (* any other case shouldn't happen as minimal index is always >= 0 *) - | _ -> (Nulls.top (), size1) in - - match n with - (* strcat *) - | None -> - let nulls2', _ = to_string (nulls2, size2) in - compute_concat nulls2' - (* strncat *) - | Some n when n >= 0 -> - let n = Z.of_int n in - (* take at most n bytes from src; if no null byte among them, add null byte at index n *) - let nulls2' = - let (nulls2, size2) = to_string (nulls2, size2) in - if not (Nulls.exists Possibly (Z.gt n) nulls2) then - Nulls.precise_singleton n - else if not (Nulls.exists Definitely (Z.gt n) nulls2) then - let max_size = BatOption.default (Z.succ n) (Idx.maximal size2) in - let nulls2 = Nulls.remove_all Possibly nulls2 in - let nulls2 = Nulls.filter ~max_size (Z.geq n) nulls2 in - Nulls.add Possibly n nulls2 - else - let min_size = BatOption.default Z.zero (Idx.minimal size2) in - let max_size = BatOption.default n (Idx.maximal size2) in - Nulls.filter ~max_size ~min_size (Z.gt n) nulls2 - in - compute_concat nulls2' - | _ -> (Nulls.top (), size1) - - let substring_extraction haystack ((nulls_needle, size_needle) as needle) = - (* if needle is empty string, i.e. certain null byte at index 0, return value of strstr is pointer to haystack *) - if Nulls.mem Definitely Z.zero nulls_needle then - IsSubstrAtIndex0 - else - let haystack_len = to_string_length haystack in - let needle_len = to_string_length needle in - match Idx.maximal haystack_len, Idx.minimal needle_len with - | Some haystack_max, Some needle_min when haystack_max <. needle_min -> - (* if strlen(haystack) < strlen(needle), needle can never be substring of haystack => return None *) - IsNotSubstr - | _ -> IsMaybeSubstr - - let string_comparison (nulls1, size1) (nulls2, size2) n = - let cmp n = - (* if s1 = s2 = empty string, i.e. certain null byte at index 0, or n = 0, return 0 *) - if (Nulls.mem Definitely Z.zero nulls1 && Nulls.mem Definitely Z.zero nulls2) || (BatOption.map_default (Z.equal Z.zero) false n) then - Idx.of_int IInt Z.zero - (* if only s1 = empty string, return negative integer *) - else if Nulls.mem Definitely Z.zero nulls1 && not (Nulls.mem Possibly Z.zero nulls2) then - Idx.ending IInt Z.minus_one - (* if only s2 = empty string, return positive integer *) - else if Nulls.mem Definitely Z.zero nulls2 then - Idx.starting IInt Z.one - else - try - let min_must1 = Nulls.min_elem Definitely nulls1 in - let min_must2 = Nulls.min_elem Definitely nulls2 in - if not (min_must1 =. min_must2) - && min_must1 =.(Nulls.min_elem Possibly nulls1) - && min_must2 =. (Nulls.min_elem Possibly nulls2) - && (BatOption.map_default (fun x -> min_must1 <. x || min_must2 <. x) true n) - then - (* if first null bytes are certain, have different indexes and are before index n if n present, return integer <> 0 *) - Idx.of_excl_list IInt [Z.zero] - else - Idx.top_of IInt - with Not_found -> Idx.top_of IInt - in - - match n with - (* strcmp *) - | None -> - (* track any potential buffer overflow and issue warning if needed *) - let warn_missing_nulls nulls name = - if Nulls.is_empty Definitely nulls then - warn_past_end "Array of string %s doesn't contain a null byte: buffer overflow" name - else if Nulls.is_empty Possibly nulls then - warn_past_end "Array of string %s might not contain a null byte: potential buffer overflow" name - in - warn_missing_nulls nulls1 "1"; - warn_missing_nulls nulls2 "2"; - (* compute abstract value for result of strcmp *) - cmp None - (* strncmp *) - | Some n when n >= 0 -> - let n = Z.of_int n in - let warn_size size name = - let min = min_nat_of_idx size in - match Idx.maximal size with - | Some max when n >. max -> - warn_past_end "The size of the array of string %s is smaller than n bytes" name - | Some max when n >. min -> - warn_past_end "The size of the array of string %s might be smaller than n bytes" name - | None when n >. min -> - warn_past_end "The size of the array of string %s might be smaller than n bytes" name - | _ -> () - in - warn_size size1 "1"; - warn_size size2 "2"; - (* compute abstract value for result of strncmp *) - cmp (Some n) - | _ -> Idx.top_of IInt - - let update_length new_size (nulls, size) = (nulls, new_size) - - let project ?(varAttr=[]) ?(typAttr=[]) _ t = t - - let invariant ~value_invariant ~offset ~lval x = Invariant.none -end - module AttributeConfiguredArrayDomain(Val: LatticeWithSmartOps) (Idx:IntDomain.Z):S with type value = Val.t and type idx = Idx.t = struct module P = PartitionedWithLength(Val)(Idx) @@ -1734,7 +1012,7 @@ struct let smart_widen f g = binop_to_t' (P.smart_widen f g) (T.smart_widen f g) (U.smart_widen f g) let smart_leq f g = binop' (P.smart_leq f g) (T.smart_leq f g) (U.smart_leq f g) let update_length newl x = unop_to_t' (P.update_length newl) (T.update_length newl) (U.update_length newl) x - let name () = "FlagHelperAttributeConfiguredArrayDomain" + let name () = "AttributeConfiguredArrayDomain" let bot () = to_t @@ match get_domain ~varAttr:[] ~typAttr:[] with | PartitionedDomain -> (Some (P.bot ()), None, None) @@ -1802,91 +1080,3 @@ struct (T.invariant ~value_invariant ~offset ~lval) (U.invariant ~value_invariant ~offset ~lval) end - -module AttributeConfiguredAndNullByteArrayDomain (Val: LatticeWithNull) (Idx: IntDomain.Z): StrWithDomain with type value = Val.t and type idx = Idx.t = -struct - module A = AttributeConfiguredArrayDomain (Val) (Idx) - module N = NullByte (Val) (Idx) - - include Lattice.Prod (A) (N) - - let name () = "AttributeConfiguredAndNullByteArrayDomain" - type idx = Idx.t - type value = Val.t - - type ret = Null | NotNull | Maybe - type substr = N.substr = IsNotSubstr | IsSubstrAtIndex0 | IsMaybeSubstr - - let domain_of_t (t_f, _) = A.domain_of_t t_f - - let get ?(checkBounds=true) (ask: VDQ.t) (t_f, t_n) i arrExpDim= - let f_get = A.get ~checkBounds ask t_f i arrExpDim in - if get_bool "ana.base.arrays.nullbytes" then - let n_get = N.get ask t_n i in - match Val.get_ikind f_get, n_get with - | Some ik, Null -> Val.meet f_get (Val.zero_of_ikind ik) - | Some ik, NotNull -> Val.meet f_get (Val.not_zero_of_ikind ik) - | _ -> f_get - else - f_get - - let construct a n = - if get_bool "ana.base.arrays.nullbytes" then - (a, n ()) - else - (a, N.top ()) - - let set (ask:VDQ.t) (t_f, t_n) i v = construct (A.set ask t_f i v) (fun () -> N.set ask t_n i v) - let make ?(varAttr=[]) ?(typAttr=[]) i v = construct (A.make ~varAttr ~typAttr i v) (fun () -> N.make ~varAttr ~typAttr i v) - let map f (t_f, t_n) = construct (A.map f t_f) (fun () -> N.map f t_n) - let update_length newl (t_f, t_n) = construct (A.update_length newl t_f) (fun () -> N.update_length newl t_n) - - let smart_binop op_a op_n x y (t_f1, t_n1) (t_f2, t_n2) = construct (op_a x y t_f1 t_f2) (fun () -> op_n x y t_n1 t_n2) - - let smart_join = smart_binop A.smart_join N.smart_join - let smart_widen = smart_binop A.smart_widen N.smart_widen - - let string_op op (t_f1, t_n1) (_, t_n2) n = construct (A.map Val.invalidate_abstract_value t_f1) (fun () -> op t_n1 t_n2 n) - let string_copy = string_op N.string_copy - let string_concat = string_op N.string_concat - - let extract op default (_, t_n1) (_, t_n2) n = - if get_bool "ana.base.arrays.nullbytes" then - op t_n1 t_n2 n - else - (* Hidden behind unit, as constructing defaults may happen to early otherwise *) - (* e.g. for Idx.top_of IInt *) - default () - - let substring_extraction x y = extract (fun x y _ -> N.substring_extraction x y) (fun () -> IsMaybeSubstr) x y None - let string_comparison = extract N.string_comparison (fun () -> Idx.top_of IInt) - - let length (t_f, t_n) = - if get_bool "ana.base.arrays.nullbytes" then - N.length t_n - else - A.length t_f - let move_if_affected ?(replace_with_const=false) (ask:VDQ.t) (t_f, t_n) v f = (A.move_if_affected ~replace_with_const ask t_f v f, N.move_if_affected ~replace_with_const ask t_n v f) - let get_vars_in_e (t_f, _) = A.get_vars_in_e t_f - let fold_left f acc (t_f, _) = A.fold_left f acc t_f - - let smart_leq x y (t_f1, t_n1) (t_f2, t_n2) = - if get_bool "ana.base.arrays.nullbytes" then - A.smart_leq x y t_f1 t_f2 && N.smart_leq x y t_n1 t_n2 - else - A.smart_leq x y t_f1 t_f2 - - let to_null_byte_domain s = - if get_bool "ana.base.arrays.nullbytes" then - (A.make (Idx.top_of ILong) (Val.meet (Val.not_zero_of_ikind IChar) (Val.zero_of_ikind IChar)), N.to_null_byte_domain s) - else - (A.top (), N.top ()) - let to_string_length (_, t_n) = - if get_bool "ana.base.arrays.nullbytes" then - N.to_string_length t_n - else - Idx.top_of !Cil.kindOfSizeOf - - let project ?(varAttr=[]) ?(typAttr=[]) ask (t_f, t_n) = (A.project ~varAttr ~typAttr ask t_f, N.project ~varAttr ~typAttr ask t_n) - let invariant ~value_invariant ~offset ~lval (t_f, _) = A.invariant ~value_invariant ~offset ~lval t_f -end diff --git a/src/cdomain/value/cdomains/arrayDomain.mli b/src/cdomains/arrayDomain.mli similarity index 56% rename from src/cdomain/value/cdomains/arrayDomain.mli rename to src/cdomains/arrayDomain.mli index a741c9b3449..8e891df4974 100644 --- a/src/cdomain/value/cdomains/arrayDomain.mli +++ b/src/cdomains/arrayDomain.mli @@ -12,7 +12,8 @@ val get_domain: varAttr:Cil.attributes -> typAttr:Cil.attributes -> domain val can_recover_from_top: domain -> bool (** Some domains such as Trivial cannot recover from their value ever being top. {!ValueDomain} handles intialization differently for these *) -module type S0 = +(** Abstract domains representing arrays. *) +module type S = sig include Lattice.S type idx @@ -21,6 +22,12 @@ sig type value (** The abstract domain of values stored in the array. *) + val domain_of_t: t -> domain + (* Returns the domain used for the array*) + + val get: ?checkBounds:bool -> VDQ.t -> t -> Basetype.CilExp.t option * idx -> (lval option * int) option -> value + (** Returns the element residing at the given index. *) + val set: VDQ.t -> t -> Basetype.CilExp.t option * idx -> value -> t (** Returns a new abstract value, where the given index is replaced with the * given element. *) @@ -50,104 +57,25 @@ sig val smart_widen: (Cil.exp -> BigIntOps.t option) -> (Cil.exp -> BigIntOps.t option) -> t -> t -> t val smart_leq: (Cil.exp -> BigIntOps.t option) -> (Cil.exp -> BigIntOps.t option) -> t -> t -> bool val update_length: idx -> t -> t + val project: ?varAttr:Cil.attributes -> ?typAttr:Cil.attributes -> VDQ.t -> t -> t val invariant: value_invariant:(offset:Cil.offset -> lval:Cil.lval -> value -> Invariant.t) -> offset:Cil.offset -> lval:Cil.lval -> t -> Invariant.t end -(** Abstract domains representing arrays. *) -module type S = -sig - include S0 - - val domain_of_t: t -> domain - (* Returns the domain used for the array*) - - val get: ?checkBounds:bool -> VDQ.t -> t -> Basetype.CilExp.t option * idx -> (lval option * int) option -> value - (** Returns the element residing at the given index. *) -end - -(** Abstract domains representing strings a.k.a. null-terminated char arrays. *) -module type Str = -sig - include S0 - - type ret = Null | NotNull | Maybe - type substr = IsNotSubstr | IsSubstrAtIndex0 | IsMaybeSubstr - - val get: VDQ.t -> t -> Basetype.CilExp.t option * idx -> ret - (* overwrites get of module S *) - - val to_null_byte_domain: string -> t - (* Converts a string to its abstract value in the NullByte domain *) - - val to_string_length: t -> idx - (** Returns length of string represented by input abstract value *) - - val string_copy: t -> t -> int option -> t - (** [string_copy dest src n] returns an abstract value representing the copy of string [src] - * into array [dest], taking at most [n] bytes of [src] if present *) - - val string_concat: t -> t -> int option -> t - (** [string_concat s1 s2 n] returns a new abstract value representing the string - * concatenation of the input abstract values [s1] and [s2], taking at most [n] bytes of - * [s2] if present *) - - val substring_extraction: t -> t -> substr - (** [substring_extraction haystack needle] returns {!IsNotSubstr} if the string represented by - * the abstract value [needle] surely isn't a substring of [haystack], {!IsSubstrAtIndex0} if - * [needle] is the empty string, else {!IsMaybeSubstr} *) - - val string_comparison: t -> t -> int option -> idx - (** [string_comparison s1 s2 n] returns a negative / positive idx element if the string - * represented by [s1] is less / greater than the one by [s2] or zero if they are equal; - * only compares the first [n] bytes if present *) -end - -module type StrWithDomain = -sig - include Str - include S with type t := t and type idx := idx -end - -module type LatticeWithInvalidate = -sig - include Lattice.S - val invalidate_abstract_value: t -> t -end - module type LatticeWithSmartOps = sig - include LatticeWithInvalidate + include Lattice.S val smart_join: (Cil.exp -> BigIntOps.t option) -> (Cil.exp -> BigIntOps.t option) -> t -> t -> t val smart_widen: (Cil.exp -> BigIntOps.t option) -> (Cil.exp -> BigIntOps.t option) -> t -> t -> t val smart_leq: (Cil.exp -> BigIntOps.t option) -> (Cil.exp -> BigIntOps.t option) -> t -> t -> bool end -module type Null = -sig - type t - type retnull = Null | NotNull | Maybe - - val null: unit -> t - val is_null: t -> retnull - - val get_ikind: t -> Cil.ikind option - val zero_of_ikind: Cil.ikind -> t - val not_zero_of_ikind: Cil.ikind -> t -end - -module type LatticeWithNull = -sig - include LatticeWithSmartOps - include Null with type t := t -end - -module Trivial (Val: LatticeWithInvalidate) (Idx: Lattice.S): S with type value = Val.t and type idx = Idx.t +module Trivial (Val: Lattice.S) (Idx: Lattice.S): S with type value = Val.t and type idx = Idx.t (** This functor creates a trivial single cell representation of an array. The * indexing type is taken as a parameter to satisfy the type system, it is not * used in the implementation. *) -module TrivialWithLength (Val: LatticeWithInvalidate) (Idx: IntDomain.Z): S with type value = Val.t and type idx = Idx.t +module TrivialWithLength (Val: Lattice.S) (Idx: IntDomain.Z): S with type value = Val.t and type idx = Idx.t (** This functor creates a trivial single cell representation of an array. The * indexing type is also used to manage the length. *) @@ -162,18 +90,5 @@ module Partitioned (Val: LatticeWithSmartOps) (Idx: IntDomain.Z): S with type va module PartitionedWithLength (Val: LatticeWithSmartOps) (Idx:IntDomain.Z): S with type value = Val.t and type idx = Idx.t (** Like partitioned but additionally manages the length of the array. *) -module NullByte (Val: LatticeWithNull) (Idx: IntDomain.Z): Str with type value = Val.t and type idx = Idx.t -(** This functor creates an array representation by the indexes of all null bytes - * the array must and may contain. This is useful to analyze strings, i.e. null- - * terminated char arrays, and particularly to determine if operations on strings - * could lead to a buffer overflow. Concrete values from Val are not interesting - * for this domain. It additionally tracks the array size. -*) - -module AttributeConfiguredArrayDomain (Val: LatticeWithSmartOps) (Idx: IntDomain.Z): S with type value = Val.t and type idx = Idx.t +module AttributeConfiguredArrayDomain(Val: LatticeWithSmartOps) (Idx:IntDomain.Z):S with type value = Val.t and type idx = Idx.t (** Switches between PartitionedWithLength, TrivialWithLength and Unroll based on variable, type, and flag. *) - -module AttributeConfiguredAndNullByteArrayDomain (Val: LatticeWithNull) (Idx: IntDomain.Z): StrWithDomain with type value = Val.t and type idx = Idx.t -(** Like FlagHelperAttributeConfiguredArrayDomain but additionally runs NullByte - * in parallel if flag "ana.base.arrays.nullbytes" is set. -*) diff --git a/src/cdomain/value/cdomains/concDomain.ml b/src/cdomains/concDomain.ml similarity index 66% rename from src/cdomain/value/cdomains/concDomain.ml rename to src/cdomains/concDomain.ml index 5f609a31d82..b16cdf1d9f5 100644 --- a/src/cdomain/value/cdomains/concDomain.ml +++ b/src/cdomains/concDomain.ml @@ -1,25 +1,6 @@ (** Domains for thread sets and their uniqueness. *) -module ThreadSet = -struct - include SetDomain.Make (ThreadIdDomain.Thread) - - let is_top = mem UnknownThread - - let top () = singleton UnknownThread - - let merge uop cop x y = - match is_top x, is_top y with - | true, true -> uop x y - | false, true -> x - | true, false -> y - | false, false -> cop x y - - let meet x y = merge join meet x y - - let narrow x y = merge (fun x y -> widen x (join x y)) narrow x y - -end +module ThreadSet = SetDomain.ToppedSet (ThreadIdDomain.Thread) (struct let topname = "All Threads" end) module MustThreadSet = SetDomain.Reverse(ThreadSet) module CreatedThreadSet = ThreadSet diff --git a/src/cdomains/fileDomain.ml b/src/cdomains/fileDomain.ml new file mode 100644 index 00000000000..ca585b8bce9 --- /dev/null +++ b/src/cdomains/fileDomain.ml @@ -0,0 +1,81 @@ +(** Domains for file handles. *) + +open Batteries + +module D = MvalMapDomain + + +module Val = +struct + type mode = Read | Write [@@deriving eq, ord, hash] + type s = Open of string*mode | Closed | Error [@@deriving eq, ord, hash] + let name = "File handles" + let var_state = Closed + let string_of_mode = function Read -> "Read" | Write -> "Write" + let string_of_state = function + | Open(filename, m) -> "open("^filename^", "^string_of_mode m^")" + | Closed -> "closed" + | Error -> "error" + + (* properties of records (e.g. used by Dom.warn_each) *) + let opened s = s <> Closed && s <> Error + let closed s = s = Closed + let writable s = match s with Open((_,Write)) -> true | _ -> false +end + + +module Dom = +struct + include D.Domain (D.Value (Val)) + + (* returns a tuple (thunk, result) *) + let report_ ?(neg=false) k p msg m = + let f ?(may=false) msg = + let f () = warn ~may msg in + f, if may then `May true else `Must true in + let mf = (fun () -> ()), `Must false in + if mem k m then + let p = if neg then not % p else p in + let v = find' k m in + if V.must p v then f msg (* must *) + else if V.may p v then f ~may:true msg (* may *) + else mf (* none *) + else if neg then f msg else mf + + let report ?(neg=false) k p msg m = (fst (report_ ~neg k p msg m)) () (* evaluate thunk *) + + let reports k xs m = + let uncurry (neg, p, msg) = report_ ~neg:neg k p msg m in + let f result x = if snd (uncurry x) = result then Some (fst (uncurry x)) else None in + let must_true = BatList.filter_map (f (`Must true)) xs in + let may_true = BatList.filter_map (f (`May true)) xs in + (* output first must and first may *) + if must_true <> [] then (List.hd must_true) (); + if may_true <> [] then (List.hd may_true) () + + (* handling state *) + let opened r = V.state r |> Val.opened + let closed r = V.state r |> Val.closed + let writable r = V.state r |> Val.writable + + let fopen k loc filename mode m = + if is_unknown k m then m else + let mode = match String.lowercase_ascii mode with "r" -> Val.Read | _ -> Val.Write in + let v = V.make k loc (Val.Open(filename, mode)) in + add' k v m + let fclose k loc m = + if is_unknown k m then m else + let v = V.make k loc Val.Closed in + change k v m + let error k m = + if is_unknown k m then m else + let loc = if mem k m then find' k m |> V.split |> snd |> Set.choose |> V.loc else [] in + let v = V.make k loc Val.Error in + change k v m + let success k m = + if is_unknown k m then m else + match find_option k m with + | Some v when V.may (Val.opened%V.state) v && V.may (V.in_state Val.Error) v -> + change k (V.filter (Val.opened%V.state) v) m (* TODO what about must-set? *) + | _ -> m +end diff --git a/src/cdomain/value/cdomains/floatDomain.ml b/src/cdomains/floatDomain.ml similarity index 98% rename from src/cdomain/value/cdomains/floatDomain.ml rename to src/cdomains/floatDomain.ml index e3787541bd4..f52c8491110 100644 --- a/src/cdomain/value/cdomains/floatDomain.ml +++ b/src/cdomains/floatDomain.ml @@ -40,8 +40,6 @@ module type FloatArith = sig (** sin(x) *) val tan : t -> t (** tan(x) *) - val sqrt : t -> t - (** sqrt(x) *) (** {inversions of unary functions}*) val inv_ceil : ?asPreciseAsConcrete:bool -> t -> t @@ -672,14 +670,6 @@ module FloatIntervalImpl(Float_t : CFloatType) = struct | (l, h) when l = h && l = Float_t.zero -> of_const 0. (*tan(0) = 0*) | _ -> top () (**could be exact for intervals where l=h, or even for some intervals *) - let eval_sqrt = function - | (l, h) when l = Float_t.zero && h = Float_t.zero -> of_const 0. - | (l, h) when l >= Float_t.zero -> - let low = Float_t.sqrt Down l in - let high = Float_t.sqrt Up h in - Interval (low, high) - | _ -> top () - let eval_inv_ceil ?(asPreciseAsConcrete=false) = function | (l, h) -> if (Float_t.sub Up (Float_t.ceil l) (Float_t.sub Down (Float_t.ceil l) (Float_t.of_float Nearest 1.0)) = (Float_t.of_float Nearest 1.0)) then ( @@ -794,7 +784,6 @@ module FloatIntervalImpl(Float_t : CFloatType) = struct let cos = eval_unop eval_cos let sin = eval_unop eval_sin let tan = eval_unop eval_tan - let sqrt = eval_unop eval_sqrt let inv_ceil ?(asPreciseAsConcrete=false) = eval_unop ~warn:false (eval_inv_ceil ~asPreciseAsConcrete:asPreciseAsConcrete) let inv_floor ?(asPreciseAsConcrete=false) = eval_unop ~warn:false (eval_inv_floor ~asPreciseAsConcrete:asPreciseAsConcrete) @@ -910,7 +899,6 @@ module FloatIntervalImplLifted = struct let cos = lift (F1.cos, F2.cos) let sin = lift (F1.sin, F2.sin) let tan = lift (F1.tan, F2.tan) - let sqrt = lift (F1.sqrt, F2.sqrt) let inv_ceil ?(asPreciseAsConcrete=BoolDomain.MustBool.top ()) = function | F32 a -> F32 (F1.inv_ceil ~asPreciseAsConcrete:true a) @@ -1036,11 +1024,11 @@ module FloatDomTupleImpl = struct type 'a m = (module FloatDomain with type t = 'a) (* only first-order polymorphism on functions -> use records to get around monomorphism restriction on arguments (Same trick as used in intDomain) *) - type 'b poly_in = { fi : 'a. 'a m -> 'b -> 'a } [@@unboxed] - type 'b poly_pr = { fp : 'a. 'a m -> 'a -> 'b } [@@unboxed] - type 'b poly2_pr = { f2p : 'a. 'a m -> 'a -> 'a -> 'b } [@@unboxed] - type poly1 = { f1 : 'a. 'a m -> 'a -> 'a } [@@unboxed] - type poly2 = { f2 : 'a. 'a m -> 'a -> 'a -> 'a } [@@unboxed] + type 'b poly_in = { fi : 'a. 'a m -> 'b -> 'a } + type 'b poly_pr = { fp : 'a. 'a m -> 'a -> 'b } + type 'b poly2_pr = { f2p : 'a. 'a m -> 'a -> 'a -> 'b } + type poly1 = { f1 : 'a. 'a m -> 'a -> 'a } + type poly2 = { f2 : 'a. 'a m -> 'a -> 'a -> 'a } let create r x (f1 : float_precision) = let f b g = if b then Some (g x) else None in @@ -1171,8 +1159,6 @@ module FloatDomTupleImpl = struct map { f1= (fun (type a) (module F : FloatDomain with type t = a) -> F.sin); } let tan = map { f1= (fun (type a) (module F : FloatDomain with type t = a) -> F.tan); } - let sqrt = - map { f1= (fun (type a) (module F : FloatDomain with type t = a) -> F.sqrt); } (*"asPreciseAsConcrete" has no meaning here*) let inv_ceil ?(asPreciseAsConcrete=BoolDomain.MustBool.top ()) = diff --git a/src/cdomain/value/cdomains/floatDomain.mli b/src/cdomains/floatDomain.mli similarity index 99% rename from src/cdomain/value/cdomains/floatDomain.mli rename to src/cdomains/floatDomain.mli index d958e1ee812..06bca69acaa 100644 --- a/src/cdomain/value/cdomains/floatDomain.mli +++ b/src/cdomains/floatDomain.mli @@ -57,9 +57,6 @@ module type FloatArith = sig val tan : t -> t (** tan(x) *) - val sqrt : t -> t - (** sqrt(x) *) - (** {inversions of unary functions}*) val inv_ceil : ?asPreciseAsConcrete:bool -> t -> t (** (inv_ceil z -> x) if (z = ceil(x)) *) diff --git a/src/common/cdomains/floatOps/floatOps.ml b/src/cdomains/floatOps/floatOps.ml similarity index 95% rename from src/common/cdomains/floatOps/floatOps.ml rename to src/cdomains/floatOps/floatOps.ml index a4e39d930ef..a951ec08fe5 100644 --- a/src/common/cdomains/floatOps/floatOps.ml +++ b/src/cdomains/floatOps/floatOps.ml @@ -35,7 +35,6 @@ module type CFloatType = sig val sub: round_mode -> t -> t -> t val mul: round_mode -> t -> t -> t val div: round_mode -> t -> t -> t - val sqrt: round_mode -> t -> t val atof: round_mode -> string -> t end @@ -75,7 +74,6 @@ module CDouble = struct external sub: round_mode -> t -> t -> t = "sub_double" external mul: round_mode -> t -> t -> t = "mul_double" external div: round_mode -> t -> t -> t = "div_double" - external sqrt: round_mode -> t -> t = "sqrt_double" external atof: round_mode -> string -> t = "atof_double" end @@ -109,7 +107,6 @@ module CFloat = struct external sub: round_mode -> t -> t -> t = "sub_float" external mul: round_mode -> t -> t -> t = "mul_float" external div: round_mode -> t -> t -> t = "div_float" - external sqrt: round_mode -> t -> t = "sqrt_float" external atof: round_mode -> string -> t = "atof_float" diff --git a/src/common/cdomains/floatOps/floatOps.mli b/src/cdomains/floatOps/floatOps.mli similarity index 96% rename from src/common/cdomains/floatOps/floatOps.mli rename to src/cdomains/floatOps/floatOps.mli index cf24f75ed5d..05bf3638723 100644 --- a/src/common/cdomains/floatOps/floatOps.mli +++ b/src/cdomains/floatOps/floatOps.mli @@ -38,7 +38,6 @@ module type CFloatType = sig val sub: round_mode -> t -> t -> t val mul: round_mode -> t -> t -> t val div: round_mode -> t -> t -> t - val sqrt: round_mode -> t -> t val atof: round_mode -> string -> t end diff --git a/src/common/cdomains/floatOps/stubs.c b/src/cdomains/floatOps/stubs.c similarity index 76% rename from src/common/cdomains/floatOps/stubs.c rename to src/cdomains/floatOps/stubs.c index 50e4a2fb313..e0485883ddf 100644 --- a/src/common/cdomains/floatOps/stubs.c +++ b/src/cdomains/floatOps/stubs.c @@ -36,20 +36,6 @@ static void change_round_mode(int mode) } } -#define UNARY_OP(name, type, op) \ - CAMLprim value name##_##type(value mode, value x) \ - { \ - int old_roundingmode = fegetround(); \ - change_round_mode(Int_val(mode)); \ - volatile type r, x1 = Double_val(x); \ - r = op(x1); \ - fesetround(old_roundingmode); \ - return caml_copy_double(r); \ - } - -UNARY_OP(sqrt, double, sqrt); -UNARY_OP(sqrt, float, sqrtf); - #define BINARY_OP(name, type, op) \ CAMLprim value name##_##type(value mode, value x, value y) \ { \ diff --git a/src/cdomain/value/cdomains/intDomain.ml b/src/cdomains/intDomain.ml similarity index 96% rename from src/cdomain/value/cdomains/intDomain.ml rename to src/cdomains/intDomain.ml index d820683f0c2..4407801463c 100644 --- a/src/cdomain/value/cdomains/intDomain.ml +++ b/src/cdomains/intDomain.ml @@ -285,6 +285,99 @@ end module type Z = Y with type int_t = BI.t +module OldDomainFacade (Old : IkindUnawareS with type int_t = int64) : S with type int_t = BI.t and type t = Old.t = +struct + include Old + type int_t = BI.t + let neg ?no_ov _ik = Old.neg + let add ?no_ov _ik = Old.add + let sub ?no_ov _ik = Old.sub + let mul ?no_ov _ik = Old.mul + let div ?no_ov _ik = Old.div + let rem _ik = Old.rem + + let lt _ik = Old.lt + let gt _ik = Old.gt + let le _ik = Old.le + let ge _ik = Old.ge + let eq _ik = Old.eq + let ne _ik = Old.ne + + let bitnot _ik = bitnot + let bitand _ik = bitand + let bitor _ik = bitor + let bitxor _ik = bitxor + + let shift_left _ik = shift_left + let shift_right _ik = shift_right + + let lognot _ik = lognot + let logand _ik = logand + let logor _ik = logor + + + let to_int a = Option.map BI.of_int64 (Old.to_int a) + + let equal_to (x: int_t) (a: t)= + try + Old.equal_to (BI.to_int64 x) a + with Z.Overflow | Failure _ -> `Top + + let to_excl_list a = Option.map (BatTuple.Tuple2.map1 (List.map BI.of_int64)) (Old.to_excl_list a) + let of_excl_list ik xs = + let xs' = List.map BI.to_int64 xs in + Old.of_excl_list ik xs' + + let to_incl_list a = Option.map (List.map BI.of_int64) (Old.to_incl_list a) + + let maximal a = Option.map BI.of_int64 (Old.maximal a) + let minimal a = Option.map BI.of_int64 (Old.minimal a) + + let of_int ik x = + (* If we cannot convert x to int64, we have to represent it with top in the underlying domain*) + try + Old.of_int (BI.to_int64 x) + with + Failure _ -> top_of ik + + let of_bool ik b = Old.of_bool b + let of_interval ?(suppress_ovwarn=false) ik (l, u) = + try + Old.of_interval ~suppress_ovwarn ik (BI.to_int64 l, BI.to_int64 u) + with + Failure _ -> top_of ik + let of_congruence ik (c, m) = + try + Old.of_congruence ik (BI.to_int64 c, BI.to_int64 m) + with + Failure _ -> top_of ik + + let starting ?(suppress_ovwarn=false) ik x = + try Old.starting ~suppress_ovwarn ik (BI.to_int64 x) with Failure _ -> top_of ik + let ending ?(suppress_ovwarn=false) ik x = + try Old.ending ~suppress_ovwarn ik (BI.to_int64 x) with Failure _ -> top_of ik + + let join _ik = Old.join + let meet _ik = Old.meet + let narrow _ik = Old.narrow + let widen _ik = Old.widen + + let is_top_of _ik = Old.is_top + + let invariant_ikind e ik t = Old.invariant e t + + let cast_to ?torg ?no_ov = Old.cast_to ?torg + + let refine_with_congruence ik a b = a + let refine_with_interval ik a b = a + let refine_with_excl_list ik a b = a + let refine_with_incl_list ik a b = a + + let project ik p t = t + + let arbitrary _ik = Old.arbitrary () +end + module IntDomLifter (I : S) = struct @@ -520,11 +613,6 @@ module IntervalArith(Ints_t : IntOps.IntOps) = struct let x2y2 = (Ints_t.mul x2 y2) in (min4 x1y1 x1y2 x2y1 x2y2, max4 x1y1 x1y2 x2y1 x2y2) - let shift_left (x1,x2) (y1,y2) = - let y1p = Ints_t.shift_left Ints_t.one y1 in - let y2p = Ints_t.shift_left Ints_t.one y2 in - mul (x1, x2) (y1p, y2p) - let div (x1, x2) (y1, y2) = let x1y1n = (Ints_t.div x1 y1) in let x1y2n = (Ints_t.div x1 y2) in @@ -766,6 +854,7 @@ struct let bitnot = bit1 (fun _ik -> Ints_t.bitnot) let shift_right = bitcomp (fun _ik x y -> Ints_t.shift_right x (Ints_t.to_int y)) + let shift_left = bitcomp (fun _ik x y -> Ints_t.shift_left x (Ints_t.to_int y)) let neg ?no_ov ik = function None -> (None,{underflow=false; overflow=false}) | Some x -> norm ik @@ Some (IArith.neg x) @@ -778,20 +867,6 @@ struct let mul ?no_ov = binary_op_with_norm IArith.mul let sub ?no_ov = binary_op_with_norm IArith.sub - let shift_left ik a b = - match is_bot a, is_bot b with - | true, true -> (bot_of ik,{underflow=false; overflow=false}) - | true, _ - | _ , true -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show a) (show b))) - | _ -> - match a, minimal b, maximal b with - | Some a, Some bl, Some bu when (Ints_t.compare bl Ints_t.zero >= 0) -> - (try - let r = IArith.shift_left a (Ints_t.to_int bl, Ints_t.to_int bu) in - norm ik @@ Some r - with Z.Overflow -> (top_of ik,{underflow=false; overflow=true})) - | _ -> (top_of ik,{underflow=true; overflow=true}) - let rem ik x y = match x, y with | None, None -> None | None, _ | _, None -> raise (ArithmeticOnIntegerBot (Printf.sprintf "%s op %s" (show x) (show y))) @@ -906,12 +981,12 @@ struct let arbitrary ik = let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) + (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint MyCheck.Arbitrary.big_int in *) (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in + let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 MyCheck.Arbitrary.int64 in let pair_arb = QCheck.pair int_arb int_arb in let shrink = function - | Some (l, u) -> (return None) <+> (GobQCheck.shrink pair_arb (l, u) >|= of_interval ik >|= fst) + | Some (l, u) -> (return None) <+> (MyCheck.shrink pair_arb (l, u) >|= of_interval ik >|= fst) | None -> empty in QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) (fun x -> of_interval ik x |> fst ) pair_arb) @@ -1511,13 +1586,13 @@ struct let arbitrary ik = let open QCheck.Iter in - (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint GobQCheck.Arbitrary.big_int in *) + (* let int_arb = QCheck.map ~rev:Ints_t.to_bigint Ints_t.of_bigint MyCheck.Arbitrary.big_int in *) (* TODO: apparently bigints are really slow compared to int64 for domaintest *) - let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in + let int_arb = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 MyCheck.Arbitrary.int64 in let pair_arb = QCheck.pair int_arb int_arb in let list_pair_arb = QCheck.small_list pair_arb in let canonize_randomly_generated_list = (fun x -> norm_intvs ik x |> fst) in - let shrink xs = GobQCheck.shrink list_pair_arb xs >|= canonize_randomly_generated_list + let shrink xs = MyCheck.shrink list_pair_arb xs >|= canonize_randomly_generated_list in QCheck.(set_shrink shrink @@ set_print show @@ map (*~rev:BatOption.get*) canonize_randomly_generated_list list_pair_arb) end @@ -1605,7 +1680,7 @@ struct let logand n1 n2 = of_bool ((to_bool' n1) && (to_bool' n2)) let logor n1 n2 = of_bool ((to_bool' n1) || (to_bool' n2)) let cast_to ?torg t x = failwith @@ "Cast_to not implemented for " ^ (name ()) ^ "." - let arbitrary ik = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 (* TODO: use ikind *) + let arbitrary ik = QCheck.map ~rev:Ints_t.to_int64 Ints_t.of_int64 MyCheck.Arbitrary.int64 (* TODO: use ikind *) let invariant _ _ = Invariant.none (* TODO *) end @@ -1623,11 +1698,10 @@ end module Flat (Base: IkindUnawareS) = (* identical to Lift, but goes to `Top/`Bot if Base raises Unknown/Error *) struct type int_t = Base.int_t - include Lattice.FlatConf (struct - include Printable.DefaultConf + include Lattice.Flat (Base) (struct let top_name = "Unknown int" let bot_name = "Error int" - end) (Base) + end) let top_of ik = top () let bot_of ik = bot () @@ -1703,11 +1777,10 @@ end module Lift (Base: IkindUnawareS) = (* identical to Flat, but does not go to `Top/Bot` if Base raises Unknown/Error *) struct - include Lattice.LiftPO (struct - include Printable.DefaultConf + include Lattice.LiftPO (Base) (struct let top_name = "MaxInt" let bot_name = "MinInt" - end) (Base) + end) type int_t = Base.int_t let top_of ik = top () let bot_of ik = bot () @@ -1805,7 +1878,7 @@ struct module I = BI (* We use these types for the functions in this module to make the intended meaning more explicit *) type t = Exc of BISet.t * Interval32.t - type inc = Inc of BISet.t [@@unboxed] + type inc = Inc of BISet.t let max_of_range r = Size.max_from_bit_range (Option.get (R.maximal r)) let min_of_range r = Size.min_from_bit_range (Option.get (R.minimal r)) let cardinality_of_range r = BI.add BI.one (BI.add (BI.neg (min_of_range r)) (max_of_range r)) @@ -2314,8 +2387,8 @@ struct let excluded s = from_excl ik s in let definite x = of_int ik x in let shrink = function - | `Excluded (s, _) -> GobQCheck.shrink (S.arbitrary ()) s >|= excluded (* S TODO: possibly shrink excluded to definite *) - | `Definite x -> (return `Bot) <+> (GobQCheck.shrink (BigInt.arbitrary ()) x >|= definite) + | `Excluded (s, _) -> MyCheck.shrink (S.arbitrary ()) s >|= excluded (* S TODO: possibly shrink excluded to definite *) + | `Definite x -> (return `Bot) <+> (MyCheck.shrink (BigInt.arbitrary ()) x >|= definite) | `Bot -> empty in QCheck.frequency ~shrink ~print:show [ @@ -2728,8 +2801,8 @@ module Enums : S with type int_t = BigInt.t = struct let neg s = of_excl_list ik (BISet.elements s) in let pos s = norm ik (Inc s) in let shrink = function - | Exc (s, _) -> GobQCheck.shrink (BISet.arbitrary ()) s >|= neg (* S TODO: possibly shrink neg to pos *) - | Inc s -> GobQCheck.shrink (BISet.arbitrary ()) s >|= pos + | Exc (s, _) -> MyCheck.shrink (BISet.arbitrary ()) s >|= neg (* S TODO: possibly shrink neg to pos *) + | Inc s -> MyCheck.shrink (BISet.arbitrary ()) s >|= pos in QCheck.frequency ~shrink ~print:show [ 20, QCheck.map neg (BISet.arbitrary ()); @@ -3204,7 +3277,6 @@ struct let invariant_ikind e ik x = match x with - | x when is_top x -> Invariant.top () | Some (c, m) when m =: Ints_t.zero -> if get_bool "witness.invariant.exact" then let c = Ints_t.to_bigint c in @@ -3219,7 +3291,7 @@ struct let arbitrary ik = let open QCheck in - let int_arb = map ~rev:Ints_t.to_int64 Ints_t.of_int64 GobQCheck.Arbitrary.int64 in + let int_arb = map ~rev:Ints_t.to_int64 Ints_t.of_int64 MyCheck.Arbitrary.int64 in let cong_arb = pair int_arb int_arb in let of_pair ik p = normalize ik (Some p) in let to_pair = Option.get in @@ -3313,18 +3385,18 @@ module IntDomTupleImpl = struct type 'a m2 = (module SOverflow with type t = 'a and type int_t = int_t ) (* only first-order polymorphism on functions -> use records to get around monomorphism restriction on arguments *) - type 'b poly_in = { fi : 'a. 'a m -> 'b -> 'a } [@@unboxed] (* inject *) - type 'b poly2_in = { fi2 : 'a. 'a m2 -> 'b -> 'a } [@@unboxed] (* inject for functions that depend on int_t *) - type 'b poly2_in_ovc = { fi2_ovc : 'a. 'a m2 -> 'b -> 'a * overflow_info} [@@unboxed] (* inject for functions that depend on int_t *) - - type 'b poly_pr = { fp : 'a. 'a m -> 'a -> 'b } [@@unboxed] (* project *) - type 'b poly_pr2 = { fp2 : 'a. 'a m2 -> 'a -> 'b } [@@unboxed] (* project for functions that depend on int_t *) - type 'b poly2_pr = {f2p: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'b} [@@unboxed] - type poly1 = {f1: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a} [@@unboxed] (* needed b/c above 'b must be different from 'a *) - type poly1_ovc = {f1_ovc: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a * overflow_info } [@@unboxed] (* needed b/c above 'b must be different from 'a *) - type poly2 = {f2: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'a} [@@unboxed] - type poly2_ovc = {f2_ovc: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'a * overflow_info } [@@unboxed] - type 'b poly3 = { f3: 'a. 'a m -> 'a option } [@@unboxed] (* used for projection to given precision *) + type 'b poly_in = { fi : 'a. 'a m -> 'b -> 'a } (* inject *) + type 'b poly2_in = { fi2 : 'a. 'a m2 -> 'b -> 'a } (* inject for functions that depend on int_t *) + type 'b poly2_in_ovc = { fi2_ovc : 'a. 'a m2 -> 'b -> 'a * overflow_info} (* inject for functions that depend on int_t *) + + type 'b poly_pr = { fp : 'a. 'a m -> 'a -> 'b } (* project *) + type 'b poly_pr2 = { fp2 : 'a. 'a m2 -> 'a -> 'b } (* project for functions that depend on int_t *) + type 'b poly2_pr = {f2p: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'b} + type poly1 = {f1: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a} (* needed b/c above 'b must be different from 'a *) + type poly1_ovc = {f1_ovc: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a * overflow_info } (* needed b/c above 'b must be different from 'a *) + type poly2 = {f2: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'a} + type poly2_ovc = {f2_ovc: 'a. 'a m -> ?no_ov:bool -> 'a -> 'a -> 'a * overflow_info } + type 'b poly3 = { f3: 'a. 'a m -> 'a option } (* used for projection to given precision *) let create r x ((p1, p2, p3, p4, p5): int_precision) = let f b g = if b then Some (g x) else None in f p1 @@ r.fi (module I1), f p2 @@ r.fi (module I2), f p3 @@ r.fi (module I3), f p4 @@ r.fi (module I4), f p5 @@ r.fi (module I5) @@ -3340,14 +3412,14 @@ module IntDomTupleImpl = struct | Some(_, {underflow; overflow}) -> not (underflow || overflow) | _ -> false - let check_ov ~cast ik intv intv_set = + let check_ov ik intv intv_set = let no_ov = (no_overflow ik intv) || (no_overflow ik intv_set) in if not no_ov && ( BatOption.is_some intv || BatOption.is_some intv_set) then ( let (_,{underflow=underflow_intv; overflow=overflow_intv}) = match intv with None -> (I2.bot (), {underflow= true; overflow = true}) | Some x -> x in let (_,{underflow=underflow_intv_set; overflow=overflow_intv_set}) = match intv_set with None -> (I5.bot (), {underflow= true; overflow = true}) | Some x -> x in let underflow = underflow_intv && underflow_intv_set in let overflow = overflow_intv && overflow_intv_set in - set_overflow_flag ~cast ~underflow ~overflow ik; + set_overflow_flag ~cast:false ~underflow ~overflow ik; ); no_ov @@ -3356,7 +3428,7 @@ module IntDomTupleImpl = struct let map x = Option.map fst x in let intv = f p2 @@ r.fi2_ovc (module I2) in let intv_set = f p5 @@ r.fi2_ovc (module I5) in - ignore (check_ov ~cast:false ik intv intv_set); + ignore (check_ov ik intv intv_set); map @@ f p1 @@ r.fi2_ovc (module I1), map @@ f p2 @@ r.fi2_ovc (module I2), map @@ f p3 @@ r.fi2_ovc (module I3), map @@ f p4 @@ r.fi2_ovc (module I4), map @@ f p5 @@ r.fi2_ovc (module I5) let create2_ovc ik r x = (* use where values are introduced *) @@ -3537,7 +3609,7 @@ module IntDomTupleImpl = struct let map f ?no_ov = function Some x -> Some (f ?no_ov x) | _ -> None in let intv = map (r.f1_ovc (module I2)) b in let intv_set = map (r.f1_ovc (module I5)) e in - let no_ov = check_ov ~cast ik intv intv_set in + let no_ov = check_ov ik intv intv_set in let no_ov = no_ov || should_ignore_overflow ik in refine ik ( map (fun ?no_ov x -> r.f1_ovc ?no_ov (module I1) x |> fst) a @@ -3547,10 +3619,10 @@ module IntDomTupleImpl = struct , BatOption.map fst intv_set ) (* map2 with overflow check *) - let map2ovc ?(cast=false) ik r (xa, xb, xc, xd, xe) (ya, yb, yc, yd, ye) = + let map2ovc ik r (xa, xb, xc, xd, xe) (ya, yb, yc, yd, ye) = let intv = opt_map2 (r.f2_ovc (module I2)) xb yb in let intv_set = opt_map2 (r.f2_ovc (module I5)) xe ye in - let no_ov = check_ov ~cast ik intv intv_set in + let no_ov = check_ov ik intv intv_set in let no_ov = no_ov || should_ignore_overflow ik in refine ik ( opt_map2 (fun ?no_ov x y -> r.f2_ovc ?no_ov (module I1) x y |> fst) xa ya diff --git a/src/cdomain/value/cdomains/intDomain.mli b/src/cdomains/intDomain.mli similarity index 98% rename from src/cdomain/value/cdomains/intDomain.mli rename to src/cdomains/intDomain.mli index 8078597ee98..0d118d8c2c6 100644 --- a/src/cdomain/value/cdomains/intDomain.mli +++ b/src/cdomains/intDomain.mli @@ -310,6 +310,8 @@ end module SOverflowUnlifter (D : SOverflow) : S with type int_t = D.int_t and type t = D.t +module OldDomainFacade (Old : IkindUnawareS with type int_t = int64) : S with type int_t = IntOps.BigIntOps.t and type t = Old.t +(** Facade for IntDomain implementations that do not implement the interface where arithmetic functions take an ikind parameter. *) module type Y = sig diff --git a/src/cdomain/value/cdomains/jmpBufDomain.ml b/src/cdomains/jmpBufDomain.ml similarity index 100% rename from src/cdomain/value/cdomains/jmpBufDomain.ml rename to src/cdomains/jmpBufDomain.ml diff --git a/src/cdomain/value/cdomains/lval.ml b/src/cdomains/lval.ml similarity index 100% rename from src/cdomain/value/cdomains/lval.ml rename to src/cdomains/lval.ml diff --git a/src/cdomains/mHP.ml b/src/cdomains/mHP.ml index 016a72a77eb..8037cfa21d6 100644 --- a/src/cdomains/mHP.ml +++ b/src/cdomains/mHP.ml @@ -4,7 +4,7 @@ include Printable.Std let name () = "mhp" -module TID = ThreadIdDomain.Thread +module TID = ThreadIdDomain.FlagConfiguredTID module Pretty = GoblintCil.Pretty type t = { diff --git a/src/cdomain/value/cdomains/mutexAttrDomain.ml b/src/cdomains/mutexAttrDomain.ml similarity index 91% rename from src/cdomain/value/cdomains/mutexAttrDomain.ml rename to src/cdomains/mutexAttrDomain.ml index ea9696d26fb..748ede0ff59 100644 --- a/src/cdomain/value/cdomains/mutexAttrDomain.ml +++ b/src/cdomains/mutexAttrDomain.ml @@ -18,7 +18,7 @@ struct end) end -include Lattice.FlatConf (struct include Printable.DefaultConf let bot_name = "Uninitialized" let top_name = "Top" end) (MutexKind) +include Lattice.Flat(MutexKind) (struct let bot_name = "Uninitialized" let top_name = "Top" end) (* Needed because OS X is weird and assigns different constants than normal systems... :( *) let recursive_int = lazy ( diff --git a/src/cdomain/value/cdomains/mval.ml b/src/cdomains/mval.ml similarity index 100% rename from src/cdomain/value/cdomains/mval.ml rename to src/cdomains/mval.ml diff --git a/src/cdomain/value/cdomains/mval.mli b/src/cdomains/mval.mli similarity index 100% rename from src/cdomain/value/cdomains/mval.mli rename to src/cdomains/mval.mli diff --git a/src/cdomains/mvalMapDomain.ml b/src/cdomains/mvalMapDomain.ml new file mode 100644 index 00000000000..d0d2f8da856 --- /dev/null +++ b/src/cdomains/mvalMapDomain.ml @@ -0,0 +1,299 @@ +(** Domains for {{!Mval} mvalue} maps. *) + +open Batteries +open GoblintCil + +module M = Messages + + +exception Unknown +exception Error + +(* signature for map entries *) +module type S = +sig + include Lattice.S + type k = Mval.Exp.t (* key *) + type s (* state is defined by Impl *) + type r (* record *) + + (* printing *) + val string_of: t -> string + val string_of_key: k -> string + val string_of_record: r -> string + + (* constructing *) + val make: k -> Node.t list -> s -> t + + (* manipulation *) + val map: (r -> r) -> t -> t + val filter: (r -> bool) -> t -> t + val union: t -> t -> t + val set_key: k -> t -> t + val set_state: s -> t -> t + val remove_state: s -> t -> t + + (* deconstructing *) + val split: t -> r Set.t * r Set.t + val map': (r -> 'a) -> t -> 'a Set.t * 'a Set.t + val filter': (r -> bool) -> t -> r Set.t * r Set.t + val length: t -> int * int + + (* predicates *) + val must: (r -> bool) -> t -> bool + val may: (r -> bool) -> t -> bool + (* properties of records *) + val key: r -> k + val loc: r -> Node.t list + val edit_loc: (Node.t list -> Node.t list) -> r -> r + val state: r -> s + val in_state: s -> r -> bool + + (* special variables *) + val get_record: t -> r option + (* val make_record: k -> location list -> s -> r *) + val make_var: k -> t + val from_tuple: r Set.t * r Set.t -> t + + (* aliasing *) + val is_alias: t -> bool + val get_alias: t -> k + val make_alias: k -> t +end + +module Value (Impl: sig + type s (* state *) [@@deriving eq, ord, hash] + val name: string + val var_state: s + val string_of_state: s -> string + end) : S with type s = Impl.s = +struct + type k = Mval.Exp.t [@@deriving eq, ord, hash] + type s = Impl.s [@@deriving eq, ord, hash] + module R = struct + include Printable.StdLeaf + type t = { key: k; loc: Node.t list; state: s } [@@deriving eq, ord, hash] + let name () = "MValMapDomainValue" + + let pretty () {key; loc; state} = + Pretty.dprintf "{key=%a; loc=%a; state=%s}" Mval.Exp.pretty key (Pretty.d_list ", " Node.pretty) loc (Impl.string_of_state state) + + include Printable.SimplePretty ( + struct + type nonrec t = t + let pretty = pretty + end + ) + end + type r = R.t + open R + (* TODO: use SetDomain.Reverse? *) + module Must' = SetDomain.ToppedSet (R) (struct let topname = "top" end) + module Must = Lattice.Reverse (Must') + module May = SetDomain.ToppedSet (R) (struct let topname = "top" end) + include Lattice.Prod (Must) (May) + let name () = Impl.name + + (* converts to polymorphic sets *) + let split (x,y) = try Must'.elements x |> Set.of_list, May.elements y |> Set.of_list with SetDomain.Unsupported _ -> Set.empty, Set.empty + + (* special variable used for indirection *) + let alias_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@alias" Cil.voidType, `NoOffset + (* alias structure: x[0].key=alias_var, y[0].key=linked_var *) + let is_alias (x,y) = neg Must'.is_empty x && (Must'.choose x).key=alias_var + let get_alias (x,y) = (May.choose y).key + + (* Printing *) + let string_of_key k = Mval.Exp.show k + let string_of_loc xs = String.concat ", " (List.map (CilType.Location.show % Node.location) xs) + let string_of_record r = Impl.string_of_state r.state^" ("^string_of_loc r.loc^")" + let string_of (x,y) = + if is_alias (x,y) then + "alias for "^string_of_key @@ get_alias (x,y) + else + let x, y = split (x,y) in + let z = Set.diff y x in + "{ "^String.concat ", " (List.map string_of_record (Set.elements x))^" }, "^ + "{ "^String.concat ", " (List.map string_of_record (Set.elements z))^" }" + let show x = string_of x + include Printable.SimpleShow (struct + type nonrec t = t + let show = show + end) + (* constructing & manipulation *) + let make_record k l s = { key=k; loc=l; state=s } + let make k l s = let v = make_record k l s in Must'.singleton v, May.singleton v + let map f (x,y) = Must'.map f x, May.map f y + let filter p (x,y) = Must'.filter p x, May.filter p y (* retains top *) + let union (a,b) (c,d) = Must'.union a c, May.union b d + let set_key k v = map (fun x -> {x with key=k}) v (* changes key for all elements *) + let set_state s v = map (fun x -> {x with state=s}) v + let remove_state s v = filter (fun x -> x.state<>s) v + + (* deconstructing *) + let length = split %> Tuple2.mapn Set.cardinal + let map' f = split %> Tuple2.mapn (Set.map f) + let filter' f = split %> Tuple2.mapn (Set.filter f) + + (* predicates *) + let must p (x,y) = Must'.exists p x || May.for_all p y + let may p (x,y) = May.exists p y + + (* properties of records *) + let key r = r.key + let loc r = r.loc + let edit_loc f r = {r with loc=f r.loc} + let state r = r.state + let in_state s r = r.state = s + + (* special variables *) + let get_record (x,y) = if Must'.is_empty x then None else Some (Must'.choose x) + let make_var_record k = make_record k [] Impl.var_state + let make_var k = Must'.singleton (make_var_record k), May.singleton (make_var_record k) + let make_alias k = Must'.singleton (make_var_record alias_var), May.singleton (make_var_record k) + let from_tuple (x,y) = Set.to_list x |> Must'.of_list, Set.to_list y |> May.of_list +end + + +module Domain (V: S) = +struct + module K = Mval.Exp + module V = V + module MD = MapDomain.MapBot (Mval.Exp) (V) + include MD + + (* Map functions *) + (* find that resolves aliases *) + let find' k m = let v = find k m in if V.is_alias v then find (V.get_alias v) m else v + let find_option k m = if mem k m then Some(find' k m) else None + let get_alias k m = (* target: returns Some k' if k links to k' *) + if mem k m && V.is_alias (find k m) then Some (V.get_alias (find k m)) else None + let get_aliased k m = (* sources: get list of keys that link to k *) + (* iter (fun k' (x,y) -> if V.is_alias (x,y) then print_endline ("alias "^V.string_of_key k'^" -> "^V.string_of_key (Set.choose y).key)) m; *) + (* TODO V.get_alias v=k somehow leads to Out_of_memory... *) + filter (fun k' v -> V.is_alias v && V.string_of_key (V.get_alias v)=V.string_of_key k) m |> bindings |> List.map fst + let get_aliases k m = (* get list of all other keys that have the same pointee *) + match get_alias k m with + | Some k' -> [k] (* k links to k' *) + | None -> get_aliased k m (* k' that link to k *) + let alias a b m = (* link a to b *) + (* if b is already an alias, follow it... *) + let b' = get_alias b m |? b in + (* add an entry for key a, that points to b' *) + add a (V.make_alias b') m + let remove' k m = (* fixes keys that link to k before removing it *) + if mem k m && not (V.is_alias (find k m)) then (* k might be aliased *) + let v = find k m in + match get_aliased k m with + | [] -> remove k m (* nothing links to k *) + | k'::xs -> let m = add k' v m in (* set k' to v, link xs to k', finally remove k *) + (* List.map (fun x -> x.vname) (k'::xs) |> String.concat ", " |> print_endline; *) + List.fold_left (fun m x -> alias x k' m) m xs |> remove k + else remove k m (* k not in m or an alias *) + let add' k v m = + remove' k m (* fixes keys that might have linked to k *) + |> add k v (* set new value *) + let change k v m = (* if k is an alias, replace its pointee *) + add (get_alias k m |? k) v m + + (* special variables *) + let get_record k m = Option.bind (find_option k m) V.get_record + let edit_record k f m = + let v = find_option k m |? V.make_var k in + add k (V.map f v) m + let get_value k m = find_option k m |> Option.map_default V.split (Set.empty,Set.empty) + let extend_value k v' m = + let v = V.from_tuple v' in + if mem k m then + add k (V.union (find k m) v) m + else + add k v m + let union (a,b) (c,d) = Set.union a c, Set.union b d + let is_special_var k = String.get (V.string_of_key k) 0 = '@' + let without_special_vars m = filter (fun k v -> not @@ is_special_var k) m + + (* functions needed for enter & combine *) + (* only keep globals, aliases to them and special variables *) + let only_globals m = filter (fun k v -> (fst k).vglob || V.is_alias v && (fst (V.get_alias v)).vglob || is_special_var k) m + (* adds all the bindings from m2 to m1 (overwrites!) *) + let add_all m1 m2 = add_list (bindings m2) m1 + + (* callstack for locations *) + let callstack_var = Cilfacade.create_var @@ Cil.makeVarinfo false "@callstack" Cil.voidType, `NoOffset + let callstack m = get_record callstack_var m |> Option.map_default V.loc [] + let string_of_callstack m = " [call stack: "^String.concat ", " (List.map (CilType.Location.show % Node.location) (callstack m))^"]" + let edit_callstack f m = edit_record callstack_var (V.edit_loc f) m + + + (* predicates *) + let must k p m = mem k m && V.must p (find' k m) + let may k p m = mem k m && V.may p (find' k m) + let is_may k m = mem k m && let x,y = V.length (find' k m) in x=0 && y>0 + + let filter_values p m = (* filters all values in the map and flattens result *) + let flatten_sets = List.fold_left Set.union Set.empty in + without_special_vars m + |> filter (fun k v -> V.may p v && not (V.is_alias v)) + |> bindings |> List.map (fun (k,v) -> V.filter' p v) + |> List.split |> (fun (x,y) -> flatten_sets x, flatten_sets y) + let filter_records k p m = (* filters both sets of k *) + if mem k m then V.filter' p (find' k m) else Set.empty, Set.empty + + let unknown k m = add' k (V.top ()) m + let is_unknown k m = if mem k m then V.is_top (find' k m) else false + + (* printing *) + let string_of_state k m = if not (mem k m) then "?" else V.string_of (find' k m) + let string_of_key k = V.string_of_key k + let string_of_keys rs = Set.map (V.string_of_key % V.key) rs |> Set.elements |> String.concat ", " + let string_of_entry k m = string_of_key k ^ ": " ^ string_of_state k m + let string_of_map m = List.map (fun (k,v) -> string_of_entry k m) (bindings m) + + let warn ?may:(may=false) ?loc:(loc=[Option.get !Node.current_node]) msg = + let split_category s = + if Str.string_partial_match (Str.regexp {|\[\([^]]*\)\]|}) s 0 then + (Some (Str.matched_group 1 s), Str.string_after s (Str.match_end ())) + else + (None, s) + in + let rec split_categories s = + match split_category s with + | (Some category, s') -> + let (categories, s'') = split_categories s' in + (category :: categories, s'') + | (None, s') -> ([], s') + in + match split_categories msg with + | ([], msg) -> (if may then Messages.warn else Messages.error) ~loc:(Node (List.last loc)) "%s" msg + | (category :: categories, msg) -> + let category_of_string s = Messages.Category.from_string_list [String.lowercase_ascii s] in (* TODO: doesn't split subcategories, not used and no defined syntax even *) + let category = category_of_string category in + let tags = List.map (fun category -> Messages.Tag.Category (category_of_string category)) categories in + (if may then Messages.warn else Messages.error) ~loc:(Node (List.last loc)) ~category ~tags "%s" msg + + (* getting keys from Cil Lvals *) + + let key_from_lval lval = match lval with (* TODO try to get a Mval.Exp from Cil.Lval *) + | Var v1, o1 -> v1, Offset.Exp.of_cil o1 + | Mem Lval(Var v1, o1), o2 -> v1, Offset.Exp.of_cil (addOffset o1 o2) + (* | Mem exp, o1 -> failwith "not implemented yet" (* TODO use query_lv *) *) + | _ -> Cilfacade.create_var @@ Cil.makeVarinfo false ("?"^CilType.Lval.show lval) Cil.voidType, `NoOffset (* TODO *) + + let keys_from_lval lval (ask: Queries.ask) = (* use MayPointTo query to get all possible pointees of &lval *) + (* print_query_lv ctx.ask (AddrOf lval); *) + let query_addrs (ask: Queries.ask) exp = match ask.f (Queries.MayPointTo exp) with + | ad when not (Queries.AD.is_top ad) -> Queries.AD.elements ad + | _ -> [] + in + let exp = AddrOf lval in + let addrs = query_addrs ask exp in (* MayPointTo -> LValSet *) + let keys = List.fold (fun vs addr -> + match addr with + | Queries.AD.Addr.Addr (v,o) -> (v, ValueDomain.Offs.to_exp o) :: vs + | _ -> vs + ) [] addrs + in + let pretty_key k = Pretty.text (string_of_key k) in + Messages.debug ~category:Analyzer "MayPointTo %a = [%a]" d_exp exp (Pretty.docList ~sep:(Pretty.text ", ") pretty_key) keys; + keys +end diff --git a/src/cdomain/value/cdomains/mval_intf.ml b/src/cdomains/mval_intf.ml similarity index 100% rename from src/cdomain/value/cdomains/mval_intf.ml rename to src/cdomains/mval_intf.ml diff --git a/src/cdomain/value/cdomains/offset.ml b/src/cdomains/offset.ml similarity index 95% rename from src/cdomain/value/cdomains/offset.ml rename to src/cdomains/offset.ml index 62bab39eb78..eca85e08a45 100644 --- a/src/cdomain/value/cdomains/offset.ml +++ b/src/cdomains/offset.ml @@ -22,7 +22,7 @@ struct include CilType.Exp let name () = "exp index" - let any = Cilfacade.any_index_exp + let any = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "any_index") let all = CastE (TInt (Cilfacade.ptrdiff_ikind (), []), mkString "all_index") (* Override output *) @@ -142,11 +142,15 @@ struct | TPtr (t,_), `Index (i,o) -> type_of ~base:t o | TComp (ci,_), `Field (f,o) -> let fi = try getCompField ci f.fname - with Not_found -> raise (Type_of_error (t, show o)) + with Not_found -> + let s = GobPretty.sprintf "Addr.type_offset: field %s not found in type %a" f.fname d_plaintype t in + raise (Type_of_error (t, s)) in type_of ~base:fi.ftype o (* TODO: Why? Imprecise on zstd-thread-pool regression tests. *) (* | TComp _, `Index (_,o) -> type_of ~base:t o (* this happens (hmmer, perlbench). safe? *) *) - | t, o -> raise (Type_of_error (t, show o)) + | t,o -> + let s = GobPretty.sprintf "Addr.type_offset: could not follow offset in type. type: %a, offset: %a" d_plaintype t pretty o in + raise (Type_of_error (t, s)) let rec prefix (x: t) (y: t): t option = match x,y with | `Index (x, xs), `Index (y, ys) when Idx.equal x y -> prefix xs ys @@ -257,9 +261,3 @@ struct | `Index (i,o) -> Index (i, to_cil o) | `Field (f,o) -> Field (f, to_cil o) end - - -let () = Printexc.register_printer (function - | Type_of_error (t, o) -> Some (GobPretty.sprintf "Offset.Type_of_error(%a, %s)" d_plaintype t o) - | _ -> None (* for other exceptions *) - ) diff --git a/src/cdomain/value/cdomains/offset.mli b/src/cdomains/offset.mli similarity index 100% rename from src/cdomain/value/cdomains/offset.mli rename to src/cdomains/offset.mli diff --git a/src/cdomain/value/cdomains/offset_intf.ml b/src/cdomains/offset_intf.ml similarity index 100% rename from src/cdomain/value/cdomains/offset_intf.ml rename to src/cdomains/offset_intf.ml diff --git a/src/cdomain/value/cdomains/preValueDomain.ml b/src/cdomains/preValueDomain.ml similarity index 100% rename from src/cdomain/value/cdomains/preValueDomain.ml rename to src/cdomains/preValueDomain.ml diff --git a/src/cdomains/regionDomain.ml b/src/cdomains/regionDomain.ml index cd9141876c4..b577e3499f9 100644 --- a/src/cdomains/regionDomain.ml +++ b/src/cdomains/regionDomain.ml @@ -8,9 +8,23 @@ module B = Printable.UnitConf (struct let name = "•" end) module VFB = struct - include Printable.EitherConf (struct include Printable.DefaultConf let expand1 = false let expand2 = false end) (VF) (B) + include Printable.Either (VF) (B) let name () = "region" + let pretty () = function + | `Right () -> Pretty.text "•" + | `Left x -> VF.pretty () x + + let show = function + | `Right () -> "•" + | `Left x -> VF.show x + + let printXml f = function + | `Right () -> + BatPrintf.fprintf f "\n\n•\n\n\n" + | `Left x -> + BatPrintf.fprintf f "\n\n%a\n\n\n" VF.printXml x + let collapse (x:t) (y:t): bool = match x,y with | `Right (), `Right () -> true @@ -143,13 +157,13 @@ struct (* This is the main logic for dealing with the bullet and finding it an * owner... *) - let add_set ?(escape=false) (s:set) llist (p,m:t): t = + let add_set (s:set) llist (p,m:t): t = if RS.has_bullet s then let f key value (ys, x) = if RS.has_bullet value then key::ys, RS.join value x else ys,x in let ys,x = RegMap.fold f m (llist, RS.remove_bullet s) in let x = RS.remove_bullet x in - if not escape && RS.is_empty x then + if RS.is_empty x then p, RegMap.add_list_set llist RS.single_bullet m else RegPart.add x p, RegMap.add_list_set ys x m @@ -201,25 +215,6 @@ struct | Some (_,x,_) -> p, RegMap.add x RS.single_bullet m | _ -> p,m - (* Copied & modified from assign. *) - let assign_escape (rval: exp) (st: t): t = - (* let _ = printf "%a = %a\n" (printLval plainCilPrinter) lval (printExp plainCilPrinter) rval in *) - let t = Cilfacade.typeOf rval in - if isPointerType t then begin (* TODO: this currently allows function pointers, e.g. in iowarrior, but should it? *) - match eval_exp rval with - (* TODO: should offs_x matter? *) - | Some (deref_y,y,offs_y) -> - let (p,m) = st in begin - match is_global y with - | true -> - add_set ~escape:true (RS.single_vf y) [] st - | false -> - add_set ~escape:true (RegMap.find y m) [y] st - end - | _ -> st - end else - st - let related_globals (deref_vfd: eval_t) (p,m: t): elt list = let add_o o2 (v,o) = (v, F.add_offset o o2) in match deref_vfd with @@ -238,4 +233,4 @@ struct end (* TODO: remove Lift *) -module RegionDom = Lattice.LiftConf (struct include Printable.DefaultConf let top_name = "Unknown" let bot_name = "Error" end) (RegMap) +module RegionDom = Lattice.Lift (RegMap) (struct let top_name = "Unknown" let bot_name = "Error" end) diff --git a/src/cdomains/specDomain.ml b/src/cdomains/specDomain.ml new file mode 100644 index 00000000000..75a9d8edc51 --- /dev/null +++ b/src/cdomains/specDomain.ml @@ -0,0 +1,34 @@ +(** Domains for finite automaton specification file analysis. *) + +open Batteries + +module D = MvalMapDomain + + +module Val = +struct + type s = string [@@deriving eq, ord, hash] + let name = "Spec value" + let var_state = "" + let string_of_state s = s + + (* transforms May-Sets of length 1 to Must. NOTE: this should only be done if the original set had more than one element! *) + (* let maybe_must = function May xs when Set.cardinal xs = 1 -> Must (Set.choose xs) | x -> x *) + (* let may = function Must x -> May (Set.singleton x) | xs -> xs *) + (* let records = function Must x -> (Set.singleton x) | May xs -> xs *) + (* let list_of_records = function Must x -> [x] | May xs -> List.of_enum (Set.enum xs) *) + (* let vnames x = String.concat ", " (List.map (fun r -> string_of_key r.var) (list_of_records x)) *) +end + + +module Dom = +struct + include D.Domain (D.Value (Val)) + + (* handling state *) + let goto k loc state m = add' k (V.make k loc state) m + let may_goto k loc state m = let v = V.join (find' k m) (V.make k loc state) in add' k v m + let in_state k s m = must k (V.in_state s) m + let may_in_state k s m = may k (V.in_state s) m + let get_states k m = if not (mem k m) then [] else find' k m |> V.map' V.state |> snd |> Set.elements +end diff --git a/src/cdomains/stackDomain.ml b/src/cdomains/stackDomain.ml index 50864d6294b..3a83c785035 100644 --- a/src/cdomains/stackDomain.ml +++ b/src/cdomains/stackDomain.ml @@ -30,7 +30,7 @@ struct module VarLat = Lattice.Fake (Basetype.Variables) - module Var = Lattice.LiftConf (struct include Printable.DefaultConf let top_name="top" let bot_name="⊥" end) (VarLat) + module Var = Lattice.Lift (VarLat) (struct let top_name="top" let bot_name="⊥" end) include Lattice.Liszt (Var) let top () : t = [] diff --git a/src/cdomain/value/cdomains/structDomain.ml b/src/cdomains/structDomain.ml similarity index 100% rename from src/cdomain/value/cdomains/structDomain.ml rename to src/cdomains/structDomain.ml diff --git a/src/cdomain/value/cdomains/structDomain.mli b/src/cdomains/structDomain.mli similarity index 100% rename from src/cdomain/value/cdomains/structDomain.mli rename to src/cdomains/structDomain.mli diff --git a/src/cdomains/symbLocksDomain.ml b/src/cdomains/symbLocksDomain.ml index 85578d5fad8..4a44911a53e 100644 --- a/src/cdomains/symbLocksDomain.ml +++ b/src/cdomains/symbLocksDomain.ml @@ -306,7 +306,6 @@ struct end include AddressDomain.AddressPrintable (Mval.MakePrintable (Offset.MakePrintable (Idx))) - let name () = "i-lock" let rec conv_const_offset x = match x with diff --git a/src/cdomain/value/cdomains/threadIdDomain.ml b/src/cdomains/threadIdDomain.ml similarity index 59% rename from src/cdomain/value/cdomains/threadIdDomain.ml rename to src/cdomains/threadIdDomain.ml index 85f9a0297b0..7193552048a 100644 --- a/src/cdomain/value/cdomains/threadIdDomain.ml +++ b/src/cdomains/threadIdDomain.ml @@ -23,7 +23,7 @@ module type Stateless = sig include S - val threadenter: multiple:bool -> Node.t -> int option -> varinfo -> t + val threadenter: Node.t -> int option -> varinfo -> t end module type Stateful = @@ -32,8 +32,8 @@ sig module D: Lattice.S - val threadenter: multiple:bool -> t * D.t -> Node.t -> int option -> varinfo -> t list - val threadspawn: multiple:bool -> D.t -> Node.t -> int option -> varinfo -> D.t + val threadenter: t * D.t -> Node.t -> int option -> varinfo -> t list + val threadspawn: D.t -> Node.t -> int option -> varinfo -> D.t (** If it is possible to get a list of threads created thus far, get it *) val created: t -> D.t -> (t list) option @@ -71,10 +71,9 @@ struct let threadinit v ~multiple: t = (v, None) - let threadenter ~multiple l i v: t = + let threadenter l i v: t = if GobConfig.get_bool "ana.thread.include-node" then - let counter = Option.map (fun x -> if multiple then WrapperFunctionAnalysis0.ThreadCreateUniqueCount.top () else x) i in - (v, Some (l, counter)) + (v, Some (l, i)) else (v, None) @@ -94,8 +93,8 @@ struct module D = Lattice.Unit - let threadenter ~multiple _ n i v = [threadenter ~multiple n i v] - let threadspawn ~multiple () _ _ _ = () + let threadenter _ n i v = [threadenter n i v] + let threadspawn () _ _ _ = () let created _ _ = None end @@ -163,10 +162,10 @@ struct else ([base_tid], S.empty ()) - let threadenter ~multiple ((p, _ ) as current, (cs,_)) (n: Node.t) i v = - let ni = Base.threadenter ~multiple n i v in + let threadenter ((p, _ ) as current, (cs,_)) (n: Node.t) i v = + let ni = Base.threadenter n i v in let ((p', s') as composed) = compose current ni in - if is_unique composed && (S.mem ni cs || multiple) then + if is_unique composed && S.mem ni cs then [(p, S.singleton ni); composed] (* also respawn unique version of the thread to keep it reachable while thread ID sets refer to it *) else [composed] @@ -183,12 +182,12 @@ struct in Some (List.concat_map map_one els) - let threadspawn ~multiple (cs,cms) l i v = - let e = Base.threadenter ~multiple l i v in + let threadspawn (cs,cms) l i v = + let e = Base.threadenter l i v in if S.mem e cs then (cs, S.add e cms) else - (S.add e cs, if multiple then S.add e cms else cms) + (S.add e cs, cms) let is_main = function | ([fl], s) when S.is_empty s && Base.is_main fl -> true @@ -196,14 +195,12 @@ struct end module ThreadLiftNames = struct - include Printable.DefaultConf let bot_name = "Bot Threads" let top_name = "Top Threads" - let expand1 = false end module Lift (Thread: S) = struct - include Lattice.FlatConf (ThreadLiftNames) (Thread) + include Lattice.Flat (Thread) (ThreadLiftNames) let name () = "Thread" end @@ -219,7 +216,7 @@ struct let name = "FlagConfiguredTID" end) - module D = Lattice.Lift2 (H.D) (P.D) + module D = Lattice.Lift2(H.D)(P.D)(struct let bot_name = "bot" let top_name = "top" end) let history_enabled () = match GobConfig.get_string "ana.thread.domain" with @@ -260,101 +257,28 @@ struct | (None, Some x'), `Top -> liftp x' (P.D.top ()) | _ -> None - let threadenter ~multiple x n i v = + let threadenter x n i v = match x with - | ((Some x', None), `Lifted1 d) -> H.threadenter ~multiple (x',d) n i v |> List.map (fun t -> (Some t, None)) - | ((Some x', None), `Bot) -> H.threadenter ~multiple (x',H.D.bot ()) n i v |> List.map (fun t -> (Some t, None)) - | ((Some x', None), `Top) -> H.threadenter ~multiple (x',H.D.top ()) n i v |> List.map (fun t -> (Some t, None)) - | ((None, Some x'), `Lifted2 d) -> P.threadenter ~multiple (x',d) n i v |> List.map (fun t -> (None, Some t)) - | ((None, Some x'), `Bot) -> P.threadenter ~multiple (x',P.D.bot ()) n i v |> List.map (fun t -> (None, Some t)) - | ((None, Some x'), `Top) -> P.threadenter ~multiple (x',P.D.top ()) n i v |> List.map (fun t -> (None, Some t)) + | ((Some x', None), `Lifted1 d) -> H.threadenter (x',d) n i v |> List.map (fun t -> (Some t, None)) + | ((Some x', None), `Bot) -> H.threadenter (x',H.D.bot ()) n i v |> List.map (fun t -> (Some t, None)) + | ((Some x', None), `Top) -> H.threadenter (x',H.D.top ()) n i v |> List.map (fun t -> (Some t, None)) + | ((None, Some x'), `Lifted2 d) -> P.threadenter (x',d) n i v |> List.map (fun t -> (None, Some t)) + | ((None, Some x'), `Bot) -> P.threadenter (x',P.D.bot ()) n i v |> List.map (fun t -> (None, Some t)) + | ((None, Some x'), `Top) -> P.threadenter (x',P.D.top ()) n i v |> List.map (fun t -> (None, Some t)) | _ -> failwith "FlagConfiguredTID received a value where not exactly one component is set" - let threadspawn ~multiple x n i v = + let threadspawn x n i v = match x with - | `Lifted1 x' -> `Lifted1 (H.threadspawn ~multiple x' n i v) - | `Lifted2 x' -> `Lifted2 (P.threadspawn ~multiple x' n i v) - | `Bot when history_enabled () -> `Lifted1 (H.threadspawn ~multiple (H.D.bot ()) n i v) - | `Bot -> `Lifted2 (P.threadspawn ~multiple (P.D.bot ()) n i v) - | `Top when history_enabled () -> `Lifted1 (H.threadspawn ~multiple (H.D.top ()) n i v) - | `Top -> `Lifted2 (P.threadspawn ~multiple (P.D.top ()) n i v) + | `Lifted1 x' -> `Lifted1 (H.threadspawn x' n i v) + | `Lifted2 x' -> `Lifted2 (P.threadspawn x' n i v) + | `Bot when history_enabled () -> `Lifted1 (H.threadspawn (H.D.bot ()) n i v) + | `Bot -> `Lifted2 (P.threadspawn (P.D.bot ()) n i v) + | `Top when history_enabled () -> `Lifted1 (H.threadspawn (H.D.top ()) n i v) + | `Top -> `Lifted2 (P.threadspawn (P.D.top ()) n i v) let name () = "FlagConfiguredTID: " ^ if history_enabled () then H.name () else P.name () end -type thread = - | Thread of FlagConfiguredTID.t - | UnknownThread -[@@deriving eq, ord, hash] - -module Thread : Stateful with type t = thread = -struct - include Printable.Std - type t = thread [@@deriving eq, ord, hash] - - let name () = "Thread id" - let pretty () t = - match t with - | Thread tid -> FlagConfiguredTID.pretty () tid - | UnknownThread -> Pretty.text "Unknown thread id" - - let show t = - match t with - | Thread tid -> FlagConfiguredTID.show tid - | UnknownThread -> "Unknown thread id" - - let printXml f t = - match t with - | Thread tid -> FlagConfiguredTID.printXml f tid - | UnknownThread -> BatPrintf.fprintf f "\n\nUnknown thread id\n\n\n" - - let to_yojson t = - match t with - | Thread tid -> FlagConfiguredTID.to_yojson tid - | UnknownThread -> `String "Unknown thread id" - - let relift t = - match t with - | Thread tid -> Thread (FlagConfiguredTID.relift tid) - | UnknownThread -> UnknownThread - - let lift t = Thread t - - let threadinit v ~multiple = Thread (FlagConfiguredTID.threadinit v ~multiple) - - let is_main t = - match t with - | Thread tid -> FlagConfiguredTID.is_main tid - | UnknownThread -> false - - let is_unique t = - match t with - | Thread tid -> FlagConfiguredTID.is_unique tid - | UnknownThread -> false - - let may_create t1 t2 = - match t1, t2 with - | Thread tid1, Thread tid2 -> FlagConfiguredTID.may_create tid1 tid2 - | _, _ -> true - - let is_must_parent t1 t2 = - match t1, t2 with - | Thread tid1, Thread tid2 -> FlagConfiguredTID.is_must_parent tid1 tid2 - | _, _ -> false - - module D = FlagConfiguredTID.D - - let threadenter ~multiple (t, d) node i v = - match t with - | Thread tid -> List.map lift (FlagConfiguredTID.threadenter ~multiple (tid, d) node i v) - | UnknownThread -> assert false - - let threadspawn = FlagConfiguredTID.threadspawn - - let created t d = - match t with - | Thread tid -> Option.map (List.map lift) (FlagConfiguredTID.created tid d) - | UnknownThread -> None -end +module Thread = FlagConfiguredTID module ThreadLifted = Lift (Thread) diff --git a/src/cdomain/value/cdomains/unionDomain.ml b/src/cdomains/unionDomain.ml similarity index 93% rename from src/cdomain/value/cdomains/unionDomain.ml rename to src/cdomains/unionDomain.ml index ad5c5310615..ac25450c6ad 100644 --- a/src/cdomain/value/cdomains/unionDomain.ml +++ b/src/cdomains/unionDomain.ml @@ -16,11 +16,10 @@ sig end module Field = struct - include Lattice.FlatConf (struct - include Printable.DefaultConf + include Lattice.Flat (CilType.Fieldinfo) (struct let top_name = "Unknown field" let bot_name = "If you see this, you are special!" - end) (CilType.Fieldinfo) + end) let meet f g = if equal f g then diff --git a/src/cdomain/value/cdomains/valueDomain.ml b/src/cdomains/valueDomain.ml similarity index 95% rename from src/cdomain/value/cdomains/valueDomain.ml rename to src/cdomains/valueDomain.ml index 74e131ef12b..67b3d9429f4 100644 --- a/src/cdomain/value/cdomains/valueDomain.ml +++ b/src/cdomains/valueDomain.ml @@ -19,12 +19,11 @@ sig include Lattice.S type offs val eval_offset: VDQ.t -> (AD.t -> t) -> t-> offs -> exp option -> lval option -> typ -> t - val update_offset: ?blob_destructive:bool -> VDQ.t -> t -> offs -> t -> exp option -> lval -> typ -> t + val update_offset: VDQ.t -> t -> offs -> t -> exp option -> lval -> typ -> t val update_array_lengths: (exp -> t) -> t -> Cil.typ -> t val affect_move: ?replace_with_const:bool -> VDQ.t -> t -> varinfo -> (exp -> int option) -> t val affecting_vars: t -> varinfo list val invalidate_value: VDQ.t -> typ -> t -> t - val invalidate_abstract_value: t -> t val is_safe_cast: typ -> typ -> bool val cast: ?torg:typ -> typ -> t -> t val smart_join: (exp -> BI.t option) -> (exp -> BI.t option) -> t -> t -> t @@ -39,8 +38,6 @@ sig val is_top_value: t -> typ -> bool val zero_init_value: ?varAttr:attributes -> typ -> t - include ArrayDomain.Null with type t := t - val project: VDQ.t -> int_precision option-> ( attributes * attributes ) option -> t -> t val mark_jmpbufs_as_copied: t -> t end @@ -52,7 +49,6 @@ sig type origin include Lattice.S with type t = value * size * origin - val map: (value -> value) -> t -> t val value: t -> value val invalidate_value: VDQ.t -> typ -> t -> t end @@ -72,7 +68,6 @@ struct type size = Size.t type origin = ZeroInit.t - let map f (v, s, o) = f v, s, o let value (a, b, c) = a let relift (a, b, c) = Value.relift a, b, c let invalidate_value ask t (v, s, o) = Value.invalidate_value ask t v, s, o @@ -255,6 +250,7 @@ struct let tag_name : t -> string = function | Top -> "Top" | Int _ -> "Int" | Float _ -> "Float" | Address _ -> "Address" | Struct _ -> "Struct" | Union _ -> "Union" | Array _ -> "Array" | Blob _ -> "Blob" | Thread _ -> "Thread" | Mutex -> "Mutex" | MutexAttr _ -> "MutexAttr" | JmpBuf _ -> "JmpBuf" | Bot -> "Bot" + include Printable.Std let name () = "compound" @@ -268,22 +264,6 @@ struct let is_top x = x = Top let top_name = "Unknown" - let null () = Int (ID.of_int IChar Z.zero) - - type retnull = Null | NotNull | Maybe - let is_null = function - | Int n when GobOption.exists (Z.equal Z.zero) (ID.to_int n) -> Null - | Int n -> - let zero_ik = ID.of_int (ID.ikind n) Z.zero in - if ID.to_bool (ID.ne n zero_ik) = Some true then NotNull else Maybe - | _ -> Maybe - - let get_ikind = function - | Int n -> Some (ID.ikind n) - | _ -> None - let zero_of_ikind ik = Int(ID.of_int ik Z.zero) - let not_zero_of_ikind ik = Int(ID.of_excl_list ik [Z.zero]) - let pretty () state = match state with | Int n -> ID.pretty () n @@ -522,7 +502,7 @@ struct let warn_type op x y = if GobConfig.get_bool "dbg.verbose" then - ignore @@ printf "warn_type %s: incomparable abstr. values %s and %s at %a: %a and %a\n" op (tag_name (x:t)) (tag_name (y:t)) CilType.Location.pretty !Goblint_tracing.current_loc pretty x pretty y + ignore @@ printf "warn_type %s: incomparable abstr. values %s and %s at %a: %a and %a\n" op (tag_name (x:t)) (tag_name (y:t)) CilType.Location.pretty !Tracing.current_loc pretty x pretty y let rec leq x y = match (x,y) with @@ -572,9 +552,11 @@ struct | y, Blob (x,s,o) -> Blob (join (x:t) y, s, o) | (Thread x, Thread y) -> Thread (Threads.join x y) | (Int x, Thread y) - | (Thread y, Int x) -> Thread (Threads.join y (Threads.top ())) + | (Thread y, Int x) -> + Thread y (* TODO: ignores int! *) | (Address x, Thread y) - | (Thread y, Address x) -> Thread (Threads.join y (Threads.top ())) + | (Thread y, Address x) -> + Thread y (* TODO: ignores address! *) | (JmpBuf x, JmpBuf y) -> JmpBuf (JmpBufs.join x y) | (Mutex, Mutex) -> Mutex | (MutexAttr x, MutexAttr y) -> MutexAttr (MutexAttr.join x y) @@ -603,9 +585,11 @@ struct | (Blob x, Blob y) -> Blob (Blobs.widen x y) (* TODO: why no blob special cases like in join? *) | (Thread x, Thread y) -> Thread (Threads.widen x y) | (Int x, Thread y) - | (Thread y, Int x) -> Thread (Threads.widen y (Threads.join y (Threads.top ()))) + | (Thread y, Int x) -> + Thread y (* TODO: ignores int! *) | (Address x, Thread y) - | (Thread y, Address x) -> Thread (Threads.widen y (Threads.join y (Threads.top ()))) + | (Thread y, Address x) -> + Thread y (* TODO: ignores address! *) | (Mutex, Mutex) -> Mutex | (JmpBuf x, JmpBuf y) -> JmpBuf (JmpBufs.widen x y) | (MutexAttr x, MutexAttr y) -> MutexAttr (MutexAttr.widen x y) @@ -724,27 +708,11 @@ struct let v = invalidate_value ask voidType (CArrays.get ask n (array_idx_top) None) in Array (CArrays.set ask n (array_idx_top) v) | t , Blob n -> Blob (Blobs.invalidate_value ask t n) - | _ , Thread tid -> Thread (Threads.join (Threads.top ()) tid) + | _ , Thread _ -> state (* TODO: no top thread ID set! *) | _ , JmpBuf _ -> state (* TODO: no top jmpbuf *) | _, Bot -> Bot (* Leave uninitialized value (from malloc) alone in free to avoid trashing everything. TODO: sound? *) | t , _ -> top_value t - (* TODO: why is this separately needed? *) - let rec invalidate_abstract_value = function - | Top -> Top - | Int i -> Int (ID.top_of (ID.ikind i)) - | Float f -> Float (FD.top_of (FD.get_fkind f)) - | Address _ -> Address (AD.top_ptr) - | Struct s -> Struct (Structs.map invalidate_abstract_value s) - | Union u -> Union (Unions.top ()) (* More precise invalidate does not make sense, as it is not clear which component is accessed. *) - | Array a -> Array (CArrays.map invalidate_abstract_value a) - | Blob b -> Blob (Blobs.map invalidate_abstract_value b) - | Thread _ -> Thread (Threads.top ()) - | JmpBuf _ -> JmpBuf (JmpBufs.top ()) - | Mutex -> Mutex - | MutexAttr _ -> MutexAttr (MutexAttrDomain.top ()) - | Bot -> Bot - (* take the last offset in offset and move it over to left *) let shift_one_over left offset = @@ -930,7 +898,7 @@ struct in do_eval_offset ask f x offs exp l o v t 0 - let update_offset ?(blob_destructive=false) (ask: VDQ.t) (x:t) (offs:offs) (value:t) (exp:exp option) (v:lval) (t:typ): t = + let update_offset (ask: VDQ.t) (x:t) (offs:offs) (value:t) (exp:exp option) (v:lval) (t:typ): t = let rec do_update_offset (ask:VDQ.t) (x:t) (offs:offs) (value:t) (exp:exp option) (l:lval option) (o:offset option) (v:lval) (t:typ) (depth:int):t = if M.tracing then M.traceli "update_offset" "do_update_offset %a %a (%a) %a\n" pretty x Offs.pretty offs (Pretty.docOpt (CilType.Exp.pretty ())) exp pretty value; let mu = function Blob (Blob (y, s', orig), s, orig2) -> Blob (y, ID.join s s',orig) | x -> x in @@ -978,11 +946,9 @@ struct | (Var var, _) -> let blob_size_opt = ID.to_int s in not @@ ask.is_multiple var + && not @@ Cil.isVoidType t (* Size of value is known *) && Option.is_some blob_size_opt (* Size of blob is known *) - && (( - not @@ Cil.isVoidType t (* Size of value is known *) - && BI.equal (Option.get blob_size_opt) (BI.of_int @@ Cil.alignOf_int t) - ) || blob_destructive) + && BI.equal (Option.get blob_size_opt) (BI.of_int @@ Cil.alignOf_int t) | _ -> false end in @@ -1268,7 +1234,7 @@ and Structs: StructDomain.S with type field = fieldinfo and type value = Compoun and Unions: UnionDomain.S with type t = UnionDomain.Field.t * Compound.t and type value = Compound.t = UnionDomain.Simple (Compound) -and CArrays: ArrayDomain.StrWithDomain with type value = Compound.t and type idx = ArrIdxDomain.t = ArrayDomain.AttributeConfiguredAndNullByteArrayDomain(Compound)(ArrIdxDomain) +and CArrays: ArrayDomain.S with type value = Compound.t and type idx = ArrIdxDomain.t = ArrayDomain.AttributeConfiguredArrayDomain(Compound)(ArrIdxDomain) and Blobs: Blob with type size = ID.t and type value = Compound.t and type origin = ZeroInit.t = Blob (Compound) (ID) diff --git a/src/cdomains/vectorMatrix.ml b/src/cdomains/vectorMatrix.ml index 1dd684a4c0f..d652145032d 100644 --- a/src/cdomains/vectorMatrix.ml +++ b/src/cdomains/vectorMatrix.ml @@ -251,14 +251,12 @@ module ArrayVector: AbstractVector = let nth = Array.get - let map2i f v1 v2 = - let f' i = uncurry (f i) in - Array.mapi f' (Array.combine v1 v2) (* TODO: iter2i? *) + let map2i f v1 v2 = let f' i (v'1, v'2) = f i v'1 v'2 in Array.mapi f' (Array.combine v1 v2) (* TODO: iter2i? *) let map2i_with f v1 v2 = Array.iter2i (fun i x y -> v1.(i) <- f i x y) v1 v2 - let find2i f v1 v2 = - Array.findi (uncurry f) (Array.combine v1 v2) (* TODO: iter2i? *) + let find2i f v1 v2 = let f' (v'1, v'2) = f v'1 v'2 in + Array.findi f' (Array.combine v1 v2) (* TODO: iter2i? *) let to_array v = v diff --git a/src/common/cdomains/basetype.ml b/src/common/cdomains/basetype.ml index 1b846309aa3..55b5dbde07b 100644 --- a/src/common/cdomains/basetype.ml +++ b/src/common/cdomains/basetype.ml @@ -20,6 +20,8 @@ struct | _ -> Local let name () = "variables" let printXml f x = BatPrintf.fprintf f "\n\n%s\n\n\n" (XmlUtil.escape (show x)) + + let arbitrary () = MyCheck.Arbitrary.varinfo end module RawStrings: Printable.S with type t = string = @@ -33,6 +35,12 @@ struct let printXml f x = BatPrintf.fprintf f "\n\n%s\n\n\n" (XmlUtil.escape (show x)) end +module Strings: Lattice.S with type t = [`Bot | `Lifted of string | `Top] = + Lattice.Flat (RawStrings) (struct + let top_name = "?" + let bot_name = "-" + end) + module RawBools: Printable.S with type t = bool = struct include Printable.StdLeaf @@ -44,6 +52,12 @@ struct let printXml f x = BatPrintf.fprintf f "\n\n%s\n\n\n" (show x) end +module Bools: Lattice.S with type t = [`Bot | `Lifted of bool | `Top] = + Lattice.Flat (RawBools) (struct + let top_name = "?" + let bot_name = "-" + end) + module CilExp = struct include CilType.Exp diff --git a/src/common/common.mld b/src/common/common.mld index 2176a95b8ab..662c789572d 100644 --- a/src/common/common.mld +++ b/src/common/common.mld @@ -10,20 +10,27 @@ For better context, see {!Goblint_lib} which also documents these modules. Node Edge MyCFG -CfgTools } {2 Specification} {!modules: AnalysisState -AnalysisStateUtil ControlSpecC } +{2 Configuration} +{!modules: +GobConfig +AfterConfig +JsonSchema +Options +} + {1 Domains} {!modules: Printable +Lattice } {2 Analysis-specific} @@ -35,6 +42,7 @@ Printable {1 I/O} {!modules: Messages +Tracing } @@ -43,7 +51,6 @@ Messages {2 General} {!modules: -IntOps LazyEval ResettableLazy MessageUtil @@ -57,13 +64,11 @@ Cilfacade RichVarinfo } -{2 Analysis-specific} -{!modules: -ContextUtil -} - {1 Library extensions} {2 Standard library} {!modules:GobFormat} + +{2 Other libraries} +{!modules:MyCheck} diff --git a/src/domain/lattice.ml b/src/common/domains/lattice.ml similarity index 94% rename from src/domain/lattice.ml rename to src/common/domains/lattice.ml index 99322c09d87..79455aea629 100644 --- a/src/domain/lattice.ml +++ b/src/common/domains/lattice.ml @@ -148,14 +148,13 @@ struct end (* HAS SIDE-EFFECTS ---- PLEASE INSTANCIATE ONLY ONCE!!! *) -module HConsed (Base:S) (Arg: sig val assume_idempotent: bool end) = +module HConsed (Base:S) = struct include Printable.HConsed (Base) - let lift_f2 f x y = f (unlift x) (unlift y) - let narrow x y = if Arg.assume_idempotent && x.BatHashcons.tag == y.BatHashcons.tag then x else lift (lift_f2 Base.narrow x y) + let narrow x y = if x.BatHashcons.tag == y.BatHashcons.tag then x else lift (lift_f2 Base.narrow x y) let widen x y = if x.BatHashcons.tag == y.BatHashcons.tag then x else lift (lift_f2 Base.widen x y) - let meet x y = if Arg.assume_idempotent && x.BatHashcons.tag == y.BatHashcons.tag then x else lift (lift_f2 Base.meet x y) + let meet x y = if x.BatHashcons.tag == y.BatHashcons.tag then x else lift (lift_f2 Base.meet x y) let join x y = if x.BatHashcons.tag == y.BatHashcons.tag then x else lift (lift_f2 Base.join x y) let leq x y = (x.BatHashcons.tag == y.BatHashcons.tag) || lift_f2 Base.leq x y let is_top = lift_f Base.is_top @@ -183,9 +182,9 @@ struct let pretty_diff () ((x:t),(y:t)): Pretty.doc = M.pretty_diff () (unlift x, unlift y) end -module FlatConf (Conf: Printable.LiftConf) (Base: Printable.S) = +module Flat (Base: Printable.S) (N: Printable.LiftingNames) = struct - include Printable.LiftConf (Conf) (Base) + include Printable.Lift (Base) (N) let bot () = `Bot let is_bot x = x = `Bot let top () = `Top @@ -227,12 +226,10 @@ struct end -module Flat = FlatConf (Printable.DefaultConf) - -module LiftConf (Conf: Printable.LiftConf) (Base: S) = +module Lift (Base: S) (N: Printable.LiftingNames) = struct - include Printable.LiftConf (Conf) (Base) + include Printable.Lift (Base) (N) let bot () = `Bot let is_bot x = x = `Bot @@ -280,11 +277,9 @@ struct | _ -> x end -module Lift = LiftConf (Printable.DefaultConf) - -module LiftPO (Conf: Printable.LiftConf) (Base: PO) = +module LiftPO (Base: PO) (N: Printable.LiftingNames) = struct - include Printable.LiftConf (Conf) (Base) + include Printable.Lift (Base) (N) let bot () = `Bot let is_bot x = x = `Bot @@ -340,9 +335,9 @@ struct | _ -> x end -module Lift2Conf (Conf: Printable.Lift2Conf) (Base1: S) (Base2: S) = +module Lift2 (Base1: S) (Base2: S) (N: Printable.LiftingNames) = struct - include Printable.Lift2Conf (Conf) (Base1) (Base2) + include Printable.Lift2 (Base1) (Base2) (N) let bot () = `Bot let is_bot x = x = `Bot @@ -412,8 +407,6 @@ struct end -module Lift2 = Lift2Conf (Printable.DefaultConf) - module ProdConf (C: Printable.ProdConfiguration) (Base1: S) (Base2: S) = struct include Printable.ProdConf (C) (Base1) (Base2) diff --git a/src/util/std/gobQCheck.ml b/src/common/domains/myCheck.ml similarity index 91% rename from src/util/std/gobQCheck.ml rename to src/common/domains/myCheck.ml index 12809d5b468..98583cd2c35 100644 --- a/src/util/std/gobQCheck.ml +++ b/src/common/domains/myCheck.ml @@ -56,4 +56,7 @@ struct let gens = List.map gen arbs in let shrinks = List.map shrink arbs in make ~shrink:(Shrink.sequence shrinks) (Gen.sequence gens) + + open GoblintCil + let varinfo: Cil.varinfo arbitrary = QCheck.always (Cil.makeGlobalVar "arbVar" Cil.voidPtrType) (* S TODO: how to generate this *) end diff --git a/src/common/domains/printable.ml b/src/common/domains/printable.ml index 0b1769e99c1..b0755fb7300 100644 --- a/src/common/domains/printable.ml +++ b/src/common/domains/printable.ml @@ -103,6 +103,18 @@ struct end module Unit = UnitConf (struct let name = "()" end) +module type LiftingNames = +sig + val bot_name: string + val top_name: string +end + +module DefaultNames = +struct + let bot_name = "bot" + let top_name = "top" +end + (* HAS SIDE-EFFECTS ---- PLEASE INSTANCIATE ONLY ONCE!!! *) module HConsed (Base:S) = struct @@ -183,67 +195,11 @@ struct let tag = lift_f M.tag end - -module type PrefixNameConf = -sig - val expand: bool -end - -module PrefixName (Conf: PrefixNameConf) (Base: S): S with type t = Base.t = +module Lift (Base: S) (N: LiftingNames) = struct - include Base - - let pretty () x = - if Conf.expand then - Pretty.dprintf "%s:%a" (Base.name ()) Base.pretty x - else - Base.pretty () x - - let show x = - if Conf.expand then - Base.name () ^ ":" ^ Base.show x - else - Base.show x - - let printXml f x = - if Conf.expand then - BatPrintf.fprintf f "\n\n%s\n\n%a\n\n" (Base.name ()) Base.printXml x - else - Base.printXml f x - - let to_yojson x = - if Conf.expand then - `Assoc [(Base.name (), Base.to_yojson x)] - else - Base.to_yojson x -end - - -module type LiftConf = -sig - val bot_name: string - val top_name: string - val expand1: bool -end - -module DefaultConf = -struct - let bot_name = "bot" - let top_name = "top" - let expand1 = true - let expand2 = true - let expand3 = true -end - -module LiftConf (Conf: LiftConf) (Base: S) = -struct - open struct - module Base = PrefixName (struct let expand = Conf.expand1 end) (Base) - end - type t = [`Bot | `Lifted of Base.t | `Top] [@@deriving eq, ord, hash] include Std - open Conf + include N let lift x = `Lifted x @@ -261,13 +217,13 @@ struct let name () = "lifted " ^ Base.name () let printXml f = function - | `Bot -> BatPrintf.fprintf f "\n\n%s\n\n\n" (XmlUtil.escape bot_name) - | `Top -> BatPrintf.fprintf f "\n\n%s\n\n\n" (XmlUtil.escape top_name) + | `Bot -> BatPrintf.fprintf f "\n\n%s\n\n\n" (XmlUtil.escape N.bot_name) + | `Top -> BatPrintf.fprintf f "\n\n%s\n\n\n" (XmlUtil.escape N.top_name) | `Lifted x -> Base.printXml f x let to_yojson = function - | `Bot -> `String bot_name - | `Top -> `String top_name + | `Bot -> `String N.bot_name + | `Top -> `String N.top_name | `Lifted x -> Base.to_yojson x let relift x = match x with @@ -277,9 +233,9 @@ struct let arbitrary () = let open QCheck.Iter in let shrink = function - | `Lifted x -> (return `Bot) <+> (GobQCheck.shrink (Base.arbitrary ()) x >|= lift) + | `Lifted x -> (return `Bot) <+> (MyCheck.shrink (Base.arbitrary ()) x >|= lift) | `Bot -> empty - | `Top -> GobQCheck.Iter.of_arbitrary ~n:20 (Base.arbitrary ()) >|= lift + | `Top -> MyCheck.Iter.of_arbitrary ~n:20 (Base.arbitrary ()) >|= lift in QCheck.frequency ~shrink ~print:show [ 20, QCheck.map lift (Base.arbitrary ()); @@ -288,96 +244,35 @@ struct ] (* S TODO: decide frequencies *) end -module type EitherConf = -sig - val expand1: bool - val expand2: bool -end - -module EitherConf (Conf: EitherConf) (Base1: S) (Base2: S) = +module Either (Base1: S) (Base2: S) = struct - open struct - module Base1 = PrefixName (struct let expand = Conf.expand1 end) (Base1) - module Base2 = PrefixName (struct let expand = Conf.expand2 end) (Base2) - end - type t = [`Left of Base1.t | `Right of Base2.t] [@@deriving eq, ord, hash] include Std let pretty () (state:t) = match state with - | `Left n -> Base1.pretty () n - | `Right n -> Base2.pretty () n + | `Left n -> Pretty.dprintf "%s:%a" (Base1.name ()) Base1.pretty n + | `Right n -> Pretty.dprintf "%s:%a" (Base2.name ()) Base2.pretty n let show state = match state with - | `Left n -> Base1.show n - | `Right n -> Base2.show n + | `Left n -> (Base1.name ()) ^ ":" ^ Base1.show n + | `Right n -> (Base2.name ()) ^ ":" ^ Base2.show n let name () = "either " ^ Base1.name () ^ " or " ^ Base2.name () let printXml f = function - | `Left x -> Base1.printXml f x - | `Right x -> Base2.printXml f x + | `Left x -> BatPrintf.fprintf f "\n\nLeft\n\n%a\n\n" Base1.printXml x + | `Right x -> BatPrintf.fprintf f "\n\nRight\n\n%a\n\n" Base2.printXml x let to_yojson = function - | `Left x -> Base1.to_yojson x - | `Right x -> Base2.to_yojson x + | `Left x -> `Assoc [ Base1.name (), Base1.to_yojson x ] + | `Right x -> `Assoc [ Base2.name (), Base2.to_yojson x ] let relift = function | `Left x -> `Left (Base1.relift x) | `Right x -> `Right (Base2.relift x) end -module Either = EitherConf (DefaultConf) - -module type Either3Conf = -sig - include EitherConf - val expand3: bool -end - -module Either3Conf (Conf: Either3Conf) (Base1: S) (Base2: S) (Base3: S) = -struct - open struct - module Base1 = PrefixName (struct let expand = Conf.expand1 end) (Base1) - module Base2 = PrefixName (struct let expand = Conf.expand2 end) (Base2) - module Base3 = PrefixName (struct let expand = Conf.expand3 end) (Base3) - end - - type t = [`Left of Base1.t | `Middle of Base2.t | `Right of Base3.t] [@@deriving eq, ord, hash] - include Std - - let pretty () (state:t) = - match state with - | `Left n -> Base1.pretty () n - | `Middle n -> Base2.pretty () n - | `Right n -> Base3.pretty () n - - let show state = - match state with - | `Left n -> Base1.show n - | `Middle n -> Base2.show n - | `Right n -> Base3.show n - - let name () = "either " ^ Base1.name () ^ " or " ^ Base2.name () ^ " or " ^ Base3.name () - let printXml f = function - | `Left x -> Base1.printXml f x - | `Middle x -> Base2.printXml f x - | `Right x -> Base3.printXml f x - - let to_yojson = function - | `Left x -> Base1.to_yojson x - | `Middle x -> Base2.to_yojson x - | `Right x -> Base3.to_yojson x - - let relift = function - | `Left x -> `Left (Base1.relift x) - | `Middle x -> `Middle (Base2.relift x) - | `Right x -> `Right (Base3.relift x) -end - -module Either3 = Either3Conf (DefaultConf) - module Option (Base: S) (N: Name) = struct type t = Base.t option [@@deriving eq, ord, hash] @@ -405,22 +300,11 @@ struct let relift = Option.map Base.relift end -module type Lift2Conf = -sig - include LiftConf - val expand2: bool -end - -module Lift2Conf (Conf: Lift2Conf) (Base1: S) (Base2: S) = +module Lift2 (Base1: S) (Base2: S) (N: LiftingNames) = struct - open struct - module Base1 = PrefixName (struct let expand = Conf.expand1 end) (Base1) - module Base2 = PrefixName (struct let expand = Conf.expand2 end) (Base2) - end - type t = [`Bot | `Lifted1 of Base1.t | `Lifted2 of Base2.t | `Top] [@@deriving eq, ord, hash] include Std - open Conf + include N let pretty () (state:t) = match state with @@ -443,16 +327,16 @@ struct let name () = "lifted " ^ Base1.name () ^ " and " ^ Base2.name () let printXml f = function - | `Bot -> BatPrintf.fprintf f "\n\n%s\n\n\n" bot_name - | `Top -> BatPrintf.fprintf f "\n\n%s\n\n\n" top_name - | `Lifted1 x -> Base1.printXml f x - | `Lifted2 x -> Base2.printXml f x + | `Bot -> BatPrintf.fprintf f "\n\n%s\n\n\n" N.bot_name + | `Top -> BatPrintf.fprintf f "\n\n%s\n\n\n" N.top_name + | `Lifted1 x -> BatPrintf.fprintf f "\n\n\nLifted1\n\n%a\n\n" Base1.printXml x + | `Lifted2 x -> BatPrintf.fprintf f "\n\n\nLifted2\n\n%a\n\n" Base2.printXml x let to_yojson = function - | `Bot -> `String bot_name - | `Top -> `String top_name - | `Lifted1 x -> Base1.to_yojson x - | `Lifted2 x -> Base2.to_yojson x + | `Bot -> `String N.bot_name + | `Top -> `String N.top_name + | `Lifted1 x -> `Assoc [ Base1.name (), Base1.to_yojson x ] + | `Lifted2 x -> `Assoc [ Base2.name (), Base2.to_yojson x ] end module type ProdConfiguration = @@ -708,8 +592,8 @@ struct let arbitrary () = let open QCheck.Iter in let shrink = function - | `Lifted x -> GobQCheck.shrink (Base.arbitrary ()) x >|= lift - | `Top -> GobQCheck.Iter.of_arbitrary ~n:20 (Base.arbitrary ()) >|= lift + | `Lifted x -> MyCheck.shrink (Base.arbitrary ()) x >|= lift + | `Top -> MyCheck.Iter.of_arbitrary ~n:20 (Base.arbitrary ()) >|= lift in QCheck.frequency ~shrink ~print:show [ 20, QCheck.map lift (Base.arbitrary ()); diff --git a/src/common/dune b/src/common/dune index 85769709006..c8f1564782a 100644 --- a/src/common/dune +++ b/src/common/dune @@ -8,21 +8,22 @@ batteries.unthreaded zarith goblint_std - goblint_config - goblint_tracing goblint-cil fpath yojson + json-data-encoding + cpu goblint_timing + goblint_build_info + goblint.sites qcheck-core.runner) (flags :standard -open Goblint_std) - (foreign_stubs (language c) (names stubs)) - (ocamlopt_flags :standard -no-float-const-prop) (preprocess (pps ppx_deriving.std ppx_deriving_hash - ppx_deriving_yojson)) - (instrumentation (backend bisect_ppx))) + ppx_deriving_yojson + ppx_blob)) + (preprocessor_deps (file util/options.schema.json))) (documentation) diff --git a/src/common/framework/analysisState.ml b/src/common/framework/analysisState.ml index fd76e1bb67a..05a93741f82 100644 --- a/src/common/framework/analysisState.ml +++ b/src/common/framework/analysisState.ml @@ -7,8 +7,6 @@ let should_warn = ref false (** Whether signed overflow or underflow happened *) let svcomp_may_overflow = ref false -(** Whether the termination analysis detects the program as non-terminating *) -let svcomp_may_not_terminate = ref false (** Whether an invalid free happened *) let svcomp_may_invalid_free = ref false diff --git a/src/config/afterConfig.ml b/src/common/util/afterConfig.ml similarity index 100% rename from src/config/afterConfig.ml rename to src/common/util/afterConfig.ml diff --git a/src/common/util/cilfacade.ml b/src/common/util/cilfacade.ml index eff97da4040..ba57074e5aa 100644 --- a/src/common/util/cilfacade.ml +++ b/src/common/util/cilfacade.ml @@ -74,18 +74,19 @@ let print (fileAST: file) = let rmTemps fileAST = RmUnused.removeUnused fileAST + let visitors = ref [] let register_preprocess name visitor_fun = visitors := !visitors @ [name, visitor_fun] let do_preprocess ast = - (* this has to be done here, since the settings aren't available when register_preprocess is called *) - let active_visitors = List.filter_map (fun (name, visitor_fun) -> if List.mem name (get_string_list "ana.activated") then Some visitor_fun else None) !visitors in - let f fd visitor_fun = ignore @@ visitCilFunction (visitor_fun fd) fd in - if active_visitors <> [] then - iterGlobals ast (function GFun (fd,_) -> List.iter (f fd) active_visitors | _ -> ()) - else - () + let f fd (name, visitor_fun) = + (* this has to be done here, since the settings aren't available when register_preprocess is called *) + if List.mem name (get_string_list "ana.activated") then + ignore @@ visitCilFunction (visitor_fun fd) fd + in + iterGlobals ast (function GFun (fd,_) -> List.iter (f fd) !visitors | _ -> ()) + (** @raise GoblintCil.FrontC.ParseError @raise GoblintCil.Errormsg.Error *) @@ -531,12 +532,6 @@ let stmt_fundecs: fundec StmtH.t ResettableLazy.t = h ) - -let get_pseudo_return_id fd = - let start_id = 10_000_000_000 in (* TODO get max_sid? *) - let sid = Hashtbl.hash fd.svar.vid in (* Need pure sid instead of Cil.new_sid for incremental, similar to vid in Cilfacade.create_var. We only add one return stmt per loop, so the hash from the functions vid should be unique. *) - if sid < start_id then sid + start_id else sid - let pseudo_return_to_fun = StmtH.create 113 (** Find [fundec] which the [stmt] is in. *) @@ -672,16 +667,9 @@ let find_stmt_sid sid = try IntH.find pseudo_return_stmt_sids sid with Not_found -> IntH.find (ResettableLazy.force stmt_sids) sid -module FunLocH = Hashtbl.Make(CilType.Fundec) -module LocSet = Hashtbl.Make(CilType.Location) - -(** Contains the locations of the upjumping gotos and the respective functions - * they are being called in. *) -let funs_with_upjumping_gotos: unit LocSet.t FunLocH.t = FunLocH.create 13 -let reset_lazy ?(keepupjumpinggotos=false) () = +let reset_lazy () = StmtH.clear pseudo_return_to_fun; - if not keepupjumpinggotos then FunLocH.clear funs_with_upjumping_gotos; ResettableLazy.reset stmt_fundecs; ResettableLazy.reset varinfo_fundecs; ResettableLazy.reset name_fundecs; @@ -713,9 +701,3 @@ let add_function_declarations (file: Cil.file): unit = let fun_decls = List.filter_map declaration_from_GFun functions in let globals = upto_last_type @ fun_decls @ non_types @ functions in file.globals <- globals - - -(** Special index expression for some unknown index. - Weakly updates array in assignment. - Used for [exp.fast_global_inits]. *) -let any_index_exp = CastE (TInt (ptrdiff_ikind (), []), mkString "any_index") (* TODO: move back to Offset *) diff --git a/src/config/gobConfig.ml b/src/common/util/gobConfig.ml similarity index 96% rename from src/config/gobConfig.ml rename to src/common/util/gobConfig.ml index 24a1701ce60..c517ba150d0 100644 --- a/src/config/gobConfig.ml +++ b/src/common/util/gobConfig.ml @@ -21,6 +21,7 @@ *) open Batteries +open Tracing open Printf exception ConfigError of string @@ -299,7 +300,7 @@ struct try let st = String.trim st in let x = get_value !json_conf (parse_path st) in - if Goblint_tracing.tracing then Goblint_tracing.trace "conf-reads" "Reading '%s', it is %a.\n" st GobYojson.pretty x; + if tracing then trace "conf-reads" "Reading '%s', it is %a.\n" st GobYojson.pretty x; try f x with Yojson.Safe.Util.Type_error (s, _) -> eprintf "The value for '%s' has the wrong type: %s\n" st s; @@ -331,7 +332,7 @@ struct let wrap_get f x = (* self-observe options, which Spec construction depends on *) - if !building_spec && Goblint_tracing.tracing then Goblint_tracing.trace "config" "get during building_spec: %s\n" x; + if !building_spec && Tracing.tracing then Tracing.trace "config" "get during building_spec: %s\n" x; (* TODO: blacklist such building_spec option from server mode modification since it will have no effect (spec is already built) *) f x @@ -351,7 +352,7 @@ struct (** Helper function for writing values. Handles the tracing. *) let set_path_string st v = - if Goblint_tracing.tracing then Goblint_tracing.trace "conf" "Setting '%s' to %a.\n" st GobYojson.pretty v; + if tracing then trace "conf" "Setting '%s' to %a.\n" st GobYojson.pretty v; set_value v json_conf (parse_path st) let set_json st j = @@ -401,7 +402,7 @@ struct | Some fn -> let v = Yojson.Safe.from_channel % BatIO.to_input_channel |> File.with_file_in (Fpath.to_string fn) in merge v; - if Goblint_tracing.tracing then Goblint_tracing.trace "conf" "Merging with '%a', resulting\n%a.\n" GobFpath.pretty fn GobYojson.pretty !json_conf + if tracing then trace "conf" "Merging with '%a', resulting\n%a.\n" GobFpath.pretty fn GobYojson.pretty !json_conf | None -> raise (Sys_error (Printf.sprintf "%s: No such file or diretory" (Fpath.to_string fn))) end diff --git a/src/config/jsonSchema.ml b/src/common/util/jsonSchema.ml similarity index 100% rename from src/config/jsonSchema.ml rename to src/common/util/jsonSchema.ml diff --git a/src/common/util/messageCategory.ml b/src/common/util/messageCategory.ml index 41c9bc08e18..c70b8faf5f3 100644 --- a/src/common/util/messageCategory.ml +++ b/src/common/util/messageCategory.ml @@ -46,7 +46,6 @@ type category = | Imprecise | Witness | Program - | Termination [@@deriving eq, ord, hash] type t = category [@@deriving eq, ord, hash] @@ -205,7 +204,6 @@ let should_warn e = | Imprecise -> "imprecise" | Witness -> "witness" | Program -> "program" - | Termination -> "termination" (* Don't forget to add option to schema! *) in get_bool ("warn." ^ (to_string e)) @@ -226,7 +224,6 @@ let path_show e = | Imprecise -> ["Imprecise"] | Witness -> ["Witness"] | Program -> ["Program"] - | Termination -> ["Termination"] let show x = String.concat " > " (path_show x) @@ -266,7 +263,6 @@ let categoryName = function | Overflow -> "Overflow"; | DivByZero -> "DivByZero") | Float -> "Float" - | Termination -> "Termination" let from_string_list (s: string list) = @@ -287,7 +283,6 @@ let from_string_list (s: string list) = | "imprecise" -> Imprecise | "witness" -> Witness | "program" -> Program - | "termination" -> Termination | _ -> Unknown let to_yojson x = `List (List.map (fun x -> `String x) (path_show x)) diff --git a/src/common/util/messages.ml b/src/common/util/messages.ml index d7afec43c51..42a31189783 100644 --- a/src/common/util/messages.ml +++ b/src/common/util/messages.ml @@ -339,23 +339,4 @@ let msg_final severity ?(tags=[]) ?(category=Category.Unknown) fmt = else GobPretty.igprintf () fmt - -include Goblint_tracing - -open Pretty - -let tracel sys ?var fmt = - let loc = !current_loc in - let docloc sys doc = - printtrace sys (dprintf "(%a)@?" CilType.Location.pretty loc ++ indent 2 doc); - in - gtrace true docloc sys var ~loc ignore fmt - -let traceli sys ?var ?(subsys=[]) fmt = - let loc = !current_loc in - let g () = activate sys subsys in - let docloc sys doc: unit = - printtrace sys (dprintf "(%a)" CilType.Location.pretty loc ++ indent 2 doc); - traceIndent () - in - gtrace true docloc sys var ~loc g fmt +include Tracing diff --git a/src/config/options.ml b/src/common/util/options.ml similarity index 98% rename from src/config/options.ml rename to src/common/util/options.ml index 125da3330bd..3046f708098 100644 --- a/src/config/options.ml +++ b/src/common/util/options.ml @@ -1,4 +1,4 @@ -(** [src/config/options.schema.json] low-level access. *) +(** [src/common/util/options.schema.json] low-level access. *) open Json_schema diff --git a/src/config/options.schema.json b/src/common/util/options.schema.json similarity index 94% rename from src/config/options.schema.json rename to src/common/util/options.schema.json index e6586ed56dd..4df26495429 100644 --- a/src/config/options.schema.json +++ b/src/common/util/options.schema.json @@ -352,7 +352,7 @@ "description": "List of path-sensitive analyses", "type": "array", "items": { "type": "string" }, - "default": [ "mutex", "malloc_null", "uninit", "expsplit","activeSetjmp","memLeak" ] + "default": [ "mutex", "malloc_null", "uninit", "expsplit","activeSetjmp" ] }, "ctx_insens": { "title": "ana.ctx_insens", @@ -467,6 +467,32 @@ }, "additionalProperties": false }, + "file": { + "title": "ana.file", + "type": "object", + "properties": { + "optimistic": { + "title": "ana.file.optimistic", + "description": "Assume fopen never fails.", + "type": "boolean", + "default": false + } + }, + "additionalProperties": false + }, + "spec": { + "title": "ana.spec", + "type": "object", + "properties": { + "file": { + "title": "ana.spec.file", + "description": "Path to the specification file.", + "type": "string", + "default": "" + } + }, + "additionalProperties": false + }, "pml": { "title": "ana.pml", "type": "object", @@ -516,39 +542,9 @@ "title": "ana.autotune.activated", "description": "Lists of activated tuning options.", "type": "array", - "items": { - "type": "string", - "enum": [ - "congruence", - "singleThreaded", - "specification", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "loopUnrollHeuristic", - "forceLoopUnrollForFewLoops", - "arrayDomain", - "octagon", - "wideningThresholds", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" - ] - }, + "items": { "type": "string" }, "default": [ - "congruence", - "singleThreaded", - "specification", - "mallocWrappers", - "noRecursiveIntervals", - "enums", - "loopUnrollHeuristic", - "arrayDomain", - "octagon", - "wideningThresholds", - "memsafetySpecification", - "termination", - "tmpSpecialAnalysis" + "congruence", "singleThreaded", "specification", "mallocWrappers", "noRecursiveIntervals", "enums", "loopUnrollHeuristic", "arrayDomain", "octagon", "wideningThresholds" ] } }, @@ -629,19 +625,11 @@ }, "additionalProperties": false }, - "strings": { - "title": "ana.base.strings", - "type": "object", - "properties": { - "domain": { - "title": "ana.base.strings.domain", - "description": "Domain for string literals.", - "type": "string", - "enum": ["unit", "flat", "disjoint"], - "default": "flat" - } - }, - "additionalProperties": false + "limit-string-addresses": { + "title": "ana.base.limit-string-addresses", + "description": "Limit abstract address sets to keep at most one distinct string pointer.", + "type": "boolean", + "default": true }, "partition-arrays": { "title": "ana.base.partition-arrays", @@ -689,12 +677,6 @@ "description": "Indicates how many values will the unrolled part of the unrolled array domain contain.", "type": "integer", "default": 0 - }, - "nullbytes": { - "title": "ana.base.arrays.nullbytes", - "description": "Whether the Null Byte array domain should be activated.", - "type": "boolean", - "default": false } }, "additionalProperties": false @@ -1032,12 +1014,6 @@ "type": "boolean", "default": true }, - "call": { - "title": "ana.race.call", - "description": "Report races for thread-unsafe function calls.", - "type": "boolean", - "default": true - }, "direct-arithmetic": { "title": "ana.race.direct-arithmetic", "description": "Collect and distribute direct (i.e. not in a field) accesses to arithmetic types.", @@ -1319,7 +1295,6 @@ "linux-kernel", "goblint", "sv-comp", - "klever", "ncurses", "zstd", "pcre", @@ -2136,12 +2111,6 @@ "type": "boolean", "default": true }, - "termination": { - "title": "warn.termination", - "description": "Non-Termination warning", - "type": "boolean", - "default": true - }, "unknown": { "title": "warn.unknown", "description": "Unknown (of string) warnings", @@ -2195,25 +2164,6 @@ "description": "Output messages in deterministic order. Useful for cram testing.", "type": "boolean", "default": false - }, - "memleak": { - "title": "warn.memleak", - "type":"object", - "properties": { - "memcleanup": { - "title": "warn.memleak.memcleanup", - "description": "Enable memory leak warnings only for violations of the SV-COMP \"valid-memcleanup\" category", - "type": "boolean", - "default": false - }, - "memtrack": { - "title": "warn.memleak.memtrack", - "description": "Enable memory leak warnings only for violations of the SV-COMP \"valid-memtrack\" category", - "type": "boolean", - "default": false - } - }, - "additionalProperties": false } }, "additionalProperties": false @@ -2335,56 +2285,24 @@ "title": "witness", "type": "object", "properties": { - "graphml": { - "title": "witness.graphml", - "type": "object", - "properties": { - "enabled": { - "title": "witness.graphml.enabled", - "description": "Output GraphML witness", - "type": "boolean", - "default": false - }, - "path": { - "title": "witness.graphml.path", - "description": "GraphML witness output path", - "type": "string", - "default": "witness.graphml" - }, - "id": { - "title": "witness.graphml.id", - "description": "Which witness node IDs to use? node/enumerate", - "type": "string", - "enum": ["node", "enumerate"], - "default": "node" - }, - "minimize": { - "title": "witness.graphml.minimize", - "description": "Try to minimize the witness", - "type": "boolean", - "default": false - }, - "uncil": { - "title": "witness.graphml.uncil", - "description": - "Try to undo CIL control flow transformations in witness", - "type": "boolean", - "default": false - }, - "stack": { - "title": "witness.graphml.stack", - "description": "Construct stacktrace-based witness nodes", - "type": "boolean", - "default": true - }, - "unknown": { - "title": "witness.graphml.unknown", - "description": "Output witness for unknown result", - "type": "boolean", - "default": true - } - }, - "additionalProperties": false + "enabled": { + "title": "witness.enabled", + "description": "Output witness", + "type": "boolean", + "default": true + }, + "path": { + "title": "witness.path", + "description": "Witness output path", + "type": "string", + "default": "witness.graphml" + }, + "id": { + "title": "witness.id", + "description": "Which witness node IDs to use? node/enumerate", + "type": "string", + "enum": ["node", "enumerate"], + "default": "node" }, "invariant": { "title": "witness.invariant", @@ -2421,7 +2339,7 @@ "title": "witness.invariant.accessed", "description": "Only emit invariants for locally accessed variables", "type": "boolean", - "default": false + "default": true }, "full": { "title": "witness.invariant.full", @@ -2464,6 +2382,31 @@ }, "additionalProperties": false }, + "minimize": { + "title": "witness.minimize", + "description": "Try to minimize the witness", + "type": "boolean", + "default": false + }, + "uncil": { + "title": "witness.uncil", + "description": + "Try to undo CIL control flow transformations in witness", + "type": "boolean", + "default": false + }, + "stack": { + "title": "witness.stack", + "description": "Construct stacktrace-based witness nodes", + "type": "boolean", + "default": true + }, + "unknown": { + "title": "witness.unknown", + "description": "Output witness for unknown result", + "type": "boolean", + "default": true + }, "yaml": { "title": "witness.yaml", "type": "object", @@ -2474,16 +2417,6 @@ "type": "boolean", "default": false }, - "format-version": { - "title": "witness.yaml.format-version", - "description": "YAML witness format version", - "type": "string", - "enum": [ - "0.1", - "2.0" - ], - "default": "0.1" - }, "entry-types": { "title": "witness.yaml.entry-types", "description": "YAML witness entry types to output/input.", @@ -2496,8 +2429,7 @@ "flow_insensitive_invariant", "precondition_loop_invariant", "loop_invariant_certificate", - "precondition_loop_invariant_certificate", - "invariant_set" + "precondition_loop_invariant_certificate" ] }, "default": [ @@ -2505,24 +2437,7 @@ "loop_invariant", "flow_insensitive_invariant", "loop_invariant_certificate", - "precondition_loop_invariant_certificate", - "invariant_set" - ] - }, - "invariant-types": { - "title": "witness.yaml.invariant-types", - "description": "YAML witness invariant types to output/input.", - "type": "array", - "items": { - "type": "string", - "enum": [ - "location_invariant", - "loop_invariant" - ] - }, - "default": [ - "location_invariant", - "loop_invariant" + "precondition_loop_invariant_certificate" ] }, "path": { @@ -2537,12 +2452,6 @@ "type": "string", "default": "" }, - "strict": { - "title": "witness.yaml.strict", - "description": "", - "type": "boolean", - "default": false - }, "unassume": { "title": "witness.yaml.unassume", "description": "YAML witness input path", diff --git a/src/util/tracing/goblint_tracing.ml b/src/common/util/tracing.ml similarity index 84% rename from src/util/tracing/goblint_tracing.ml rename to src/common/util/tracing.ml index 0e5580b036b..ad8892c3963 100644 --- a/src/util/tracing/goblint_tracing.ml +++ b/src/common/util/tracing.ml @@ -4,7 +4,6 @@ * large domains we output. The original code generated the document object * even when the subsystem is not activated. *) -open Goblint_std open GoblintCil open Pretty @@ -68,6 +67,13 @@ let trace sys ?var fmt = gtrace true printtrace sys var ignore fmt * c: continue/normal print w/o indent-change *) +let tracel sys ?var fmt = + let loc = !current_loc in + let docloc sys doc = + printtrace sys (dprintf "(%a)@?" CilType.Location.pretty loc ++ indent 2 doc); + in + gtrace true docloc sys var ~loc ignore fmt + let tracei (sys:string) ?var ?(subsys=[]) fmt = let f sys d = printtrace sys d; traceIndent () in let g () = activate sys subsys in @@ -79,3 +85,13 @@ let traceu sys fmt = let f sys d = printtrace sys d; traceOutdent () in let g () = deactivate sys in gtrace true f sys None g fmt + + +let traceli sys ?var ?(subsys=[]) fmt = + let loc = !current_loc in + let g () = activate sys subsys in + let docloc sys doc: unit = + printtrace sys (dprintf "(%a)" CilType.Location.pretty loc ++ indent 2 doc); + traceIndent () + in + gtrace true docloc sys var ~loc g fmt diff --git a/src/common/util/xmlUtil.ml b/src/common/util/xmlUtil.ml index c0eaa074e9c..e33be1b2150 100644 --- a/src/common/util/xmlUtil.ml +++ b/src/common/util/xmlUtil.ml @@ -11,5 +11,4 @@ let escape (x:string):string = Str.global_replace (Str.regexp "\"") """ |> Str.global_replace (Str.regexp "'") "'" |> Str.global_replace (Str.regexp "[\x0b\001\x0c\x0f\x0e\x05]") "" |> (* g2html just cannot handle from some kernel benchmarks, even when escaped... *) - Str.global_replace (Str.regexp "[\x1b]") "" |> (* g2html cannot handle from chrony *) - Str.global_replace (Str.regexp "\x00") "\\\\0" (* produces \\0, is needed if an example contains \0 *) + Str.global_replace (Str.regexp "[\x1b]") "" (* g2html cannot handle from chrony *) diff --git a/src/config/config.mld b/src/config/config.mld deleted file mode 100644 index 160eaa9a117..00000000000 --- a/src/config/config.mld +++ /dev/null @@ -1,14 +0,0 @@ -{0 Library goblint.config} -This library is unwrapped and provides the following top-level modules. -For better context, see {!Goblint_lib} which also documents these modules. - - -{1 Framework} - -{2 Configuration} -{!modules: -GobConfig -AfterConfig -JsonSchema -Options -} diff --git a/src/config/dune b/src/config/dune deleted file mode 100644 index ce5cb115593..00000000000 --- a/src/config/dune +++ /dev/null @@ -1,24 +0,0 @@ -(include_subdirs no) - -(library - (name goblint_config) - (public_name goblint.config) - (wrapped false) ; TODO: wrap - (libraries - batteries.unthreaded - goblint_std - goblint_tracing - fpath - yojson - json-data-encoding - cpu - goblint.sites - qcheck-core.runner) - (flags :standard -open Goblint_std) - (preprocess - (pps - ppx_blob)) - (preprocessor_deps (file options.schema.json)) - (instrumentation (backend bisect_ppx))) - -(documentation) diff --git a/src/constraint/constrSys.ml b/src/constraint/constrSys.ml deleted file mode 100644 index 1698d5f2147..00000000000 --- a/src/constraint/constrSys.ml +++ /dev/null @@ -1,299 +0,0 @@ -(** {{!MonSystem} constraint system} signatures. *) - -open Batteries - -module type SysVar = -sig - type t - val is_write_only: t -> bool -end - -module type VarType = -sig - include Hashtbl.HashedType - include SysVar with type t := t - val pretty_trace: unit -> t -> GoblintCil.Pretty.doc - val compare : t -> t -> int - - val printXml : 'a BatInnerIO.output -> t -> unit - val var_id : t -> string - val node : t -> MyCFG.node - val relift : t -> t (* needed only for incremental+hashcons to re-hashcons contexts after loading *) -end - -(** Abstract incremental change to constraint system. - @param 'v constrain system variable type *) -type 'v sys_change_info = { - obsolete: 'v list; (** Variables to destabilize. *) - delete: 'v list; (** Variables to delete. *) - reluctant: 'v list; (** Variables to solve reluctantly. *) - restart: 'v list; (** Variables to restart. *) -} - -(** A side-effecting system. *) -module type MonSystem = -sig - type v (* variables *) - type d (* values *) - type 'a m (* basically a monad carrier *) - - (** Variables must be hashable, comparable, etc. *) - module Var : VarType with type t = v - - (** Values must form a lattice. *) - module Dom : Lattice.S with type t = d - - (** The system in functional form. *) - val system : v -> ((v -> d) -> (v -> d -> unit) -> d) m - - val sys_change: (v -> d) -> v sys_change_info - (** Compute incremental constraint system change from old solution. *) -end - -(** Any system of side-effecting equations over lattices. *) -module type EqConstrSys = MonSystem with type 'a m := 'a option - -(** A side-effecting system with globals. *) -module type GlobConstrSys = -sig - module LVar : VarType - module GVar : VarType - - module D : Lattice.S - module G : Lattice.S - val system : LVar.t -> ((LVar.t -> D.t) -> (LVar.t -> D.t -> unit) -> (GVar.t -> G.t) -> (GVar.t -> G.t -> unit) -> D.t) option - val iter_vars: (LVar.t -> D.t) -> (GVar.t -> G.t) -> VarQuery.t -> LVar.t VarQuery.f -> GVar.t VarQuery.f -> unit - val sys_change: (LVar.t -> D.t) -> (GVar.t -> G.t) -> [`L of LVar.t | `G of GVar.t] sys_change_info -end - -(** A solver is something that can translate a system into a solution (hash-table). - Incremental solver has data to be marshaled. *) -module type GenericEqIncrSolverBase = - functor (S:EqConstrSys) -> - functor (H:Hashtbl.S with type key=S.v) -> - sig - type marshal - - val copy_marshal: marshal -> marshal - val relift_marshal: marshal -> marshal - - (** The hash-map that is the first component of [solve xs vs] is a local solution for interesting variables [vs], - reached from starting values [xs]. - As a second component the solver returns data structures for incremental serialization. *) - val solve : (S.v*S.d) list -> S.v list -> marshal option -> S.d H.t * marshal - end - -(** (Incremental) solver argument, indicating which postsolving should be performed by the solver. *) -module type IncrSolverArg = -sig - val should_prune: bool - val should_verify: bool - val should_warn: bool - val should_save_run: bool -end - -(** An incremental solver takes the argument about postsolving. *) -module type GenericEqIncrSolver = - functor (Arg: IncrSolverArg) -> - GenericEqIncrSolverBase - -(** A solver is something that can translate a system into a solution (hash-table) *) -module type GenericEqSolver = - functor (S:EqConstrSys) -> - functor (H:Hashtbl.S with type key=S.v) -> - sig - (** The hash-map that is the first component of [solve xs vs] is a local solution for interesting variables [vs], - reached from starting values [xs]. *) - val solve : (S.v*S.d) list -> S.v list -> S.d H.t - end - -(** A solver is something that can translate a system into a solution (hash-table) *) -module type GenericGlobSolver = - functor (S:GlobConstrSys) -> - functor (LH:Hashtbl.S with type key=S.LVar.t) -> - functor (GH:Hashtbl.S with type key=S.GVar.t) -> - sig - type marshal - - val copy_marshal: marshal -> marshal - val relift_marshal: marshal -> marshal - - (** The hash-map that is the first component of [solve xs vs] is a local solution for interesting variables [vs], - reached from starting values [xs]. - As a second component the solver returns data structures for incremental serialization. *) - val solve : (S.LVar.t*S.D.t) list -> (S.GVar.t*S.G.t) list -> S.LVar.t list -> marshal option -> (S.D.t LH.t * S.G.t GH.t) * marshal - end - - -(** Combined variables so that we can also use the more common [EqConstrSys] - that uses only one kind of a variable. *) -module Var2 (LV:VarType) (GV:VarType) - : VarType - with type t = [ `L of LV.t | `G of GV.t ] -= -struct - type t = [ `L of LV.t | `G of GV.t ] [@@deriving eq, ord, hash] - let relift = function - | `L x -> `L (LV.relift x) - | `G x -> `G (GV.relift x) - - let pretty_trace () = function - | `L a -> GoblintCil.Pretty.dprintf "L:%a" LV.pretty_trace a - | `G a -> GoblintCil.Pretty.dprintf "G:%a" GV.pretty_trace a - - let printXml f = function - | `L a -> LV.printXml f a - | `G a -> GV.printXml f a - - let var_id = function - | `L a -> LV.var_id a - | `G a -> GV.var_id a - - let node = function - | `L a -> LV.node a - | `G a -> GV.node a - - let is_write_only = function - | `L a -> LV.is_write_only a - | `G a -> GV.is_write_only a -end - - -(** Translate a [GlobConstrSys] into a [EqConstrSys] *) -module EqConstrSysFromGlobConstrSys (S:GlobConstrSys) - : EqConstrSys with type v = Var2(S.LVar)(S.GVar).t - and type d = Lattice.Lift2(S.G)(S.D).t - and module Var = Var2(S.LVar)(S.GVar) - and module Dom = Lattice.Lift2(S.G)(S.D) -= -struct - module Var = Var2(S.LVar)(S.GVar) - module Dom = - struct - include Lattice.Lift2 (S.G) (S.D) - let printXml f = function - | `Lifted1 a -> S.G.printXml f a - | `Lifted2 a -> S.D.printXml f a - | (`Bot | `Top) as x -> printXml f x - end - type v = Var.t - type d = Dom.t - - let getG = function - | `Lifted1 x -> x - | `Bot -> S.G.bot () - | `Top -> failwith "EqConstrSysFromGlobConstrSys.getG: global variable has top value" - | `Lifted2 _ -> failwith "EqConstrSysFromGlobConstrSys.getG: global variable has local value" - - let getL = function - | `Lifted2 x -> x - | `Bot -> S.D.bot () - | `Top -> failwith "EqConstrSysFromGlobConstrSys.getL: local variable has top value" - | `Lifted1 _ -> failwith "EqConstrSysFromGlobConstrSys.getL: local variable has global value" - - let l, g = (fun x -> `L x), (fun x -> `G x) - let lD, gD = (fun x -> `Lifted2 x), (fun x -> `Lifted1 x) - - let conv f get set = - f (getL % get % l) (fun x v -> set (l x) (lD v)) - (getG % get % g) (fun x v -> set (g x) (gD v)) - |> lD - - let system = function - | `G _ -> None - | `L x -> Option.map conv (S.system x) - - let sys_change get = - S.sys_change (getL % get % l) (getG % get % g) -end - -(** Splits a [EqConstrSys] solution into a [GlobConstrSys] solution with given [Hashtbl.S] for the [EqConstrSys]. *) -module GlobConstrSolFromEqConstrSolBase (S: GlobConstrSys) (LH: Hashtbl.S with type key = S.LVar.t) (GH: Hashtbl.S with type key = S.GVar.t) (VH: Hashtbl.S with type key = Var2 (S.LVar) (S.GVar).t) = -struct - let split_solution hm = - let l' = LH.create 113 in - let g' = GH.create 113 in - let split_vars x d = match x with - | `L x -> - begin match d with - | `Lifted2 d -> LH.replace l' x d - (* | `Bot -> () *) - (* Since Verify2 is broken and only checks existing keys, add it with local bottom value. - This works around some cases, where Verify2 would not detect a problem due to completely missing variable. *) - | `Bot -> LH.replace l' x (S.D.bot ()) - | `Top -> failwith "GlobConstrSolFromEqConstrSolBase.split_vars: local variable has top value" - | `Lifted1 _ -> failwith "GlobConstrSolFromEqConstrSolBase.split_vars: local variable has global value" - end - | `G x -> - begin match d with - | `Lifted1 d -> GH.replace g' x d - | `Bot -> () - | `Top -> failwith "GlobConstrSolFromEqConstrSolBase.split_vars: global variable has top value" - | `Lifted2 _ -> failwith "GlobConstrSolFromEqConstrSolBase.split_vars: global variable has local value" - end - in - VH.iter split_vars hm; - (l', g') -end - -(** Splits a [EqConstrSys] solution into a [GlobConstrSys] solution. *) -module GlobConstrSolFromEqConstrSol (S: GlobConstrSys) (LH: Hashtbl.S with type key = S.LVar.t) (GH: Hashtbl.S with type key = S.GVar.t) = -struct - module S2 = EqConstrSysFromGlobConstrSys (S) - module VH = Hashtbl.Make (S2.Var) - - include GlobConstrSolFromEqConstrSolBase (S) (LH) (GH) (VH) -end - -(** Transforms a [GenericEqIncrSolver] into a [GenericGlobSolver]. *) -module GlobSolverFromEqSolver (Sol:GenericEqIncrSolverBase) - = functor (S:GlobConstrSys) -> - functor (LH:Hashtbl.S with type key=S.LVar.t) -> - functor (GH:Hashtbl.S with type key=S.GVar.t) -> - struct - module EqSys = EqConstrSysFromGlobConstrSys (S) - - module VH : Hashtbl.S with type key=EqSys.v = Hashtbl.Make(EqSys.Var) - module Sol' = Sol (EqSys) (VH) - - module Splitter = GlobConstrSolFromEqConstrSolBase (S) (LH) (GH) (VH) (* reuse EqSys and VH *) - - type marshal = Sol'.marshal - - let copy_marshal = Sol'.copy_marshal - let relift_marshal = Sol'.relift_marshal - - let solve ls gs l old_data = - let vs = List.map (fun (x,v) -> `L x, `Lifted2 v) ls - @ List.map (fun (x,v) -> `G x, `Lifted1 v) gs in - let sv = List.map (fun x -> `L x) l in - let hm, solver_data = Sol'.solve vs sv old_data in - Splitter.split_solution hm, solver_data - end - - -(** [EqConstrSys] where [current_var] indicates the variable whose right-hand side is currently being evaluated. *) -module CurrentVarEqConstrSys (S: EqConstrSys) = -struct - let current_var = ref None - - module S = - struct - include S - - let system x = - match S.system x with - | None -> None - | Some f -> - let f' get set = - let old_current_var = !current_var in - current_var := Some x; - Fun.protect ~finally:(fun () -> - current_var := old_current_var - ) (fun () -> - f get set - ) - in - Some f' - end -end diff --git a/src/constraint/constraint.mld b/src/constraint/constraint.mld deleted file mode 100644 index 695e7bfa0dd..00000000000 --- a/src/constraint/constraint.mld +++ /dev/null @@ -1,16 +0,0 @@ -{0 Library goblint.constraint} -This library is unwrapped and provides the following top-level modules. -For better context, see {!Goblint_lib} which also documents these modules. - - -{1 Framework} - -{2 Specification} -{!modules: -ConstrSys -} - -{2 Results} -{!modules: -VarQuery -} diff --git a/src/constraint/dune b/src/constraint/dune deleted file mode 100644 index 2d11b9010fd..00000000000 --- a/src/constraint/dune +++ /dev/null @@ -1,21 +0,0 @@ -(include_subdirs no) - -(library - (name goblint_constraint) - (public_name goblint.constraint) - (wrapped false) ; TODO: wrap - (libraries - batteries.unthreaded - goblint_std - goblint_common - goblint_domain - goblint-cil) - (flags :standard -open Goblint_std) - (preprocess - (pps - ppx_deriving.std - ppx_deriving_hash - ppx_deriving_yojson)) - (instrumentation (backend bisect_ppx))) - -(documentation) diff --git a/src/domain/domain.mld b/src/domain/domain.mld deleted file mode 100644 index ce7e1a58592..00000000000 --- a/src/domain/domain.mld +++ /dev/null @@ -1,21 +0,0 @@ -{0 Library goblint.domain} -This library is unwrapped and provides the following top-level modules. -For better context, see {!Goblint_lib} which also documents these modules. - - -{1 Domains} -{!modules: -Lattice -} - -{2 General} -{!modules: -BoolDomain -SetDomain -MapDomain -TrieDomain -DisjointDomain -HoareDomain -PartitionDomain -FlagHelper -} diff --git a/src/domain/dune b/src/domain/dune deleted file mode 100644 index 85e69a62462..00000000000 --- a/src/domain/dune +++ /dev/null @@ -1,20 +0,0 @@ -(include_subdirs no) - -(library - (name goblint_domain) - (public_name goblint.domain) - (wrapped false) ; TODO: wrap - (libraries - batteries.unthreaded - goblint_std - goblint_common - goblint-cil) - (flags :standard -open Goblint_std) - (preprocess - (pps - ppx_deriving.std - ppx_deriving_hash - ppx_deriving_yojson)) - (instrumentation (backend bisect_ppx))) - -(documentation) diff --git a/src/domains/access.ml b/src/domains/access.ml index baa9d34220a..8907ccbc322 100644 --- a/src/domains/access.ml +++ b/src/domains/access.ml @@ -438,15 +438,16 @@ struct end -(** Check if two accesses may race. *) +(* Check if two accesses may race and if yes with which confidence *) let may_race A.{kind; acc; _} A.{kind=kind2; acc=acc2; _} = - match kind, kind2 with - | Read, Read -> false (* two read/read accesses do not race *) - | Free, _ - | _, Free when not (get_bool "ana.race.free") -> false - | Call, _ - | _, Call when not (get_bool "ana.race.call") -> false - | _, _ -> MCPAccess.A.may_race acc acc2 (* analysis-specific information excludes race *) + if kind = Read && kind2 = Read then + false (* two read/read accesses do not race *) + else if not (get_bool "ana.race.free") && (kind = Free || kind2 = Free) then + false + else if not (MCPAccess.A.may_race acc acc2) then + false (* analysis-specific information excludes race *) + else + true (** Access sets for race detection and warnings. *) module WarnAccs = diff --git a/src/util/library/accessKind.ml b/src/domains/accessKind.ml similarity index 100% rename from src/util/library/accessKind.ml rename to src/domains/accessKind.ml diff --git a/src/domain/boolDomain.ml b/src/domains/boolDomain.ml similarity index 69% rename from src/domain/boolDomain.ml rename to src/domains/boolDomain.ml index d92d716d7ad..e088c3605c9 100644 --- a/src/domain/boolDomain.ml +++ b/src/domains/boolDomain.ml @@ -4,10 +4,10 @@ module Bool = struct include Basetype.RawBools (* type t = bool - let equal = Bool.equal - let compare = Bool.compare - let relift x = x - let arbitrary () = QCheck.bool *) + let equal = Bool.equal + let compare = Bool.compare + let relift x = x + let arbitrary () = QCheck.bool *) let pretty_diff () (x,y) = GoblintCil.Pretty.dprintf "%s: %a not leq %a" (name ()) pretty x pretty y end @@ -38,11 +38,4 @@ struct let widen = (&&) let meet = (||) let narrow = (||) -end - -module FlatBool: Lattice.S with type t = [`Bot | `Lifted of bool | `Top] = - Lattice.FlatConf (struct - include Printable.DefaultConf - let top_name = "?" - let bot_name = "-" - end) (Bool) +end \ No newline at end of file diff --git a/src/domain/disjointDomain.ml b/src/domains/disjointDomain.ml similarity index 100% rename from src/domain/disjointDomain.ml rename to src/domains/disjointDomain.ml diff --git a/src/domain/flagHelper.ml b/src/domains/flagHelper.ml similarity index 100% rename from src/domain/flagHelper.ml rename to src/domains/flagHelper.ml diff --git a/src/domain/hoareDomain.ml b/src/domains/hoareDomain.ml similarity index 97% rename from src/domain/hoareDomain.ml rename to src/domains/hoareDomain.ml index 37b8231b92e..23b1a922403 100644 --- a/src/domain/hoareDomain.ml +++ b/src/domains/hoareDomain.ml @@ -134,15 +134,13 @@ struct let equal x y = leq x y && leq y x let hash xs = fold (fun v a -> a + E.hash v) xs 0 let compare x y = - if equal x y then - 0 - else ( - let caridnality_comp = compare (cardinal x) (cardinal y) in - if caridnality_comp <> 0 then - caridnality_comp + if equal x y + then 0 else - Map.compare (List.compare E.compare) x y - ) + let caridnality_comp = compare (cardinal x) (cardinal y) in + if caridnality_comp <> 0 + then caridnality_comp + else Map.compare (List.compare E.compare) x y let show x : string = let all_elems : string list = List.map E.show (elements x) in Printable.get_short_list "{" "}" all_elems @@ -236,8 +234,8 @@ struct ) s2 nil with Not_found -> dprintf "choose failed b/c of empty set s1: %d s2: %d" - (cardinal s1) - (cardinal s2) + (cardinal s1) + (cardinal s2) end end @@ -341,8 +339,8 @@ struct ) s2 nil with Not_found -> dprintf "choose failed b/c of empty set s1: %d s2: %d" - (cardinal s1) - (cardinal s2) + (cardinal s1) + (cardinal s2) end end [@@deprecated] diff --git a/src/cdomain/value/domains/invariant.ml b/src/domains/invariant.ml similarity index 94% rename from src/cdomain/value/domains/invariant.ml rename to src/domains/invariant.ml index b281e8f7b3d..1a0c3c033c7 100644 --- a/src/cdomain/value/domains/invariant.ml +++ b/src/domains/invariant.ml @@ -28,12 +28,11 @@ end module N = struct - include Printable.DefaultConf let bot_name = "false" let top_name = "true" end -include Lattice.LiftConf (N) (ExpLat) +include Lattice.Lift (ExpLat) (N) let none = top () let of_exp = lift diff --git a/src/cdomain/value/domains/invariantCil.ml b/src/domains/invariantCil.ml similarity index 100% rename from src/cdomain/value/domains/invariantCil.ml rename to src/domains/invariantCil.ml diff --git a/src/domain/mapDomain.ml b/src/domains/mapDomain.ml similarity index 99% rename from src/domain/mapDomain.ml rename to src/domains/mapDomain.ml index 740da9969e1..76dec6f0d24 100644 --- a/src/domain/mapDomain.ml +++ b/src/domains/mapDomain.ml @@ -259,12 +259,11 @@ struct end (* TODO: this is very slow because every add/remove in a fold-loop relifts *) -(* TODO: currently hardcoded to assume_idempotent *) module HConsed (M: S) : S with type key = M.key and type value = M.value = struct - include Lattice.HConsed (M) (struct let assume_idempotent = false end) + include Lattice.HConsed (M) type key = M.key type value = M.value @@ -718,8 +717,8 @@ struct let singleton k v = `Lifted (M.singleton k v) let empty () = `Lifted (M.empty ()) let is_empty = function - | `Bot -> false - | `Lifted x -> M.is_empty x + | `Bot -> false + | `Lifted x -> M.is_empty x let exists f = function | `Bot -> raise (Fn_over_All "exists") | `Lifted x -> M.exists f x diff --git a/src/domain/partitionDomain.ml b/src/domains/partitionDomain.ml similarity index 100% rename from src/domain/partitionDomain.ml rename to src/domains/partitionDomain.ml diff --git a/src/domains/queries.ml b/src/domains/queries.ml index 9aae9a0cee3..c386ce36610 100644 --- a/src/domains/queries.ml +++ b/src/domains/queries.ml @@ -17,17 +17,22 @@ module TC = WrapperFunctionAnalysis0.ThreadCreateUniqueCount module ThreadNodeLattice = Lattice.Prod (NFL) (TC) module ML = LibraryDesc.MathLifted -module VI = Lattice.Flat (Basetype.Variables) +module VI = Lattice.Flat (Basetype.Variables) (struct + let top_name = "Unknown line" + let bot_name = "Unreachable line" + end) type iterprevvar = int -> (MyCFG.node * Obj.t * int) -> MyARG.inline_edge -> unit type itervar = int -> unit let compare_itervar _ _ = 0 let compare_iterprevvar _ _ = 0 -module FlatYojson = Lattice.Flat (Printable.Yojson) +module FlatYojson = Lattice.Flat (Printable.Yojson) (struct + let top_name = "top yojson" + let bot_name = "bot yojson" + end) -module SD: Lattice.S with type t = [`Bot | `Lifted of string | `Top] = - Lattice.Flat (Basetype.RawStrings) +module SD = Basetype.Strings module VD = ValueDomain.Compound module AD = ValueDomain.AD @@ -122,9 +127,6 @@ type _ t = | MayAccessed: AccessDomain.EventSet.t t | MayBeTainted: AD.t t | MayBeModifiedSinceSetjmp: JmpBufDomain.BufferEntry.t -> VS.t t - | MustTermLoop: stmt -> MustBool.t t - | MustTermAllLoops: MustBool.t t - | IsEverMultiThreaded: MayBool.t t | TmpSpecial: Mval.Exp.t -> ML.t t | MayBeOutOfBounds: varinfo * int * exp -> ID.t t | MayOverflow : exp -> MayBool.t t @@ -137,7 +139,7 @@ type 'a result = 'a Use [Analyses.ask_of_ctx] to convert [ctx] to [ask]. *) (* Must be in a singleton record due to second-order polymorphism. See https://ocaml.org/manual/polymorphism.html#s%3Ahigher-rank-poly. *) -type ask = { f: 'a. 'a t -> 'a result } [@@unboxed] +type ask = { f: 'a. 'a t -> 'a result } (* Result cannot implement Lattice.S because the function types are different due to GADT. *) module Result = @@ -194,9 +196,6 @@ struct | MayAccessed -> (module AccessDomain.EventSet) | MayBeTainted -> (module AD) | MayBeModifiedSinceSetjmp _ -> (module VS) - | MustTermLoop _ -> (module MustBool) - | MustTermAllLoops -> (module MustBool) - | IsEverMultiThreaded -> (module MayBool) | TmpSpecial _ -> (module ML) | MayBeOutOfBounds _ -> (module ID) | MayOverflow _ -> (module MayBool) @@ -265,9 +264,6 @@ struct | MayAccessed -> AccessDomain.EventSet.top () | MayBeTainted -> AD.top () | MayBeModifiedSinceSetjmp _ -> VS.top () - | MustTermLoop _ -> MustBool.top () - | MustTermAllLoops -> MustBool.top () - | IsEverMultiThreaded -> MayBool.top () | TmpSpecial _ -> ML.top () | MayBeOutOfBounds _ -> ID.top () | MayOverflow _ -> MayBool.top () @@ -276,7 +272,7 @@ end (* The type any_query can't be directly defined in Any as t, because it also refers to the t from the outer scope. *) -type any_query = Any: 'a t -> any_query [@@unboxed] +type any_query = Any: 'a t -> any_query module Any = struct @@ -332,14 +328,11 @@ struct | Any (EvalMutexAttr _ ) -> 50 | Any ThreadCreateIndexedNode -> 51 | Any ThreadsJoinedCleanly -> 52 - | Any (MustTermLoop _) -> 53 - | Any MustTermAllLoops -> 54 - | Any IsEverMultiThreaded -> 55 - | Any (TmpSpecial _) -> 56 - | Any (IsAllocVar _) -> 57 - | Any (MayBeOutOfBounds _) -> 58 - | Any (MayOverflow _) -> 59 - | Any (AllocMayBeOutOfBounds _) -> 60 + | Any (TmpSpecial _) -> 53 + | Any (IsAllocVar _) -> 54 + | Any (MayBeOutOfBounds _) -> 55 + | Any (MayOverflow _) -> 56 + | Any (AllocMayBeOutOfBounds _) -> 56 let rec compare a b = let r = Stdlib.compare (order a) (order b) in @@ -381,7 +374,6 @@ struct | Any (IsHeapVar v1), Any (IsHeapVar v2) -> CilType.Varinfo.compare v1 v2 | Any (IsAllocVar v1), Any (IsAllocVar v2) -> CilType.Varinfo.compare v1 v2 | Any (IsMultiple v1), Any (IsMultiple v2) -> CilType.Varinfo.compare v1 v2 - | Any (MustTermLoop s1), Any (MustTermLoop s2) -> CilType.Stmt.compare s1 s2 | Any (EvalThread e1), Any (EvalThread e2) -> CilType.Exp.compare e1 e2 | Any (EvalJumpBuf e1), Any (EvalJumpBuf e2) -> CilType.Exp.compare e1 e2 | Any (WarnGlobal vi1), Any (WarnGlobal vi2) -> Stdlib.compare (Hashtbl.hash vi1) (Hashtbl.hash vi2) @@ -441,7 +433,6 @@ struct | Any (IterVars i) -> 0 | Any (PathQuery (i, q)) -> 31 * i + hash (Any q) | Any (IsHeapVar v) -> CilType.Varinfo.hash v - | Any (MustTermLoop s) -> CilType.Stmt.hash s | Any (IsAllocVar v) -> CilType.Varinfo.hash v | Any (IsMultiple v) -> CilType.Varinfo.hash v | Any (EvalThread e) -> CilType.Exp.hash e @@ -516,9 +507,6 @@ struct | Any MayBeTainted -> Pretty.dprintf "MayBeTainted" | Any DYojson -> Pretty.dprintf "DYojson" | Any MayBeModifiedSinceSetjmp buf -> Pretty.dprintf "MayBeModifiedSinceSetjmp %a" JmpBufDomain.BufferEntry.pretty buf - | Any (MustTermLoop s) -> Pretty.dprintf "MustTermLoop %a" CilType.Stmt.pretty s - | Any MustTermAllLoops -> Pretty.dprintf "MustTermAllLoops" - | Any IsEverMultiThreaded -> Pretty.dprintf "IsEverMultiThreaded" | Any (TmpSpecial lv) -> Pretty.dprintf "TmpSpecial %a" Mval.Exp.pretty lv | Any (MayBeOutOfBounds (v,s, e)) -> Pretty.dprintf "MayBeOutOfBounds (%a, %a)" CilType.Varinfo.pretty v CilType.Exp.pretty e | Any (MayOverflow e) -> Pretty.dprintf "MayOverflow %a" CilType.Exp.pretty e diff --git a/src/domain/setDomain.ml b/src/domains/setDomain.ml similarity index 100% rename from src/domain/setDomain.ml rename to src/domains/setDomain.ml diff --git a/src/domain/trieDomain.ml b/src/domains/trieDomain.ml similarity index 100% rename from src/domain/trieDomain.ml rename to src/domains/trieDomain.ml diff --git a/src/cdomain/value/domains/valueDomainQueries.ml b/src/domains/valueDomainQueries.ml similarity index 97% rename from src/cdomain/value/domains/valueDomainQueries.ml rename to src/domains/valueDomainQueries.ml index 3060e75e5e2..6d00d08ec88 100644 --- a/src/cdomain/value/domains/valueDomainQueries.ml +++ b/src/domains/valueDomainQueries.ml @@ -9,7 +9,7 @@ module AD = PreValueDomain.AD module ID = struct module I = IntDomain.IntDomTuple - include Lattice.Lift (I) + include Lattice.Lift (I) (Printable.DefaultNames) let lift op x = `Lifted (op x) let unlift op x = match x with diff --git a/src/dune b/src/dune index d7c6d280261..acd5348acbf 100644 --- a/src/dune +++ b/src/dune @@ -6,15 +6,11 @@ (library (name goblint_lib) (public_name goblint.lib) - (modules :standard \ goblint privPrecCompare apronPrecCompare messagesCompare) - (libraries goblint.sites goblint.build-info goblint-cil.all-features batteries.unthreaded qcheck-core.runner sha json-data-encoding jsonrpc cpu arg-complete fpath yaml yaml.unix uuidm goblint_timing catapult goblint_backtrace fileutils goblint_std goblint_config goblint_common goblint_domain goblint_constraint goblint_solver goblint_library goblint_cdomain_value goblint_incremental goblint_tracing + (modules :standard \ goblint mainspec privPrecCompare apronPrecCompare messagesCompare) + (libraries goblint.sites goblint.build-info goblint-cil.all-features batteries.unthreaded qcheck-core.runner sha json-data-encoding jsonrpc cpu arg-complete fpath yaml yaml.unix uuidm goblint_timing catapult goblint_backtrace fileutils goblint_std goblint_common ; Conditionally compile based on whether apron optional dependency is installed or not. ; Alternative dependencies seem like the only way to optionally depend on optional dependencies. ; See: https://dune.readthedocs.io/en/stable/concepts.html#alternative-dependencies. - (select gobApron.ml from - (apron -> gobApron.apron.ml) - (-> gobApron.no-apron.ml) - ) (select apronDomain.ml from (apron apron.octD apron.boxD apron.polkaMPQ zarith_mlgmpidl -> apronDomain.apron.ml) (-> apronDomain.no-apron.ml) @@ -61,6 +57,7 @@ ) ) (flags :standard -open Goblint_std) + (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)) @@ -76,10 +73,10 @@ (copy_files# witness/z3/*.ml) (executables - (names goblint) - (public_names goblint) + (names goblint mainspec) + (public_names goblint -) (modes byte native) ; https://dune.readthedocs.io/en/stable/dune-files.html#linking-modes - (modules goblint) + (modules goblint mainspec) (libraries goblint.lib goblint.sites.dune goblint.build-info.dune goblint_std) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall -open Goblint_std) diff --git a/src/framework/analyses.ml b/src/framework/analyses.ml index 61f43cb1a5a..bb2170509de 100644 --- a/src/framework/analyses.ml +++ b/src/framework/analyses.ml @@ -11,6 +11,24 @@ module M = Messages * other functions. *) type fundecs = fundec list * fundec list * fundec list +module type SysVar = +sig + type t + val is_write_only: t -> bool +end + +module type VarType = +sig + include Hashtbl.HashedType + include SysVar with type t := t + val pretty_trace: unit -> t -> doc + val compare : t -> t -> int + + val printXml : 'a BatInnerIO.output -> t -> unit + val var_id : t -> string + val node : t -> MyCFG.node + val relift : t -> t (* needed only for incremental+hashcons to re-hashcons contexts after loading *) +end module Var = struct @@ -51,12 +69,12 @@ end module type SpecSysVar = sig include Printable.S - include ConstrSys.SysVar with type t := t + include SysVar with type t := t end module GVarF (V: SpecSysVar) = struct - include Printable.EitherConf (struct let expand1 = false let expand2 = true end) (V) (CilType.Fundec) + include Printable.Either (V) (CilType.Fundec) let name () = "FromSpec" let spec x = `Left x let contexts x = `Right x @@ -70,22 +88,6 @@ struct | `Right _ -> true end -module GVarFC (V:SpecSysVar) (C:Printable.S) = -struct - include Printable.EitherConf (struct let expand1 = false let expand2 = true end) (V) (Printable.Prod (CilType.Fundec) (C)) - let name () = "FromSpec" - let spec x = `Left x - let call (x, c) = `Right (x, c) - - (* from Basetype.Variables *) - let var_id = show - let node _ = MyCFG.Function Cil.dummyFunDec - let pretty_trace = pretty - let is_write_only = function - | `Left x -> V.is_write_only x - | `Right _ -> true -end - module GVarG (G: Lattice.S) (C: Printable.S) = struct module CSet = @@ -99,7 +101,7 @@ struct let name () = "contexts" end - include Lattice.Lift2 (G) (CSet) + include Lattice.Lift2 (G) (CSet) (Printable.DefaultNames) let spec = function | `Bot -> G.bot () @@ -124,11 +126,10 @@ exception Deadcode (** [Dom (D)] produces D lifted where bottom means dead-code *) module Dom (LD: Lattice.S) = struct - include Lattice.LiftConf (struct - include Printable.DefaultConf + include Lattice.Lift (LD) (struct let bot_name = "Dead code" let top_name = "Totally unknown and messed up" - end) (LD) + end) let lift (x:LD.t) : t = `Lifted x @@ -138,12 +139,189 @@ struct | _ -> raise Deadcode let printXml f = function - | `Top -> BatPrintf.fprintf f "%s" (XmlUtil.escape Printable.DefaultConf.top_name) + | `Top -> BatPrintf.fprintf f "%s" (XmlUtil.escape top_name) | `Bot -> () | `Lifted x -> LD.printXml f x end +module ResultNode: Printable.S with type t = MyCFG.node = +struct + include Printable.Std + + include Node + + let name () = "resultnode" + + let show a = + (* Not using Node.location here to have updated locations in incremental analysis. + See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) + let x = UpdateCil.getLoc a in + let f = Node.find_fundec a in + CilType.Location.show x ^ "(" ^ f.svar.vname ^ ")" + + include Printable.SimpleShow ( + struct + type nonrec t = t + let show = show + end + ) +end + +module type ResultConf = +sig + val result_name: string +end + +module Result (Range: Printable.S) (C: ResultConf) = +struct + include Hashtbl.Make (ResultNode) + type nonrec t = Range.t t (* specialize polymorphic type for Range values *) + + let pretty () mapping = + let f key st dok = + dok ++ dprintf "%a ->@? @[%a@]\n" ResultNode.pretty key Range.pretty st + in + let content () = fold f mapping nil in + let defline () = dprintf "OTHERS -> Not available\n" in + dprintf "@[Mapping {\n @[%t%t@]}@]" content defline + + include C + + let printXml f xs = + let print_one n v = + (* Not using Node.location here to have updated locations in incremental analysis. + See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) + let loc = UpdateCil.getLoc n in + BatPrintf.fprintf f "\n" (Node.show_id n) loc.file loc.line loc.byte loc.column; + BatPrintf.fprintf f "%a\n" Range.printXml v + in + iter print_one xs + + let printJson f xs = + let print_one n v = + (* Not using Node.location here to have updated locations in incremental analysis. + See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) + let loc = UpdateCil.getLoc n in + BatPrintf.fprintf f "{\n\"id\": \"%s\", \"file\": \"%s\", \"line\": \"%d\", \"byte\": \"%d\", \"column\": \"%d\", \"states\": %s\n},\n" (Node.show_id n) loc.file loc.line loc.byte loc.column (Yojson.Safe.to_string (Range.to_yojson v)) + in + iter print_one xs + + let printXmlWarning f () = + let one_text f Messages.Piece.{loc; text = m; _} = + match loc with + | Some loc -> + let l = Messages.Location.to_cil loc in + BatPrintf.fprintf f "\n%s" l.file l.line l.column (XmlUtil.escape m) + | None -> + () (* TODO: not outputting warning without location *) + in + let one_w f (m: Messages.Message.t) = match m.multipiece with + | Single piece -> one_text f piece + | Group {group_text = n; pieces = e; group_loc} -> + let group_loc_text = match group_loc with + | None -> "" + | Some group_loc -> GobPretty.sprintf " (%a)" CilType.Location.pretty (Messages.Location.to_cil group_loc) + in + BatPrintf.fprintf f "%a\n" n group_loc_text (BatList.print ~first:"" ~last:"" ~sep:"" one_text) e + in + let one_w f x = BatPrintf.fprintf f "\n%a" one_w x in + List.iter (one_w f) !Messages.Table.messages_list + + let output table gtable gtfxml (file: file) = + let out = Messages.get_out result_name !Messages.out in + match get_string "result" with + | "pretty" -> ignore (fprintf out "%a\n" pretty (Lazy.force table)) + | "fast_xml" -> + let module SH = BatHashtbl.Make (Basetype.RawStrings) in + let file2funs = SH.create 100 in + let funs2node = SH.create 100 in + iter (fun n _ -> SH.add funs2node (Node.find_fundec n).svar.vname n) (Lazy.force table); + iterGlobals file (function + | GFun (fd,loc) -> SH.add file2funs loc.file fd.svar.vname + | _ -> () + ); + let p_node f n = BatPrintf.fprintf f "%s" (Node.show_id n) in + let p_nodes f xs = + List.iter (BatPrintf.fprintf f "\n" p_node) xs + in + let p_funs f xs = + let one_fun n = + BatPrintf.fprintf f "\n%a\n" n p_nodes (SH.find_all funs2node n) + in + List.iter one_fun xs + in + let write_file f fn = + Messages.xml_file_name := fn; + BatPrintf.printf "Writing xml to temp. file: %s\n%!" fn; + BatPrintf.fprintf f ""; + BatPrintf.fprintf f "%s" GobSys.command_line; + BatPrintf.fprintf f ""; + let timing_ppf = BatFormat.formatter_of_out_channel f in + Timing.Default.print timing_ppf; + Format.pp_print_flush timing_ppf (); + BatPrintf.fprintf f ""; + BatPrintf.fprintf f "\n"; + BatEnum.iter (fun b -> BatPrintf.fprintf f "\n%a\n" (Filename.basename b) b p_funs (SH.find_all file2funs b)) (BatEnum.uniq @@ SH.keys file2funs); + BatPrintf.fprintf f "%a" printXml (Lazy.force table); + gtfxml f gtable; + printXmlWarning f (); + BatPrintf.fprintf f "\n"; + BatPrintf.fprintf f "%!" + in + if get_bool "g2html" then + BatFile.with_temporary_out ~mode:[`create;`text;`delete_on_exit] write_file + else + let f = BatIO.output_channel out in + write_file f (get_string "outfile") + | "json" -> + let open BatPrintf in + let module SH = BatHashtbl.Make (Basetype.RawStrings) in + let file2funs = SH.create 100 in + let funs2node = SH.create 100 in + iter (fun n _ -> SH.add funs2node (Node.find_fundec n).svar.vname n) (Lazy.force table); + iterGlobals file (function + | GFun (fd,loc) -> SH.add file2funs loc.file fd.svar.vname + | _ -> () + ); + let p_enum p f xs = BatEnum.print ~first:"[\n " ~last:"\n]" ~sep:",\n " p f xs in + let p_list p f xs = BatList.print ~first:"[\n " ~last:"\n]" ~sep:",\n " p f xs in + (*let p_kv f (k,p,v) = fprintf f "\"%s\": %a" k p v in*) + (*let p_obj f xs = BatList.print ~first:"{\n " ~last:"\n}" ~sep:",\n " p_kv xs in*) + let p_node f n = BatPrintf.fprintf f "\"%s\"" (Node.show_id n) in + let p_fun f x = fprintf f "{\n \"name\": \"%s\",\n \"nodes\": %a\n}" x (p_list p_node) (SH.find_all funs2node x) in + (*let p_fun f x = p_obj f [ "name", BatString.print, x; "nodes", p_list p_node, SH.find_all funs2node x ] in*) + let p_file f x = fprintf f "{\n \"name\": \"%s\",\n \"path\": \"%s\",\n \"functions\": %a\n}" (Filename.basename x) x (p_list p_fun) (SH.find_all file2funs x) in + let write_file f fn = + printf "Writing json to temp. file: %s\n%!" fn; + fprintf f "{\n \"parameters\": \"%s\",\n " GobSys.command_line; + fprintf f "\"files\": %a,\n " (p_enum p_file) (SH.keys file2funs); + fprintf f "\"results\": [\n %a\n]\n" printJson (Lazy.force table); + (*gtfxml f gtable;*) + (*printXmlWarning f ();*) + fprintf f "}\n"; + in + if get_bool "g2html" then + BatFile.with_temporary_out ~mode:[`create;`text;`delete_on_exit] write_file + else + let f = BatIO.output_channel out in + write_file f (get_string "outfile") + | "sarif" -> + let open BatPrintf in + printf "Writing Sarif to file: %s\n%!" (get_string "outfile"); + Yojson.Safe.to_channel ~std:true out (Sarif.to_yojson (List.rev !Messages.Table.messages_list)); + | "json-messages" -> + let json = `Assoc [ + ("files", Preprocessor.dependencies_to_yojson ()); + ("messages", Messages.Table.to_yojson ()); + ] + in + Yojson.Safe.to_channel ~std:true out json + | "none" -> () + | s -> failwith @@ "Unsupported value for option `result`: "^s +end + + (* Experiment to reduce the number of arguments on transfer functions and allow sub-analyses. The list sub contains the current local states of analyses in the same order as written in the dependencies list (in MCP). @@ -164,7 +342,7 @@ type ('d,'g,'c,'v) ctx = ; edge : MyCFG.edge ; local : 'd ; global : 'v -> 'g - ; spawn : ?multiple:bool -> lval option -> varinfo -> exp list -> unit + ; spawn : lval option -> varinfo -> exp list -> unit ; split : 'd -> Events.t list -> unit ; sideg : 'v -> 'g -> unit } @@ -175,7 +353,7 @@ exception Ctx_failure of string let ctx_failwith s = raise (Ctx_failure s) (* TODO: use everywhere in ctx *) (** Convert [ctx] to [Queries.ask]. *) -let ask_of_ctx ctx: Queries.ask = { Queries.f = ctx.ask } +let ask_of_ctx ctx: Queries.ask = { Queries.f = fun (type a) (q: a Queries.t) -> ctx.ask q } module type Spec = @@ -266,10 +444,10 @@ sig val paths_as_set : (D.t, G.t, C.t, V.t) ctx -> D.t list (** Returns initial state for created thread. *) - val threadenter : (D.t, G.t, C.t, V.t) ctx -> multiple:bool -> lval option -> varinfo -> exp list -> D.t list + val threadenter : (D.t, G.t, C.t, V.t) ctx -> lval option -> varinfo -> exp list -> D.t list (** Updates the local state of the creator thread using initial state of created thread. *) - val threadspawn : (D.t, G.t, C.t, V.t) ctx -> multiple:bool -> lval option -> varinfo -> exp list -> (D.t, G.t, C.t, V.t) ctx -> D.t + val threadspawn : (D.t, G.t, C.t, V.t) ctx -> lval option -> varinfo -> exp list -> (D.t, G.t, C.t, V.t) ctx -> D.t val event : (D.t, G.t, C.t, V.t) ctx -> Events.t -> (D.t, G.t, C.t, V.t) ctx -> D.t end @@ -300,15 +478,122 @@ type increment_data = { restarting: VarQuery.t list; } -module StdV = +(** Abstract incremental change to constraint system. + @param 'v constrain system variable type *) +type 'v sys_change_info = { + obsolete: 'v list; (** Variables to destabilize. *) + delete: 'v list; (** Variables to delete. *) + reluctant: 'v list; (** Variables to solve reluctantly. *) + restart: 'v list; (** Variables to restart. *) +} + +(** A side-effecting system. *) +module type MonSystem = +sig + type v (* variables *) + type d (* values *) + type 'a m (* basically a monad carrier *) + + (** Variables must be hashable, comparable, etc. *) + module Var : VarType with type t = v + + (** Values must form a lattice. *) + module Dom : Lattice.S with type t = d + + (** The system in functional form. *) + val system : v -> ((v -> d) -> (v -> d -> unit) -> d) m + + val sys_change: (v -> d) -> v sys_change_info + (** Compute incremental constraint system change from old solution. *) +end + +(** Any system of side-effecting equations over lattices. *) +module type EqConstrSys = MonSystem with type 'a m := 'a option + +(** A side-effecting system with globals. *) +module type GlobConstrSys = +sig + module LVar : VarType + module GVar : VarType + + module D : Lattice.S + module G : Lattice.S + val system : LVar.t -> ((LVar.t -> D.t) -> (LVar.t -> D.t -> unit) -> (GVar.t -> G.t) -> (GVar.t -> G.t -> unit) -> D.t) option + val iter_vars: (LVar.t -> D.t) -> (GVar.t -> G.t) -> VarQuery.t -> LVar.t VarQuery.f -> GVar.t VarQuery.f -> unit + val sys_change: (LVar.t -> D.t) -> (GVar.t -> G.t) -> [`L of LVar.t | `G of GVar.t] sys_change_info +end + +(** A solver is something that can translate a system into a solution (hash-table). + Incremental solver has data to be marshaled. *) +module type GenericEqIncrSolverBase = + functor (S:EqConstrSys) -> + functor (H:Hashtbl.S with type key=S.v) -> + sig + type marshal + + val copy_marshal: marshal -> marshal + val relift_marshal: marshal -> marshal + + (** The hash-map that is the first component of [solve xs vs] is a local solution for interesting variables [vs], + reached from starting values [xs]. + As a second component the solver returns data structures for incremental serialization. *) + val solve : (S.v*S.d) list -> S.v list -> marshal option -> S.d H.t * marshal + end + +(** (Incremental) solver argument, indicating which postsolving should be performed by the solver. *) +module type IncrSolverArg = +sig + val should_prune: bool + val should_verify: bool + val should_warn: bool + val should_save_run: bool +end + +(** An incremental solver takes the argument about postsolving. *) +module type GenericEqIncrSolver = + functor (Arg: IncrSolverArg) -> + GenericEqIncrSolverBase + +(** A solver is something that can translate a system into a solution (hash-table) *) +module type GenericEqSolver = + functor (S:EqConstrSys) -> + functor (H:Hashtbl.S with type key=S.v) -> + sig + (** The hash-map that is the first component of [solve xs vs] is a local solution for interesting variables [vs], + reached from starting values [xs]. *) + val solve : (S.v*S.d) list -> S.v list -> S.d H.t + end + +(** A solver is something that can translate a system into a solution (hash-table) *) +module type GenericGlobSolver = + functor (S:GlobConstrSys) -> + functor (LH:Hashtbl.S with type key=S.LVar.t) -> + functor (GH:Hashtbl.S with type key=S.GVar.t) -> + sig + type marshal + + val copy_marshal: marshal -> marshal + val relift_marshal: marshal -> marshal + + (** The hash-map that is the first component of [solve xs vs] is a local solution for interesting variables [vs], + reached from starting values [xs]. + As a second component the solver returns data structures for incremental serialization. *) + val solve : (S.LVar.t*S.D.t) list -> (S.GVar.t*S.G.t) list -> S.LVar.t list -> marshal option -> (S.D.t LH.t * S.G.t GH.t) * marshal + end + +module ResultType2 (S:Spec) = struct - let is_write_only _ = false + open S + include Printable.Prod3 (C) (D) (CilType.Fundec) + let show (es,x,f:t) = D.show x + let pretty () (_,x,_) = D.pretty () x + let printXml f (c,d,fd) = + BatPrintf.fprintf f "\n%a\n%a" C.printXml c D.printXml d end -module UnitV = +module StdV = struct - include Printable.Unit - include StdV + let is_write_only _ = false end module VarinfoV = @@ -412,15 +697,15 @@ struct let special ctx (lval: lval option) (f:varinfo) (arglist:exp list) = ctx.local - let threadenter ctx ~multiple lval f args = [ctx.local] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [ctx.local] + let threadspawn ctx lval f args fctx = ctx.local end module type SpecSys = sig module Spec: Spec - module EQSys: ConstrSys.GlobConstrSys with module LVar = VarF (Spec.C) + module EQSys: GlobConstrSys with module LVar = VarF (Spec.C) and module GVar = GVarF (Spec.V) and module D = Spec.D and module G = GVarG (Spec.G) (Spec.C) diff --git a/src/framework/analysisResult.ml b/src/framework/analysisResult.ml deleted file mode 100644 index 09ece868c1d..00000000000 --- a/src/framework/analysisResult.ml +++ /dev/null @@ -1,191 +0,0 @@ -(** Analysis result output. *) - -open GoblintCil -open Pretty -open GobConfig - -module ResultNode: Printable.S with type t = MyCFG.node = -struct - include Printable.Std - - include Node - - let name () = "resultnode" - - let show a = - (* Not using Node.location here to have updated locations in incremental analysis. - See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) - let x = UpdateCil.getLoc a in - let f = Node.find_fundec a in - CilType.Location.show x ^ "(" ^ f.svar.vname ^ ")" - - include Printable.SimpleShow ( - struct - type nonrec t = t - let show = show - end - ) -end - -module type ResultConf = -sig - val result_name: string -end - -module Result (Range: Printable.S) (C: ResultConf) = -struct - include BatHashtbl.Make (ResultNode) - type nonrec t = Range.t t (* specialize polymorphic type for Range values *) - - let pretty () mapping = - let f key st dok = - dok ++ dprintf "%a ->@? @[%a@]\n" ResultNode.pretty key Range.pretty st - in - let content () = fold f mapping nil in - let defline () = dprintf "OTHERS -> Not available\n" in - dprintf "@[Mapping {\n @[%t%t@]}@]" content defline - - include C - - let printXml f xs = - let print_one n v = - (* Not using Node.location here to have updated locations in incremental analysis. - See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) - let loc = UpdateCil.getLoc n in - BatPrintf.fprintf f "\n" (Node.show_id n) loc.file loc.line loc.byte loc.column; - BatPrintf.fprintf f "%a\n" Range.printXml v - in - iter print_one xs - - let printJson f xs = - let print_one n v = - (* Not using Node.location here to have updated locations in incremental analysis. - See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) - let loc = UpdateCil.getLoc n in - BatPrintf.fprintf f "{\n\"id\": \"%s\", \"file\": \"%s\", \"line\": \"%d\", \"byte\": \"%d\", \"column\": \"%d\", \"states\": %s\n},\n" (Node.show_id n) loc.file loc.line loc.byte loc.column (Yojson.Safe.to_string (Range.to_yojson v)) - in - iter print_one xs - - let printXmlWarning f () = - let one_text f Messages.Piece.{loc; text = m; _} = - match loc with - | Some loc -> - let l = Messages.Location.to_cil loc in - BatPrintf.fprintf f "\n%s" l.file l.line l.column (XmlUtil.escape m) - | None -> - () (* TODO: not outputting warning without location *) - in - let one_w f (m: Messages.Message.t) = match m.multipiece with - | Single piece -> one_text f piece - | Group {group_text = n; pieces = e; group_loc} -> - let group_loc_text = match group_loc with - | None -> "" - | Some group_loc -> GobPretty.sprintf " (%a)" CilType.Location.pretty (Messages.Location.to_cil group_loc) - in - BatPrintf.fprintf f "%a\n" n group_loc_text (BatList.print ~first:"" ~last:"" ~sep:"" one_text) e - in - let one_w f x = BatPrintf.fprintf f "\n%a" one_w x in - List.iter (one_w f) !Messages.Table.messages_list - - let output table gtable gtfxml (file: file) = - let out = Messages.get_out result_name !Messages.out in - match get_string "result" with - | "pretty" -> ignore (fprintf out "%a\n" pretty (Lazy.force table)) - | "fast_xml" -> - let module SH = BatHashtbl.Make (Basetype.RawStrings) in - let file2funs = SH.create 100 in - let funs2node = SH.create 100 in - iter (fun n _ -> SH.add funs2node (Node.find_fundec n).svar.vname n) (Lazy.force table); - iterGlobals file (function - | GFun (fd,loc) -> SH.add file2funs loc.file fd.svar.vname - | _ -> () - ); - let p_node f n = BatPrintf.fprintf f "%s" (Node.show_id n) in - let p_nodes f xs = - List.iter (BatPrintf.fprintf f "\n" p_node) xs - in - let p_funs f xs = - let one_fun n = - BatPrintf.fprintf f "\n%a\n" n p_nodes (SH.find_all funs2node n) - in - List.iter one_fun xs - in - let write_file f fn = - Messages.xml_file_name := fn; - BatPrintf.printf "Writing xml to temp. file: %s\n%!" fn; - BatPrintf.fprintf f ""; - BatPrintf.fprintf f "%s" GobSys.command_line; - BatPrintf.fprintf f ""; - let timing_ppf = BatFormat.formatter_of_out_channel f in - Timing.Default.print timing_ppf; - Format.pp_print_flush timing_ppf (); - BatPrintf.fprintf f ""; - BatPrintf.fprintf f "\n"; - BatEnum.iter (fun b -> BatPrintf.fprintf f "\n%a\n" (Filename.basename b) b p_funs (SH.find_all file2funs b)) (BatEnum.uniq @@ SH.keys file2funs); - BatPrintf.fprintf f "%a" printXml (Lazy.force table); - gtfxml f gtable; - printXmlWarning f (); - BatPrintf.fprintf f "\n"; - BatPrintf.fprintf f "%!" - in - if get_bool "g2html" then - BatFile.with_temporary_out ~mode:[`create;`text;`delete_on_exit] write_file - else - let f = BatIO.output_channel out in - write_file f (get_string "outfile") - | "json" -> - let open BatPrintf in - let module SH = BatHashtbl.Make (Basetype.RawStrings) in - let file2funs = SH.create 100 in - let funs2node = SH.create 100 in - iter (fun n _ -> SH.add funs2node (Node.find_fundec n).svar.vname n) (Lazy.force table); - iterGlobals file (function - | GFun (fd,loc) -> SH.add file2funs loc.file fd.svar.vname - | _ -> () - ); - let p_enum p f xs = BatEnum.print ~first:"[\n " ~last:"\n]" ~sep:",\n " p f xs in - let p_list p f xs = BatList.print ~first:"[\n " ~last:"\n]" ~sep:",\n " p f xs in - (*let p_kv f (k,p,v) = fprintf f "\"%s\": %a" k p v in*) - (*let p_obj f xs = BatList.print ~first:"{\n " ~last:"\n}" ~sep:",\n " p_kv xs in*) - let p_node f n = BatPrintf.fprintf f "\"%s\"" (Node.show_id n) in - let p_fun f x = fprintf f "{\n \"name\": \"%s\",\n \"nodes\": %a\n}" x (p_list p_node) (SH.find_all funs2node x) in - (*let p_fun f x = p_obj f [ "name", BatString.print, x; "nodes", p_list p_node, SH.find_all funs2node x ] in*) - let p_file f x = fprintf f "{\n \"name\": \"%s\",\n \"path\": \"%s\",\n \"functions\": %a\n}" (Filename.basename x) x (p_list p_fun) (SH.find_all file2funs x) in - let write_file f fn = - printf "Writing json to temp. file: %s\n%!" fn; - fprintf f "{\n \"parameters\": \"%s\",\n " GobSys.command_line; - fprintf f "\"files\": %a,\n " (p_enum p_file) (SH.keys file2funs); - fprintf f "\"results\": [\n %a\n]\n" printJson (Lazy.force table); - (*gtfxml f gtable;*) - (*printXmlWarning f ();*) - fprintf f "}\n"; - in - if get_bool "g2html" then - BatFile.with_temporary_out ~mode:[`create;`text;`delete_on_exit] write_file - else - let f = BatIO.output_channel out in - write_file f (get_string "outfile") - | "sarif" -> - let open BatPrintf in - printf "Writing Sarif to file: %s\n%!" (get_string "outfile"); - Yojson.Safe.to_channel ~std:true out (Sarif.to_yojson (List.rev !Messages.Table.messages_list)); - | "json-messages" -> - let json = `Assoc [ - ("files", Preprocessor.dependencies_to_yojson ()); - ("messages", Messages.Table.to_yojson ()); - ] - in - Yojson.Safe.to_channel ~std:true out json - | "none" -> () - | s -> failwith @@ "Unsupported value for option `result`: "^s -end - -module ResultType2 (S: Analyses.Spec) = -struct - open S - include Printable.Prod3 (C) (D) (CilType.Fundec) - let show (es,x,f:t) = D.show x - let pretty () (_,x,_) = D.pretty () x - let printXml f (c,d,fd) = - BatPrintf.fprintf f "\n%a\n%a" C.printXml c D.printXml d -end diff --git a/src/common/framework/cfgTools.ml b/src/framework/cfgTools.ml similarity index 98% rename from src/common/framework/cfgTools.ml rename to src/framework/cfgTools.ml index 78aba170604..8f98a48e840 100644 --- a/src/common/framework/cfgTools.ml +++ b/src/framework/cfgTools.ml @@ -122,6 +122,10 @@ let rec pretty_edges () = function | [_,x] -> Edge.pretty_plain () x | (_,x)::xs -> Pretty.dprintf "%a; %a" Edge.pretty_plain x pretty_edges xs +let get_pseudo_return_id fd = + let start_id = 10_000_000_000 in (* TODO get max_sid? *) + let sid = Hashtbl.hash fd.svar.vid in (* Need pure sid instead of Cil.new_sid for incremental, similar to vid in Cilfacade.create_var. We only add one return stmt per loop, so the hash from the functions vid should be unique. *) + if sid < start_id then sid + start_id else sid let node_scc_global = NH.create 113 @@ -256,7 +260,7 @@ let createCFG (file: file) = if Messages.tracing then Messages.trace "cfg" "adding pseudo-return to the function %s.\n" fd.svar.vname; let fd_end_loc = {fd_loc with line = fd_loc.endLine; byte = fd_loc.endByte; column = fd_loc.endColumn} in let newst = mkStmt (Return (None, fd_end_loc)) in - newst.sid <- Cilfacade.get_pseudo_return_id fd; + newst.sid <- get_pseudo_return_id fd; Cilfacade.StmtH.add Cilfacade.pseudo_return_to_fun newst fd; Cilfacade.IntH.replace Cilfacade.pseudo_return_stmt_sids newst.sid newst; let newst_node = Statement newst in @@ -471,7 +475,7 @@ let createCFG (file: file) = ); if Messages.tracing then Messages.trace "cfg" "CFG building finished.\n\n"; if get_bool "dbg.verbose" then - ignore (Pretty.eprintf "cfgF (%a), cfgB (%a)\n" GobHashtbl.pretty_statistics (NH.stats cfgF) GobHashtbl.pretty_statistics (NH.stats cfgB)); + ignore (Pretty.eprintf "cfgF (%a), cfgB (%a)\n" GobHashtbl.pretty_statistics (GobHashtbl.magic_stats cfgF) GobHashtbl.pretty_statistics (GobHashtbl.magic_stats cfgB)); cfgF, cfgB, skippedByEdge let createCFG = Timing.wrap "createCFG" createCFG @@ -681,7 +685,7 @@ let getGlobalInits (file: file) : edges = lval in let rec any_index_offset = function - | Index (e,o) -> Index (Cilfacade.any_index_exp, any_index_offset o) + | Index (e,o) -> Index (Offset.Index.Exp.any, any_index_offset o) | Field (f,o) -> Field (f, any_index_offset o) | NoOffset -> NoOffset in diff --git a/src/framework/constraints.ml b/src/framework/constraints.ml index f5c024c24fe..95a13ed5169 100644 --- a/src/framework/constraints.ml +++ b/src/framework/constraints.ml @@ -5,7 +5,6 @@ open Batteries open GoblintCil open MyCFG open Analyses -open ConstrSys open GobConfig module M = Messages @@ -13,17 +12,12 @@ module M = Messages (** Lifts a [Spec] so that the domain is [Hashcons]d *) module HashconsLifter (S:Spec) - : Spec with module G = S.G + : Spec with module D = Lattice.HConsed (S.D) + and module G = S.G and module C = S.C = struct - module HConsedArg = - struct - (* We do refine int values on narrow and meet {!IntDomain.IntDomTupleImpl}, which can lead to fixpoint issues if we assume x op x = x *) - (* see https://github.com/goblint/analyzer/issues/1005 *) - let assume_idempotent = GobConfig.get_string "ana.int.refinement" = "never" - end - module D = Lattice.HConsed (S.D) (HConsedArg) + module D = Lattice.HConsed (S.D) module G = S.G module C = S.C module V = S.V @@ -89,11 +83,11 @@ struct let combine_assign ctx r fe f args fc es f_ask = D.lift @@ S.combine_assign (conv ctx) r fe f args fc (D.unlift es) f_ask - let threadenter ctx ~multiple lval f args = - List.map D.lift @@ S.threadenter (conv ctx) ~multiple lval f args + let threadenter ctx lval f args = + List.map D.lift @@ S.threadenter (conv ctx) lval f args - let threadspawn ctx ~multiple lval f args fctx = - D.lift @@ S.threadspawn (conv ctx) ~multiple lval f args (conv fctx) + let threadspawn ctx lval f args fctx = + D.lift @@ S.threadspawn (conv ctx) lval f args (conv fctx) let paths_as_set ctx = List.map (fun x -> D.lift x) @@ S.paths_as_set (conv ctx) @@ -173,11 +167,11 @@ struct let combine_assign ctx r fe f args fc es f_ask = S.combine_assign (conv ctx) r fe f args (Option.map C.unlift fc) es f_ask - let threadenter ctx ~multiple lval f args = - S.threadenter (conv ctx) ~multiple lval f args + let threadenter ctx lval f args = + S.threadenter (conv ctx) lval f args - let threadspawn ctx ~multiple lval f args fctx = - S.threadspawn (conv ctx) ~multiple lval f args (conv fctx) + let threadspawn ctx lval f args fctx = + S.threadspawn (conv ctx) lval f args (conv fctx) let paths_as_set ctx = S.paths_as_set (conv ctx) let event ctx e octx = S.event (conv ctx) e (conv octx) @@ -255,8 +249,8 @@ struct let combine_env' ctx r fe f args fc es f_ask = lift_fun ctx (lift ctx) S.combine_env (fun p -> p r fe f args fc (fst es) f_ask) let combine_assign' ctx r fe f args fc es f_ask = lift_fun ctx (lift ctx) S.combine_assign (fun p -> p r fe f args fc (fst es) f_ask) - let threadenter ctx ~multiple lval f args = lift_fun ctx (List.map lift_start_level) (S.threadenter ~multiple) ((|>) args % (|>) f % (|>) lval) - let threadspawn ctx ~multiple lval f args fctx = lift_fun ctx (lift ctx) (S.threadspawn ~multiple) ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) + let threadenter ctx lval f args = lift_fun ctx (List.map lift_start_level) S.threadenter ((|>) args % (|>) f % (|>) lval) + let threadspawn ctx lval f args fctx = lift_fun ctx (lift ctx) S.threadspawn ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) let leq0 = function | `Top -> false @@ -400,8 +394,8 @@ struct let event ctx e octx = lift_fun ctx S.event ((|>) (conv octx) % (|>) e) - let threadenter ctx ~multiple lval f args = S.threadenter (conv ctx) ~multiple lval f args |> List.map (fun d -> (d, snd ctx.local)) - let threadspawn ctx ~multiple lval f args fctx = lift_fun ctx (S.threadspawn ~multiple) ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) + let threadenter ctx lval f args = S.threadenter (conv ctx) lval f args |> List.map (fun d -> (d, snd ctx.local)) + let threadspawn ctx lval f args fctx = lift_fun ctx S.threadspawn ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) let enter ctx r f args = let m = snd ctx.local in @@ -491,8 +485,8 @@ struct let combine_env ctx r fe f args fc es f_ask = lift_fun ctx D.lift S.combine_env (fun p -> p r fe f args fc (D.unlift es) f_ask) `Bot let combine_assign ctx r fe f args fc es f_ask = lift_fun ctx D.lift S.combine_assign (fun p -> p r fe f args fc (D.unlift es) f_ask) `Bot - let threadenter ctx ~multiple lval f args = lift_fun ctx (List.map D.lift) (S.threadenter ~multiple) ((|>) args % (|>) f % (|>) lval) [] - let threadspawn ctx ~multiple lval f args fctx = lift_fun ctx D.lift (S.threadspawn ~multiple) ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) `Bot + let threadenter ctx lval f args = lift_fun ctx (List.map D.lift) S.threadenter ((|>) args % (|>) f % (|>) lval) [] + let threadspawn ctx lval f args fctx = lift_fun ctx D.lift S.threadspawn ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) `Bot let event (ctx:(D.t,G.t,C.t,V.t) ctx) (e:Events.t) (octx:(D.t,G.t,C.t,V.t) ctx):D.t = lift_fun ctx D.lift S.event ((|>) (conv octx) % (|>) e) `Bot end @@ -502,6 +496,38 @@ sig val increment: increment_data option end +(** Combined variables so that we can also use the more common [EqConstrSys] + that uses only one kind of a variable. *) +module Var2 (LV:VarType) (GV:VarType) + : VarType + with type t = [ `L of LV.t | `G of GV.t ] += +struct + type t = [ `L of LV.t | `G of GV.t ] [@@deriving eq, ord, hash] + let relift = function + | `L x -> `L (LV.relift x) + | `G x -> `G (GV.relift x) + + let pretty_trace () = function + | `L a -> Pretty.dprintf "L:%a" LV.pretty_trace a + | `G a -> Pretty.dprintf "G:%a" GV.pretty_trace a + + let printXml f = function + | `L a -> LV.printXml f a + | `G a -> GV.printXml f a + + let var_id = function + | `L a -> LV.var_id a + | `G a -> GV.var_id a + + let node = function + | `L a -> LV.node a + | `G a -> GV.node a + + let is_write_only = function + | `L a -> LV.is_write_only a + | `G a -> GV.is_write_only a +end (** The main point of this file---generating a [GlobConstrSys] from a [Spec]. *) module FromSpec (S:Spec) (Cfg:CfgBackward) (I: Increment) @@ -537,7 +563,7 @@ struct if !AnalysisState.postsolving then sideg (GVar.contexts f) (G.create_contexts (G.CSet.singleton c)) - let common_ctx var edge prev_node pval (getl:lv -> ld) sidel getg sideg : (D.t, S.G.t, S.C.t, S.V.t) ctx * D.t list ref * (lval option * varinfo * exp list * D.t * bool) list ref = + let common_ctx var edge prev_node pval (getl:lv -> ld) sidel getg sideg : (D.t, S.G.t, S.C.t, S.V.t) ctx * D.t list ref * (lval option * varinfo * exp list * D.t) list ref = let r = ref [] in let spawns = ref [] in (* now watch this ... *) @@ -555,12 +581,12 @@ struct ; split = (fun (d:D.t) es -> assert (List.is_empty es); r := d::!r) ; sideg = (fun g d -> sideg (GVar.spec g) (G.create_spec d)) } - and spawn ?(multiple=false) lval f args = + and spawn lval f args = (* TODO: adjust ctx node/edge? *) (* TODO: don't repeat for all paths that spawn same *) - let ds = S.threadenter ~multiple ctx lval f args in + let ds = S.threadenter ctx lval f args in List.iter (fun d -> - spawns := (lval, f, args, d, multiple) :: !spawns; + spawns := (lval, f, args, d) :: !spawns; match Cilfacade.find_varinfo_fundec f with | fd -> let c = S.context fd d in @@ -592,14 +618,14 @@ struct } in (* TODO: don't forget path dependencies *) - let one_spawn (lval, f, args, fd, multiple) = + let one_spawn (lval, f, args, fd) = let rec fctx = { ctx with ask = (fun (type a) (q: a Queries.t) -> S.query fctx q) ; local = fd } in - S.threadspawn ctx' ~multiple lval f args fctx + S.threadspawn ctx' lval f args fctx in bigsqcup (List.map one_spawn spawns) @@ -794,13 +820,13 @@ struct ) let tf var getl sidel getg sideg prev_node (_,edge) d (f,t) = - let old_loc = !Goblint_tracing.current_loc in - let old_loc2 = !Goblint_tracing.next_loc in - Goblint_tracing.current_loc := f; - Goblint_tracing.next_loc := t; + let old_loc = !Tracing.current_loc in + let old_loc2 = !Tracing.next_loc in + Tracing.current_loc := f; + Tracing.next_loc := t; Goblint_backtrace.protect ~mark:(fun () -> TfLocation f) ~finally:(fun () -> - Goblint_tracing.current_loc := old_loc; - Goblint_tracing.next_loc := old_loc2 + Tracing.current_loc := old_loc; + Tracing.next_loc := old_loc2 ) (fun () -> let d = tf var getl sidel getg sideg prev_node edge d in d @@ -873,7 +899,7 @@ struct ; edge = MyCFG.Skip ; local = S.startstate Cil.dummyFunDec.svar (* bot and top both silently raise and catch Deadcode in DeadcodeLifter *) ; global = (fun g -> G.spec (getg (GVar.spec g))) - ; spawn = (fun ?(multiple=false) v d -> failwith "Cannot \"spawn\" in query context.") + ; spawn = (fun v d -> failwith "Cannot \"spawn\" in query context.") ; split = (fun d es -> failwith "Cannot \"split\" in query context.") ; sideg = (fun v g -> failwith "Cannot \"split\" in query context.") } @@ -973,7 +999,7 @@ struct let dummy_pseudo_return_node f = (* not the same as in CFG, but compares equal because of sid *) - Node.Statement ({Cil.dummyStmt with sid = Cilfacade.get_pseudo_return_id f}) + Node.Statement ({Cil.dummyStmt with sid = CfgTools.get_pseudo_return_id f}) in let add_nodes_of_fun (functions: fundec list) (withEntry: fundec -> bool) = let add_stmts (f: fundec) = @@ -1022,6 +1048,137 @@ struct {obsolete; delete; reluctant; restart} end +(** Convert a non-incremental solver into an "incremental" solver. + It will solve from scratch, perform standard postsolving and have no marshal data. *) +module EqIncrSolverFromEqSolver (Sol: GenericEqSolver): GenericEqIncrSolver = + functor (Arg: IncrSolverArg) (S: EqConstrSys) (VH: Hashtbl.S with type key = S.v) -> + struct + module Sol = Sol (S) (VH) + module Post = PostSolver.MakeList (PostSolver.ListArgFromStdArg (S) (VH) (Arg)) + + type marshal = unit + let copy_marshal () = () + let relift_marshal () = () + + let solve xs vs _ = + let vh = Sol.solve xs vs in + Post.post xs vs vh; + (vh, ()) + end + + +(** Translate a [GlobConstrSys] into a [EqConstrSys] *) +module EqConstrSysFromGlobConstrSys (S:GlobConstrSys) + : EqConstrSys with type v = Var2(S.LVar)(S.GVar).t + and type d = Lattice.Lift2(S.G)(S.D)(Printable.DefaultNames).t + and module Var = Var2(S.LVar)(S.GVar) + and module Dom = Lattice.Lift2(S.G)(S.D)(Printable.DefaultNames) += +struct + module Var = Var2(S.LVar)(S.GVar) + module Dom = + struct + include Lattice.Lift2(S.G)(S.D)(Printable.DefaultNames) + let printXml f = function + | `Lifted1 a -> S.G.printXml f a + | `Lifted2 a -> S.D.printXml f a + | (`Bot | `Top) as x -> printXml f x + end + type v = Var.t + type d = Dom.t + + let getG = function + | `Lifted1 x -> x + | `Bot -> S.G.bot () + | `Top -> failwith "EqConstrSysFromGlobConstrSys.getG: global variable has top value" + | `Lifted2 _ -> failwith "EqConstrSysFromGlobConstrSys.getG: global variable has local value" + + let getL = function + | `Lifted2 x -> x + | `Bot -> S.D.bot () + | `Top -> failwith "EqConstrSysFromGlobConstrSys.getL: local variable has top value" + | `Lifted1 _ -> failwith "EqConstrSysFromGlobConstrSys.getL: local variable has global value" + + let l, g = (fun x -> `L x), (fun x -> `G x) + let lD, gD = (fun x -> `Lifted2 x), (fun x -> `Lifted1 x) + + let conv f get set = + f (getL % get % l) (fun x v -> set (l x) (lD v)) + (getG % get % g) (fun x v -> set (g x) (gD v)) + |> lD + + let system = function + | `G _ -> None + | `L x -> Option.map conv (S.system x) + + let sys_change get = + S.sys_change (getL % get % l) (getG % get % g) +end + +(** Splits a [EqConstrSys] solution into a [GlobConstrSys] solution with given [Hashtbl.S] for the [EqConstrSys]. *) +module GlobConstrSolFromEqConstrSolBase (S: GlobConstrSys) (LH: Hashtbl.S with type key = S.LVar.t) (GH: Hashtbl.S with type key = S.GVar.t) (VH: Hashtbl.S with type key = Var2 (S.LVar) (S.GVar).t) = +struct + let split_solution hm = + let l' = LH.create 113 in + let g' = GH.create 113 in + let split_vars x d = match x with + | `L x -> + begin match d with + | `Lifted2 d -> LH.replace l' x d + (* | `Bot -> () *) + (* Since Verify2 is broken and only checks existing keys, add it with local bottom value. + This works around some cases, where Verify2 would not detect a problem due to completely missing variable. *) + | `Bot -> LH.replace l' x (S.D.bot ()) + | `Top -> failwith "GlobConstrSolFromEqConstrSolBase.split_vars: local variable has top value" + | `Lifted1 _ -> failwith "GlobConstrSolFromEqConstrSolBase.split_vars: local variable has global value" + end + | `G x -> + begin match d with + | `Lifted1 d -> GH.replace g' x d + | `Bot -> () + | `Top -> failwith "GlobConstrSolFromEqConstrSolBase.split_vars: global variable has top value" + | `Lifted2 _ -> failwith "GlobConstrSolFromEqConstrSolBase.split_vars: global variable has local value" + end + in + VH.iter split_vars hm; + (l', g') +end + +(** Splits a [EqConstrSys] solution into a [GlobConstrSys] solution. *) +module GlobConstrSolFromEqConstrSol (S: GlobConstrSys) (LH: Hashtbl.S with type key = S.LVar.t) (GH: Hashtbl.S with type key = S.GVar.t) = +struct + module S2 = EqConstrSysFromGlobConstrSys (S) + module VH = Hashtbl.Make (S2.Var) + + include GlobConstrSolFromEqConstrSolBase (S) (LH) (GH) (VH) +end + +(** Transforms a [GenericEqIncrSolver] into a [GenericGlobSolver]. *) +module GlobSolverFromEqSolver (Sol:GenericEqIncrSolverBase) + = functor (S:GlobConstrSys) -> + functor (LH:Hashtbl.S with type key=S.LVar.t) -> + functor (GH:Hashtbl.S with type key=S.GVar.t) -> + struct + module EqSys = EqConstrSysFromGlobConstrSys (S) + + module VH : Hashtbl.S with type key=EqSys.v = Hashtbl.Make(EqSys.Var) + module Sol' = Sol (EqSys) (VH) + + module Splitter = GlobConstrSolFromEqConstrSolBase (S) (LH) (GH) (VH) (* reuse EqSys and VH *) + + type marshal = Sol'.marshal + + let copy_marshal = Sol'.copy_marshal + let relift_marshal = Sol'.relift_marshal + + let solve ls gs l old_data = + let vs = List.map (fun (x,v) -> `L x, `Lifted2 v) ls + @ List.map (fun (x,v) -> `G x, `Lifted1 v) gs in + let sv = List.map (fun x -> `L x) l in + let hm, solver_data = Sol'.solve vs sv old_data in + Splitter.split_solution hm, solver_data + end + (** Add path sensitivity to a analysis *) module PathSensitive2 (Spec:Spec) @@ -1106,13 +1263,12 @@ struct let fd1 = D.choose octx.local in map ctx Spec.event (fun h -> h e (conv octx fd1)) - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = let g xs ys = (List.map (fun y -> D.singleton y) ys) @ xs in - fold' ctx (Spec.threadenter ~multiple) (fun h -> h lval f args) g [] - - let threadspawn ctx ~multiple lval f args fctx = + fold' ctx Spec.threadenter (fun h -> h lval f args) g [] + let threadspawn ctx lval f args fctx = let fd1 = D.choose fctx.local in - map ctx (Spec.threadspawn ~multiple) (fun h -> h lval f args (conv fctx fd1)) + map ctx Spec.threadspawn (fun h -> h lval f args (conv fctx fd1)) let sync ctx reason = map ctx Spec.sync (fun h -> h reason) @@ -1176,7 +1332,7 @@ struct module V = struct - include Printable.EitherConf (struct let expand1 = false let expand2 = true end) (S.V) (Node) + include Printable.Either (S.V) (Node) let name () = "DeadBranch" let s x = `Left x let node x = `Right x @@ -1187,13 +1343,13 @@ struct module EM = struct - include MapDomain.MapBot (Basetype.CilExp) (BoolDomain.FlatBool) + include MapDomain.MapBot (Basetype.CilExp) (Basetype.Bools) let name () = "branches" end module G = struct - include Lattice.Lift2 (S.G) (EM) + include Lattice.Lift2 (S.G) (EM) (Printable.DefaultNames) let name () = "deadbranch" let s = function @@ -1295,7 +1451,7 @@ struct let combine_assign ctx = S.combine_assign (conv ctx) let special ctx = S.special (conv ctx) let threadenter ctx = S.threadenter (conv ctx) - let threadspawn ctx ~multiple lv f args fctx = S.threadspawn (conv ctx) ~multiple lv f args (conv fctx) + let threadspawn ctx lv f args fctx = S.threadspawn (conv ctx) lv f args (conv fctx) let sync ctx = S.sync (conv ctx) let skip ctx = S.skip (conv ctx) let asm ctx = S.asm (conv ctx) @@ -1310,19 +1466,18 @@ struct module V = struct - include Printable.Either3Conf (struct let expand1 = false let expand2 = true let expand3 = true end) (S.V) (Printable.Prod (Node) (C)) (Printable.Prod (CilType.Fundec) (C)) - let name () = "longjmp" + include Printable.Either (S.V) (Printable.Either (Printable.Prod (Node) (C)) (Printable.Prod (CilType.Fundec) (C))) let s x = `Left x - let longjmpto x = `Middle x - let longjmpret x = `Right x + let longjmpto x = `Right (`Left x) + let longjmpret x = `Right (`Right x) let is_write_only = function | `Left x -> S.V.is_write_only x - | _ -> false + | `Right _ -> false end module G = struct - include Lattice.Lift2 (S.G) (S.D) + include Lattice.Lift2 (S.G) (S.D) (Printable.DefaultNames) let s = function | `Bot -> S.G.bot () @@ -1354,7 +1509,7 @@ struct begin match g with | `Left g -> S.query (conv ctx) (WarnGlobal (Obj.repr g)) - | _ -> + | `Right g -> Queries.Result.top q end | InvariantGlobal g -> @@ -1362,7 +1517,7 @@ struct begin match g with | `Left g -> S.query (conv ctx) (InvariantGlobal (Obj.repr g)) - | _ -> + | `Right g -> Queries.Result.top q end | IterSysVars (vq, vf) -> @@ -1530,157 +1685,10 @@ struct ) in List.iter handle_path (S.paths_as_set conv_ctx); - if !AnalysisState.should_warn && List.mem "termination" @@ get_string_list "ana.activated" then ( - AnalysisState.svcomp_may_not_terminate := true; - M.warn ~category:Termination "The program might not terminate! (Longjmp)" - ); S.D.bot () | _ -> S.special conv_ctx lv f args let threadenter ctx = S.threadenter (conv ctx) - let threadspawn ctx ~multiple lv f args fctx = S.threadspawn (conv ctx) ~multiple lv f args (conv fctx) - let sync ctx = S.sync (conv ctx) - let skip ctx = S.skip (conv ctx) - let asm ctx = S.asm (conv ctx) - let event ctx e octx = S.event (conv ctx) e (conv octx) -end - - -(** Add cycle detection in the context-sensitive dynamic function call graph to an analysis *) -module RecursionTermLifter (S: Spec) - : Spec with module D = S.D - and module C = S.C -= -(* two global invariants: - - S.V -> S.G - Needed to store the previously built global invariants - - fundec * S.C -> (Set (fundec * S.C)) - The second global invariant maps from the callee fundec and context to a set of caller fundecs and contexts. - This structure therefore stores the context-sensitive call graph. - For example: - let the function f in context c call function g in context c'. - In the global invariant structure it would be stored like this: (g,c') -> {(f, c)} -*) - -struct - include S - - (* contains all the callee fundecs and contexts *) - module V = GVarFC(S.V)(S.C) - - (* Tuple containing the fundec and context of a caller *) - module Call = Printable.Prod (CilType.Fundec) (S.C) - - (* Set containing multiple caller tuples *) - module CallerSet = SetDomain.Make (Call) - - module G = - struct - include Lattice.Lift2 (G) (CallerSet) - - let spec = function - | `Bot -> G.bot () - | `Lifted1 x -> x - | _ -> failwith "RecursionTermLifter.spec" - - let callers = function - | `Bot -> CallerSet.bot () - | `Lifted2 x -> x - | _ -> failwith "RecursionTermLifter.callGraph" - - let create_spec spec = `Lifted1 spec - let create_singleton_caller caller = `Lifted2 (CallerSet.singleton caller) - - let printXml f = function - | `Lifted1 x -> G.printXml f x - | `Lifted2 x -> BatPrintf.fprintf f "%a" CallerSet.printXml x - | x -> BatPrintf.fprintf f "%a" printXml x - - end - - let name () = "RecursionTermLifter (" ^ S.name () ^ ")" - - let conv (ctx: (_, G.t, _, V.t) ctx): (_, S.G.t, _, S.V.t) ctx = - { ctx with - global = (fun v -> G.spec (ctx.global (V.spec v))); - sideg = (fun v g -> ctx.sideg (V.spec v) (G.create_spec g)); - } - - let cycleDetection ctx call = - let module LH = Hashtbl.Make (Printable.Prod (CilType.Fundec) (S.C)) in - let module LS = Set.Make (Printable.Prod (CilType.Fundec) (S.C)) in - (* find all cycles/SCCs *) - let global_visited_calls = LH.create 100 in - - (* DFS *) - let rec iter_call (path_visited_calls: LS.t) ((fundec, _) as call) = - if LS.mem call path_visited_calls then ( - AnalysisState.svcomp_may_not_terminate := true; (*set the indicator for a non-terminating program for the sv comp*) - (*Cycle found*) - let loc = M.Location.CilLocation fundec.svar.vdecl in - M.warn ~loc ~category:Termination "The program might not terminate! (Fundec %a is contained in a call graph cycle)" CilType.Fundec.pretty fundec) (* output a warning for non-termination*) - else if not (LH.mem global_visited_calls call) then begin - LH.replace global_visited_calls call (); - let new_path_visited_calls = LS.add call path_visited_calls in - let gvar = V.call call in - let callers = G.callers (ctx.global gvar) in - CallerSet.iter (fun to_call -> - iter_call new_path_visited_calls to_call - ) callers; - end - in - iter_call LS.empty call - - let query ctx (type a) (q: a Queries.t): a Queries.result = - match q with - | WarnGlobal v -> - (* check result of loop analysis *) - if not (ctx.ask Queries.MustTermAllLoops) then - AnalysisState.svcomp_may_not_terminate := true; - let v: V.t = Obj.obj v in - begin match v with - | `Left v' -> - S.query (conv ctx) (WarnGlobal (Obj.repr v')) - | `Right call -> cycleDetection ctx call (* Note: to make it more efficient, one could only execute the cycle detection in case the loop analysis returns true, because otherwise the program will probably not terminate anyway*) - end - | InvariantGlobal v -> - let v: V.t = Obj.obj v in - begin match v with - | `Left v -> - S.query (conv ctx) (InvariantGlobal (Obj.repr v)) - | `Right v -> - Queries.Result.top q - end - | _ -> S.query (conv ctx) q - - let branch ctx = S.branch (conv ctx) - let assign ctx = S.assign (conv ctx) - let vdecl ctx = S.vdecl (conv ctx) - - - let record_call sideg callee caller = - sideg (V.call callee) (G.create_singleton_caller caller) - - let enter ctx = S.enter (conv ctx) - let paths_as_set ctx = S.paths_as_set (conv ctx) - let body ctx = S.body (conv ctx) - let return ctx = S.return (conv ctx) - let combine_env ctx r fe f args fc es f_ask = - if !AnalysisState.postsolving then ( - let c_r: S.C.t = ctx.context () in (* Caller context *) - let nodeF = ctx.node in - let fd_r : fundec = Node.find_fundec nodeF in (* Caller fundec *) - let caller: (fundec * S.C.t) = (fd_r, c_r) in - let c_e: S.C.t = Option.get fc in (* Callee context *) - let fd_e : fundec = f in (* Callee fundec *) - let callee = (fd_e, c_e) in - record_call ctx.sideg callee caller - ); - S.combine_env (conv ctx) r fe f args fc es f_ask - - let combine_assign ctx = S.combine_assign (conv ctx) - let special ctx = S.special (conv ctx) - let threadenter ctx = S.threadenter (conv ctx) - let threadspawn ctx ~multiple lv f args fctx = S.threadspawn (conv ctx) ~multiple lv f args (conv fctx) + let threadspawn ctx lv f args fctx = S.threadspawn (conv ctx) lv f args (conv fctx) let sync ctx = S.sync (conv ctx) let skip ctx = S.skip (conv ctx) let asm ctx = S.asm (conv ctx) @@ -1894,3 +1902,29 @@ struct ignore (Pretty.printf "Nodes comparison summary: %t\n" (fun () -> msg)); print_newline (); end + +(** [EqConstrSys] where [current_var] indicates the variable whose right-hand side is currently being evaluated. *) +module CurrentVarEqConstrSys (S: EqConstrSys) = +struct + let current_var = ref None + + module S = + struct + include S + + let system x = + match S.system x with + | None -> None + | Some f -> + let f' get set = + let old_current_var = !current_var in + current_var := Some x; + Fun.protect ~finally:(fun () -> + current_var := old_current_var + ) (fun () -> + f get set + ) + in + Some f' + end +end diff --git a/src/framework/control.ml b/src/framework/control.ml index 391c766feb2..9baa2dd1cab 100644 --- a/src/framework/control.ml +++ b/src/framework/control.ml @@ -6,7 +6,6 @@ open Batteries open GoblintCil open MyCFG open Analyses -open ConstrSys open GobConfig open Constraints @@ -15,8 +14,7 @@ module type S2S = functor (X : Spec) -> Spec (* spec is lazy, so HConsed table in Hashcons lifters is preserved between analyses in server mode *) let spec_module: (module Spec) Lazy.t = lazy ( GobConfig.building_spec := true; - let arg_enabled = get_bool "witness.graphml.enabled" || get_bool "exp.arg" in - let termination_enabled = List.mem "termination" (get_string_list "ana.activated") in (* check if loop termination analysis is enabled*) + let arg_enabled = (get_bool "ana.sv-comp.enabled" && get_bool "witness.enabled") || get_bool "exp.arg" in let open Batteries in (* apply functor F on module X if opt is true *) let lift opt (module F : S2S) (module X : Spec) = (module (val if opt then (module F (X)) else (module X) : Spec) : Spec) in @@ -38,7 +36,6 @@ let spec_module: (module Spec) Lazy.t = lazy ( Also must be outside of deadcode, because deadcode splits (like mutex lock event) don't pass on tokens. *) |> lift (get_bool "ana.widen.tokens") (module WideningTokens.Lifter) |> lift true (module LongjmpLifter) - |> lift termination_enabled (module RecursionTermLifter) (* Always activate the recursion termination analysis, when the loop termination analysis is activated*) ) in GobConfig.building_spec := false; ControlSpecC.control_spec_c := (module S1.C); @@ -85,16 +82,16 @@ struct let save_run = let o = get_string "save_run" in if o = "" then (if gobview then "run" else "") else o in save_run <> "" end - module Slvr = (GlobSolverFromEqSolver (Goblint_solver.Selector.Make (PostSolverArg))) (EQSys) (LHT) (GHT) + module Slvr = (GlobSolverFromEqSolver (Selector.Make (PostSolverArg))) (EQSys) (LHT) (GHT) (* The comparator *) module CompareGlobSys = Constraints.CompareGlobSys (SpecSys) (* Triple of the function, context, and the local value. *) - module RT = AnalysisResult.ResultType2 (Spec) + module RT = Analyses.ResultType2 (Spec) (* Set of triples [RT] *) module LT = SetDomain.HeadlessSet (RT) (* Analysis result structure---a hashtable from program points to [LT] *) - module Result = AnalysisResult.Result (LT) (struct let result_name = "analysis" end) + module Result = Analyses.Result (LT) (struct let result_name = "analysis" end) module Query = ResultQuery.Query (SpecSys) @@ -106,8 +103,6 @@ struct let module StringMap = BatMap.Make (String) in let live_lines = ref StringMap.empty in let dead_lines = ref StringMap.empty in - let module FunSet = Hashtbl.Make (CilType.Fundec) in - let live_funs: unit FunSet.t = FunSet.create 13 in let add_one n v = match n with | Statement s when Cilfacade.(StmtH.mem pseudo_return_to_fun s) -> @@ -118,7 +113,6 @@ struct See: https://github.com/goblint/analyzer/issues/290#issuecomment-881258091. *) let l = UpdateCil.getLoc n in let f = Node.find_fundec n in - FunSet.replace live_funs f (); let add_fun = BatISet.add l.line in let add_file = StringMap.modify_def BatISet.empty f.svar.vname add_fun in let is_dead = LT.for_all (fun (_,x,f) -> Spec.D.is_bot x) v in @@ -140,21 +134,6 @@ struct try StringMap.find fn (StringMap.find file !live_lines) with Not_found -> BatISet.empty in - if List.mem "termination" @@ get_string_list "ana.activated" then ( - (* check if we have upjumping gotos *) - let open Cilfacade in - let warn_for_upjumps fundec gotos = - if FunSet.mem live_funs fundec then ( - (* set nortermiantion flag *) - AnalysisState.svcomp_may_not_terminate := true; - (* iterate through locations to produce warnings *) - LocSet.iter (fun l _ -> - M.warn ~loc:(M.Location.CilLocation l) ~category:Termination "The program might not terminate! (Upjumping Goto)" - ) gotos - ) - in - FunLocH.iter warn_for_upjumps funs_with_upjumping_gotos - ); dead_lines := StringMap.mapi (fun fi -> StringMap.mapi (fun fu ded -> BatISet.diff ded (live fi fu))) !dead_lines; dead_lines := StringMap.map (StringMap.filter (fun _ x -> not (BatISet.is_empty x))) !dead_lines; dead_lines := StringMap.filter (fun _ x -> not (StringMap.is_empty x)) !dead_lines; @@ -301,7 +280,7 @@ struct ; edge = MyCFG.Skip ; local = Spec.D.top () ; global = (fun g -> EQSys.G.spec (getg (EQSys.GVar.spec g))) - ; spawn = (fun ?(multiple=false) _ -> failwith "Global initializers should never spawn threads. What is going on?") + ; spawn = (fun _ -> failwith "Global initializers should never spawn threads. What is going on?") ; split = (fun _ -> failwith "Global initializers trying to split paths.") ; sideg = (fun g d -> sideg (EQSys.GVar.spec g) (EQSys.G.create_spec d)) } @@ -314,7 +293,7 @@ struct if M.tracing then M.trace "con" "Initializer %a\n" CilType.Location.pretty loc; (*incr count; if (get_bool "dbg.verbose")&& (!count mod 1000 = 0) then Printf.printf "%d %!" !count; *) - Goblint_tracing.current_loc := loc; + Tracing.current_loc := loc; match edge with | MyCFG.Entry func -> if M.tracing then M.trace "global_inits" "Entry %a\n" d_lval (var func.svar); @@ -336,9 +315,9 @@ struct in let with_externs = do_extern_inits ctx file in (*if (get_bool "dbg.verbose") then Printf.printf "Number of init. edges : %d\nWorking:" (List.length edges); *) - let old_loc = !Goblint_tracing.current_loc in + let old_loc = !Tracing.current_loc in let result : Spec.D.t = List.fold_left transfer_func with_externs edges in - Goblint_tracing.current_loc := old_loc; + Tracing.current_loc := old_loc; if M.tracing then M.trace "global_inits" "startstate: %a\n" Spec.D.pretty result; result, !funs in @@ -406,7 +385,7 @@ struct ; edge = MyCFG.Skip ; local = st ; global = (fun g -> EQSys.G.spec (getg (EQSys.GVar.spec g))) - ; spawn = (fun ?(multiple=false) _ -> failwith "Bug1: Using enter_func for toplevel functions with 'otherstate'.") + ; spawn = (fun _ -> failwith "Bug1: Using enter_func for toplevel functions with 'otherstate'.") ; split = (fun _ -> failwith "Bug2: Using enter_func for toplevel functions with 'otherstate'.") ; sideg = (fun g d -> sideg (EQSys.GVar.spec g) (EQSys.G.create_spec d)) } @@ -438,13 +417,13 @@ struct ; edge = MyCFG.Skip ; local = st ; global = (fun g -> EQSys.G.spec (getg (EQSys.GVar.spec g))) - ; spawn = (fun ?(multiple=false) _ -> failwith "Bug1: Using enter_func for toplevel functions with 'otherstate'.") + ; spawn = (fun _ -> failwith "Bug1: Using enter_func for toplevel functions with 'otherstate'.") ; split = (fun _ -> failwith "Bug2: Using enter_func for toplevel functions with 'otherstate'.") ; sideg = (fun g d -> sideg (EQSys.GVar.spec g) (EQSys.G.create_spec d)) } in (* TODO: don't hd *) - List.hd (Spec.threadenter ctx ~multiple:false None v []) + List.hd (Spec.threadenter ctx None v []) (* TODO: do threadspawn to mainfuns? *) in let prestartstate = Spec.startstate MyCFG.dummy_func.svar in (* like in do_extern_inits *) @@ -476,7 +455,7 @@ struct let save_run_str = let o = get_string "save_run" in if o = "" then (if gobview then "run" else "") else o in let lh, gh = if load_run <> "" then ( - let module S2' = (GlobSolverFromEqSolver (Goblint_solver.Generic.LoadRunIncrSolver (PostSolverArg))) (EQSys) (LHT) (GHT) in + let module S2' = (GlobSolverFromEqSolver (Generic.LoadRunIncrSolver (PostSolverArg))) (EQSys) (LHT) (GHT) in let (r2, _) = S2'.solve entrystates entrystates_global startvars' None in (* TODO: has incremental data? *) r2 ) else if compare_runs <> [] then ( @@ -582,7 +561,7 @@ struct let (r2, _) = S2'.solve entrystates entrystates_global startvars' None in (* TODO: has incremental data? *) CompareGlobSys.compare (get_string "solver", get_string "comparesolver") (lh,gh) (r2) in - compare_with (Goblint_solver.Selector.choose_solver (get_string "comparesolver")) + compare_with (Selector.choose_solver (get_string "comparesolver")) ); (* Most warnings happen before during postsolver, but some happen later (e.g. in finalize), so enable this for the rest (if required by option). *) diff --git a/src/framework/resultQuery.ml b/src/framework/resultQuery.ml index c676c41c14d..ce5839ef30a 100644 --- a/src/framework/resultQuery.ml +++ b/src/framework/resultQuery.ml @@ -18,7 +18,7 @@ struct ; edge = MyCFG.Skip ; local = local ; global = (fun g -> try EQSys.G.spec (GHT.find gh (EQSys.GVar.spec g)) with Not_found -> Spec.G.bot ()) (* see 29/29 on why fallback is needed *) - ; spawn = (fun ?(multiple=false) v d -> failwith "Cannot \"spawn\" in witness context.") + ; spawn = (fun v d -> failwith "Cannot \"spawn\" in witness context.") ; split = (fun d es -> failwith "Cannot \"split\" in witness context.") ; sideg = (fun v g -> failwith "Cannot \"sideg\" in witness context.") } @@ -37,7 +37,7 @@ struct ; edge = MyCFG.Skip ; local = local ; global = (fun g -> try EQSys.G.spec (GHT.find gh (EQSys.GVar.spec g)) with Not_found -> Spec.G.bot ()) (* TODO: how can be missing? *) - ; spawn = (fun ?(multiple=false) v d -> failwith "Cannot \"spawn\" in witness context.") + ; spawn = (fun v d -> failwith "Cannot \"spawn\" in witness context.") ; split = (fun d es -> failwith "Cannot \"split\" in witness context.") ; sideg = (fun v g -> failwith "Cannot \"sideg\" in witness context.") } @@ -57,7 +57,7 @@ struct ; edge = MyCFG.Skip ; local = Spec.startstate GoblintCil.dummyFunDec.svar (* bot and top both silently raise and catch Deadcode in DeadcodeLifter *) (* TODO: is this startstate bad? *) ; global = (fun v -> EQSys.G.spec (try GHT.find gh (EQSys.GVar.spec v) with Not_found -> EQSys.G.bot ())) (* TODO: how can be missing? *) - ; spawn = (fun ?(multiple=false) v d -> failwith "Cannot \"spawn\" in query context.") + ; spawn = (fun v d -> failwith "Cannot \"spawn\" in query context.") ; split = (fun d es -> failwith "Cannot \"split\" in query context.") ; sideg = (fun v g -> failwith "Cannot \"split\" in query context.") } diff --git a/src/constraint/varQuery.ml b/src/framework/varQuery.ml similarity index 100% rename from src/constraint/varQuery.ml rename to src/framework/varQuery.ml diff --git a/src/constraint/varQuery.mli b/src/framework/varQuery.mli similarity index 100% rename from src/constraint/varQuery.mli rename to src/framework/varQuery.mli diff --git a/src/goblint.ml b/src/goblint.ml index 25e809f9e98..4ea3a3d242f 100644 --- a/src/goblint.ml +++ b/src/goblint.ml @@ -38,8 +38,6 @@ let main () = print_endline (GobUnix.localtime ()); print_endline GobSys.command_line; ); - (* When analyzing a termination specification, activate the termination analysis before pre-processing. *) - if get_bool "ana.autotune.enabled" && AutoTune.specificationTerminationIsActivated () then AutoTune.focusOnTermination (); let file = lazy (Fun.protect ~finally:GoblintDir.finalize preprocess_parse_merge) in if get_bool "server.enabled" then ( let file = diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 06c51b0c154..a71a0c96843 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -21,7 +21,6 @@ module CfgTools = CfgTools A dynamic composition of analyses is combined with CFGs to produce a constraint system. *) module Analyses = Analyses -module ConstrSys = ConstrSys module Constraints = Constraints module AnalysisState = AnalysisState module AnalysisStateUtil = AnalysisStateUtil @@ -46,14 +45,13 @@ module Events = Events The following modules help query the constraint system solution using semantic information. *) -module AnalysisResult = AnalysisResult module ResultQuery = ResultQuery module VarQuery = VarQuery (** {2 Configuration} Runtime configuration is represented as JSON. - Options are specified and documented by the JSON schema [src/config/options.schema.json]. *) + Options are specified and documented by the JSON schema [src/common/util/options.schema.json]. *) module GobConfig = GobConfig module AfterConfig = AfterConfig @@ -132,7 +130,7 @@ module ExtractPthread = ExtractPthread Analyses related to [longjmp] and [setjmp]. *) module ActiveSetjmp = ActiveSetjmp -module ModifiedSinceSetjmp = ModifiedSinceSetjmp +module ModifiedSinceLongjmp = ModifiedSinceLongjmp module ActiveLongjmp = ActiveLongjmp module PoisonVariables = PoisonVariables module Vla = Vla @@ -149,10 +147,12 @@ module UnitAnalysis = UnitAnalysis (** {2 Other} *) module Assert = Assert -module LoopTermination = LoopTermination +module FileUse = FileUse module Uninit = Uninit +module Termination = Termination module Expsplit = Expsplit module StackTrace = StackTrace +module Spec = Spec (** {2 Helper} @@ -213,7 +213,6 @@ module FloatDomain = FloatDomain module Mval = Mval module Offset = Offset -module StringDomain = StringDomain module AddressDomain = AddressDomain (** {5 Complex} *) @@ -221,7 +220,6 @@ module AddressDomain = AddressDomain module StructDomain = StructDomain module UnionDomain = UnionDomain module ArrayDomain = ArrayDomain -module NullByteSet = NullByteSet module JmpBufDomain = JmpBufDomain (** {5 Combined} @@ -264,8 +262,12 @@ module AccessDomain = AccessDomain module MusteqDomain = MusteqDomain module RegionDomain = RegionDomain +module FileDomain = FileDomain module StackDomain = StackDomain +module MvalMapDomain = MvalMapDomain +module SpecDomain = SpecDomain + (** {2 Testing} Modules related to (property-based) testing of domains. *) @@ -288,11 +290,47 @@ module Serialize = Serialize module CilMaps = CilMaps +(** {1 Solvers} + + Generic solvers are used to solve {{!Analyses.MonSystem} (side-effecting) constraint systems}. *) + +(** {2 Top-down} + + The top-down solver family. *) + +module Td3 = Td3 +module TopDown = TopDown +module TopDown_term = TopDown_term +module TopDown_space_cache_term = TopDown_space_cache_term +module TopDown_deprecated = TopDown_deprecated + +(** {2 SLR} + + The SLR solver family. *) + +module SLRphased = SLRphased +module SLRterm = SLRterm +module SLR = SLR + +(** {2 Other} *) + +module EffectWConEq = EffectWConEq +module Worklist = Worklist +module Generic = Generic +module Selector = Selector + +module PostSolver = PostSolver +module LocalFixpoint = LocalFixpoint +module SolverStats = SolverStats +module SolverBox = SolverBox + + (** {1 I/O} Various input/output interfaces and formats. *) module Messages = Messages +module Tracing = Tracing (** {2 Front-end} @@ -301,7 +339,6 @@ module Messages = Messages module Preprocessor = Preprocessor module CompilationDatabase = CompilationDatabase module MakefileUtil = MakefileUtil -module TerminationPreprocessing = TerminationPreprocessing (** {2 Witnesses} @@ -402,14 +439,12 @@ module LibraryFunctions = LibraryFunctions module BaseUtil = BaseUtil module PrecisionUtil = PrecisionUtil module ContextUtil = ContextUtil -module ReturnUtil = ReturnUtil module BaseInvariant = BaseInvariant module CommonPriv = CommonPriv module WideningThresholds = WideningThresholds module VectorMatrix = VectorMatrix module SharedFunctions = SharedFunctions -module GobApron = GobApron (** {2 Precision comparison} *) @@ -430,3 +465,9 @@ module ApronPrecCompareUtil = ApronPrecCompareUtil OCaml standard library extensions which are not provided by {!Batteries}. *) module GobFormat = GobFormat + +(** {2 Other libraries} + + External library extensions. *) + +module MyCheck = MyCheck diff --git a/src/incremental/compareCFG.ml b/src/incremental/compareCFG.ml index 55b3fa8fc5f..225cbb1c76f 100644 --- a/src/incremental/compareCFG.ml +++ b/src/incremental/compareCFG.ml @@ -17,7 +17,7 @@ let (&&<>) (prev_result: bool * rename_mapping) f : bool * rename_mapping = let eq_node (x, fun1) (y, fun2) ~rename_mapping = let isPseudoReturn f sid = - let pid = Cilfacade.get_pseudo_return_id f in + let pid = CfgTools.get_pseudo_return_id f in sid == pid in match x,y with | Statement s1, Statement s2 -> diff --git a/src/incremental/dune b/src/incremental/dune deleted file mode 100644 index 15c1d2a7af4..00000000000 --- a/src/incremental/dune +++ /dev/null @@ -1,23 +0,0 @@ -(include_subdirs no) - -(library - (name goblint_incremental) - (public_name goblint.incremental) - (wrapped false) ; TODO: wrap - (libraries - batteries.unthreaded - zarith - goblint_std - goblint_config - goblint_common - goblint-cil - fpath) - (flags :standard -open Goblint_std) - (preprocess - (pps - ppx_deriving.std - ppx_deriving_hash - ppx_deriving_yojson)) - (instrumentation (backend bisect_ppx))) - -(documentation) diff --git a/src/incremental/incremental.mld b/src/incremental/incremental.mld deleted file mode 100644 index bf9b6e6a588..00000000000 --- a/src/incremental/incremental.mld +++ /dev/null @@ -1,16 +0,0 @@ -{0 Library goblint.incremental} -This library is unwrapped and provides the following top-level modules. -For better context, see {!Goblint_lib} which also documents these modules. - - -{1 Incremental} - -{!modules: -CompareCIL -CompareAST -CompareCFG -UpdateCil -MaxIdUtil -Serialize -CilMaps -} diff --git a/src/index.mld b/src/index.mld index 0f6b1c3e69f..2afbbc97aed 100644 --- a/src/index.mld +++ b/src/index.mld @@ -7,30 +7,9 @@ The following libraries make up Goblint's main codebase. {!modules:Goblint_lib} This library currently contains the majority of Goblint and is in the process of being split into smaller libraries. -{2 Library goblint.config} -This {{!page-config}unwrapped library} contains various configuration modules extracted from {!Goblint_lib}. - {2 Library goblint.common} This {{!page-common}unwrapped library} contains various common modules extracted from {!Goblint_lib}. -{2 Library goblint.domain} -This {{!page-domain}unwrapped library} contains various domain modules extracted from {!Goblint_lib}. - -{2 Library goblint.cdomain.value} -This {{!page-cdomain_value}unwrapped library} contains various value domain modules extracted from {!Goblint_lib}. - -{2 Library goblint.constraint} -This {{!page-constraint}unwrapped library} contains various constraint system modules extracted from {!Goblint_lib}. - -{2 Library goblint.solver} -{!modules:Goblint_solver} - -{2 Library goblint.library} -This {{!page-library}unwrapped library} contains various library specification modules extracted from {!Goblint_lib}. - -{2 Library goblint.incremental} -This {{!page-incremental}unwrapped library} contains various incremental modules extracted from {!Goblint_lib}. - {1 Library extensions} The following libraries provide extensions to other OCaml libraries. @@ -64,9 +43,6 @@ The following libraries provide utilities which are completely independent of Go {2 Library goblint.timing} {!modules:Goblint_timing} -{2 Library goblint.tracing} -{!modules:Goblint_tracing} - {1 Vendored} The following libraries are vendored in Goblint. diff --git a/src/main.camldoc b/src/main.camldoc new file mode 100644 index 00000000000..ec08a14a7b5 --- /dev/null +++ b/src/main.camldoc @@ -0,0 +1,142 @@ + +This is the API of the Goblint static analyzer framework, developed at the Technische Universität München ({b TUM}) +and the University of Tartu ({b UT}). + +The API is divided into four logical sections: +the framework, constraint solvers, domains, and analysis instances. + +{2 Framework} +{!modules: +Maingoblint +Analyses +Constraints +Control +MyCFG +Version +Config +} + +{3 Util} +{!modules: +Cache +Cilfacade +Defaults +GobConfig +Goblintutil +Hash +Htmldump +Htmlutil +Json +Messages +MyLiveness +OilUtil +Printer +Questions +Report +Tracing +Xmldump +} + +{3 CIL components} +{!modules: +Cil +Pretty +} + +{2 Solvers} +{!modules: +EffectWCon +EffectWConEq +Generic +Interactive +SLR +Selector +SharirPnueli +TopDown +} + +{2 Domains} + +{!modules: + +ValueDomain +Basetype + +Exp +IntDomain +CircularInterval +ArrayDomain +StructDomain +UnionDomain + +Lval +AddressDomain +MemoryDomain +MusteqDomain +RegionDomain +ShapeDomain +ListDomain + +BaseDomain +ConcDomain +ContainDomain +EscapeDomain +FlagModeDomain +LockDomain +StackDomain +FileDomain +SpecDomain +LvalMapDomain + +} + +{3 General Lattice Functors} + +{!modules: +Lattice +Printable +MapDomain +PartitionDomain +SetDomain +Queries +Glob +} + +{2 Analyses} +{!modules: +MCP +Base +Spec + +CondVars +Contain +Deadlock +DeadlocksByRaces +Depbase +Depmutex +FileUse +Flag +FlagModes +ImpVar +Malloc_null +MayLocks +MTFlag +Mutex +Region +Shapes +StackTrace +SymbLocks +Termination +ThreadEscape +Thread +Uninit +Unit +VarDep +VarEq + +LibraryFunctions +} + +{9 Indexes} + +{!indexlist} diff --git a/src/maingoblint.ml b/src/maingoblint.ml index 717773d0932..1af5971c6a1 100644 --- a/src/maingoblint.ml +++ b/src/maingoblint.ml @@ -53,7 +53,7 @@ let rec option_spec_list: Arg_complete.speclist Lazy.t = lazy ( let add_string l = let f str = l := str :: !l in Arg_complete.String (f, Arg_complete.empty) in let add_int l = let f str = l := str :: !l in Arg_complete.Int (f, Arg_complete.empty) in let set_trace sys = - if Messages.tracing then Goblint_tracing.addsystem sys + if Messages.tracing then Tracing.addsystem sys else (prerr_endline "Goblint has been compiled without tracing, recompile in trace profile (./scripts/trace_on.sh)"; raise Stdlib.Exit) in let configure_html () = @@ -112,8 +112,8 @@ let rec option_spec_list: Arg_complete.speclist Lazy.t = lazy ( ; "--print_options" , Arg_complete.Unit (fun () -> Options.print_options (); exit 0), "" ; "--print_all_options" , Arg_complete.Unit (fun () -> Options.print_all_options (); exit 0), "" ; "--trace" , Arg_complete.String (set_trace, Arg_complete.empty), "" - ; "--tracevars" , add_string Goblint_tracing.tracevars, "" - ; "--tracelocs" , add_int Goblint_tracing.tracelocs, "" + ; "--tracevars" , add_string Tracing.tracevars, "" + ; "--tracelocs" , add_int Tracing.tracelocs, "" ; "--help" , Arg_complete.Unit (fun _ -> print_help stdout),"" ; "--html" , Arg_complete.Unit (fun _ -> configure_html ()),"" ; "--sarif" , Arg_complete.Unit (fun _ -> configure_sarif ()),"" @@ -163,14 +163,7 @@ let check_arguments () = ^ String.concat " and " @@ List.map (fun s -> "'" ^ s ^ "'") imprecise_options) ); if get_bool "solvers.td3.space" && get_bool "solvers.td3.remove-wpoint" then fail "solvers.td3.space is incompatible with solvers.td3.remove-wpoint"; - if get_bool "solvers.td3.space" && get_string "solvers.td3.side_widen" = "sides-local" then fail "solvers.td3.space is incompatible with solvers.td3.side_widen = 'sides-local'"; - if List.mem "termination" @@ get_string_list "ana.activated" then ( - if GobConfig.get_bool "incremental.load" || GobConfig.get_bool "incremental.save" then fail "termination analysis is not compatible with incremental analysis"; - set_list "ana.activated" (GobConfig.get_list "ana.activated" @ [`String ("threadflag")]); - set_string "sem.int.signed_overflow" "assume_none"; - warn "termination analysis implicitly activates threadflag analysis and set sem.int.signed_overflow to assume_none"; - ); - if not (get_bool "ana.sv-comp.enabled") && get_bool "witness.graphml.enabled" then fail "witness.graphml.enabled: cannot generate GraphML witness without SV-COMP mode (ana.sv-comp.enabled)" + if get_bool "solvers.td3.space" && get_string "solvers.td3.side_widen" = "sides-local" then fail "solvers.td3.space is incompatible with solvers.td3.side_widen = 'sides-local'" (** Initialize some globals in other modules. *) let handle_flags () = @@ -194,10 +187,10 @@ let handle_flags () = let handle_options () = check_arguments (); + AfterConfig.run (); Sys.set_signal (GobSys.signal_of_string (get_string "dbg.solver-signal")) Signal_ignore; (* Ignore solver-signal before solving (e.g. MyCFG), otherwise exceptions self-signal the default, which crashes instead of printing backtrace. *) - if AutoTune.isActivated "memsafetySpecification" && get_string "ana.specification" <> "" then + if AutoTune.isActivated "specification" && get_string "ana.specification" <> "" then AutoTune.focusOnMemSafetySpecification (); - AfterConfig.run (); Cilfacade.init_options (); handle_flags () @@ -265,15 +258,6 @@ let preprocess_files () = (* Preprocessor flags *) let cppflags = ref (get_string_list "pre.cppflags") in - if get_bool "ana.sv-comp.enabled" then ( - let architecture_flag = match get_string "exp.architecture" with - | "32bit" -> "-m32" - | "64bit" -> "-m64" - | _ -> assert false - in - cppflags := architecture_flag :: !cppflags - ); - (* the base include directory *) (* TODO: any better way? dune executable promotion doesn't add _build sites *) let source_lib_dirs = @@ -505,7 +489,7 @@ let merge_parsed parsed = Cilfacade.current_file := merged_AST; (* Set before createCFG, so Cilfacade maps can be computed for loop unrolling. *) CilCfg.createCFG merged_AST; (* Create CIL CFG from CIL AST. *) - Cilfacade.reset_lazy ~keepupjumpinggotos:true (); (* Reset Cilfacade maps, which need to be recomputer after loop unrolling but keep gotos. *) + Cilfacade.reset_lazy (); (* Reset Cilfacade maps, which need to be recomputer after loop unrolling. *) merged_AST let preprocess_parse_merge () = @@ -516,7 +500,7 @@ let preprocess_parse_merge () = let do_stats () = if get_bool "dbg.timing.enabled" then ( print_newline (); - Goblint_solver.SolverStats.print (); + SolverStats.print (); print_newline (); print_string "Timings:\n"; Timing.Default.print (Stdlib.Format.formatter_of_out_channel @@ Messages.get_out "timing" Legacy.stderr); @@ -524,7 +508,7 @@ let do_stats () = ) let reset_stats () = - Goblint_solver.SolverStats.reset (); + SolverStats.reset (); Timing.Default.reset (); Timing.Program.reset () diff --git a/src/mainspec.ml b/src/mainspec.ml new file mode 100644 index 00000000000..4509645f98b --- /dev/null +++ b/src/mainspec.ml @@ -0,0 +1,13 @@ +open Goblint_lib +open Batteries (* otherwise open_in would return wrong type for SpecUtil *) +open SpecUtil + +let _ = + (* no arguments -> run interactively (= reading from stdin) *) + let args = Array.length Sys.argv > 1 in + if args && Sys.argv.(1) = "-" then + ignore(parse ~dot:true stdin) + else + let cin = if args then open_in Sys.argv.(1) else stdin in + ignore(parse ~repl:(not args) ~print:true cin) +(* exit 0 *) diff --git a/src/solver/dune b/src/solver/dune deleted file mode 100644 index bd6d7a4d0ae..00000000000 --- a/src/solver/dune +++ /dev/null @@ -1,23 +0,0 @@ -(include_subdirs no) - -(library - (name goblint_solver) - (public_name goblint.solver) - (libraries - batteries.unthreaded - goblint_std - goblint_common - goblint_config - goblint_domain - goblint_constraint - goblint_incremental - goblint-cil) - (flags :standard -open Goblint_std) - (preprocess - (pps - ppx_deriving.std - ppx_deriving_hash - ppx_deriving_yojson)) - (instrumentation (backend bisect_ppx))) - -(documentation) diff --git a/src/solver/goblint_solver.ml b/src/solver/goblint_solver.ml deleted file mode 100644 index 0a264d7dea6..00000000000 --- a/src/solver/goblint_solver.ml +++ /dev/null @@ -1,31 +0,0 @@ -(** Generic solvers for {{!ConstrSys.MonSystem} (side-effecting) constraint systems}. *) - -(** {1 Top-down} - - The top-down solver family. *) - -module Td3 = Td3 -module TopDown = TopDown -module TopDown_term = TopDown_term -module TopDown_space_cache_term = TopDown_space_cache_term -module TopDown_deprecated = TopDown_deprecated - -(** {1 SLR} - - The SLR solver family. *) - -module SLRphased = SLRphased -module SLRterm = SLRterm -module SLR = SLR - -(** {1 Other} *) - -module EffectWConEq = EffectWConEq -module Worklist = Worklist -module Generic = Generic -module Selector = Selector - -module PostSolver = PostSolver -module LocalFixpoint = LocalFixpoint -module SolverStats = SolverStats -module SolverBox = SolverBox diff --git a/src/solver/effectWConEq.ml b/src/solvers/effectWConEq.ml similarity index 95% rename from src/solver/effectWConEq.ml rename to src/solvers/effectWConEq.ml index 3cca6361b4f..c6dcf8f0e97 100644 --- a/src/solver/effectWConEq.ml +++ b/src/solvers/effectWConEq.ml @@ -1,7 +1,8 @@ (** ([effectWConEq]). *) open Batteries -open ConstrSys +open Analyses +open Constraints module Make = functor (S:EqConstrSys) -> @@ -87,4 +88,4 @@ module Make = end let _ = - Selector.add_solver ("effectWConEq", (module PostSolver.EqIncrSolverFromEqSolver (Make))); + Selector.add_solver ("effectWConEq", (module EqIncrSolverFromEqSolver (Make))); diff --git a/src/solver/generic.ml b/src/solvers/generic.ml similarity index 99% rename from src/solver/generic.ml rename to src/solvers/generic.ml index 636aed8831e..2569341dd13 100644 --- a/src/solver/generic.ml +++ b/src/solvers/generic.ml @@ -2,7 +2,7 @@ open Batteries open GobConfig -open ConstrSys +open Analyses module LoadRunSolver: GenericEqSolver = functor (S: EqConstrSys) (VH: Hashtbl.S with type key = S.v) -> @@ -30,7 +30,7 @@ module LoadRunSolver: GenericEqSolver = end module LoadRunIncrSolver: GenericEqIncrSolver = - PostSolver.EqIncrSolverFromEqSolver (LoadRunSolver) + Constraints.EqIncrSolverFromEqSolver (LoadRunSolver) module SolverStats (S:EqConstrSys) (HM:Hashtbl.S with type key = S.v) = struct diff --git a/src/solver/localFixpoint.ml b/src/solvers/localFixpoint.ml similarity index 100% rename from src/solver/localFixpoint.ml rename to src/solvers/localFixpoint.ml diff --git a/src/solver/postSolver.ml b/src/solvers/postSolver.ml similarity index 92% rename from src/solver/postSolver.ml rename to src/solvers/postSolver.ml index 7f4f9c2b1fe..f96ca832a11 100644 --- a/src/solver/postSolver.ml +++ b/src/solvers/postSolver.ml @@ -1,10 +1,9 @@ (** Extra constraint system evaluation pass for warning generation, verification, pruning, etc. *) open Batteries -open ConstrSys +open Analyses open GobConfig module Pretty = GoblintCil.Pretty -module M = Messages (** Postsolver with hooks. *) module type S = @@ -155,7 +154,13 @@ struct module VH = Hashtbl.Make (S.Var) (* starts as Hashtbl for quick lookup *) - let starth = VH.of_list S.starts + let starth = + (* VH.of_list S.starts *) (* TODO: BatHashtbl.Make.of_list is broken, use after new Batteries release *) + let starth = VH.create (List.length S.starts) in + List.iter (fun (x, d) -> + VH.replace starth x d + ) S.starts; + starth let system x = match S.system x, VH.find_option starth x with @@ -316,22 +321,3 @@ struct |> List.map snd |> List.map (fun (module F: F) -> (module F (S) (VH): M)) end - -(* Here to avoid module cycle between ConstrSys and PostSolver. *) -(** Convert a non-incremental solver into an "incremental" solver. - It will solve from scratch, perform standard postsolving and have no marshal data. *) -module EqIncrSolverFromEqSolver (Sol: GenericEqSolver): GenericEqIncrSolver = - functor (Arg: IncrSolverArg) (S: EqConstrSys) (VH: Hashtbl.S with type key = S.v) -> - struct - module Sol = Sol (S) (VH) - module Post = MakeList (ListArgFromStdArg (S) (VH) (Arg)) - - type marshal = unit - let copy_marshal () = () - let relift_marshal () = () - - let solve xs vs _ = - let vh = Sol.solve xs vs in - Post.post xs vs vh; - (vh, ()) - end diff --git a/src/solver/sLR.ml b/src/solvers/sLR.ml similarity index 91% rename from src/solver/sLR.ml rename to src/solvers/sLR.ml index d05d87c4f36..4904731b610 100644 --- a/src/solver/sLR.ml +++ b/src/solvers/sLR.ml @@ -3,7 +3,8 @@ @see Apinis, K. Frameworks for analyzing multi-threaded C. *) open Batteries -open ConstrSys +open Analyses +open Constraints open Messages let narrow f = if GobConfig.get_bool "exp.no-narrow" then (fun a b -> a) else f @@ -521,29 +522,29 @@ let _ = let module W1 = JustWiden (struct let ver = 1 end) in let module W2 = JustWiden (struct let ver = 2 end) in let module W3 = JustWiden (struct let ver = 3 end) in - Selector.add_solver ("widen1", (module PostSolver.EqIncrSolverFromEqSolver (W1))); - Selector.add_solver ("widen2", (module PostSolver.EqIncrSolverFromEqSolver (W2))); - Selector.add_solver ("widen3", (module PostSolver.EqIncrSolverFromEqSolver (W3))); + Selector.add_solver ("widen1", (module EqIncrSolverFromEqSolver (W1))); + Selector.add_solver ("widen2", (module EqIncrSolverFromEqSolver (W2))); + Selector.add_solver ("widen3", (module EqIncrSolverFromEqSolver (W3))); let module S2 = TwoPhased (struct let ver = 1 end) in - Selector.add_solver ("two", (module PostSolver.EqIncrSolverFromEqSolver (S2))); + Selector.add_solver ("two", (module EqIncrSolverFromEqSolver (S2))); let module S1 = Make (struct let ver = 1 end) in - Selector.add_solver ("new", (module PostSolver.EqIncrSolverFromEqSolver (S1))); - Selector.add_solver ("slr+", (module PostSolver.EqIncrSolverFromEqSolver (S1))) + Selector.add_solver ("new", (module EqIncrSolverFromEqSolver (S1))); + Selector.add_solver ("slr+", (module EqIncrSolverFromEqSolver (S1))) let _ = let module S1 = Make (struct let ver = 1 end) in let module S2 = Make (struct let ver = 2 end) in let module S3 = SLR3 in let module S4 = Make (struct let ver = 4 end) in - Selector.add_solver ("slr1", (module PostSolver.EqIncrSolverFromEqSolver (S1))); (* W&N at every program point *) - Selector.add_solver ("slr2", (module PostSolver.EqIncrSolverFromEqSolver (S2))); (* W&N dynamic at certain points, growing number of W-points *) - Selector.add_solver ("slr3", (module PostSolver.EqIncrSolverFromEqSolver (S3))); (* same as S2 but number of W-points may also shrink *) - Selector.add_solver ("slr4", (module PostSolver.EqIncrSolverFromEqSolver (S4))); (* restarting: set influenced variables to bot and start up-iteration instead of narrowing *) + Selector.add_solver ("slr1", (module EqIncrSolverFromEqSolver (S1))); (* W&N at every program point *) + Selector.add_solver ("slr2", (module EqIncrSolverFromEqSolver (S2))); (* W&N dynamic at certain points, growing number of W-points *) + Selector.add_solver ("slr3", (module EqIncrSolverFromEqSolver (S3))); (* same as S2 but number of W-points may also shrink *) + Selector.add_solver ("slr4", (module EqIncrSolverFromEqSolver (S4))); (* restarting: set influenced variables to bot and start up-iteration instead of narrowing *) let module S1p = PrintInfluence (Make (struct let ver = 1 end)) in let module S2p = PrintInfluence (Make (struct let ver = 2 end)) in let module S3p = PrintInfluence (Make (struct let ver = 3 end)) in let module S4p = PrintInfluence (Make (struct let ver = 4 end)) in - Selector.add_solver ("slr1p", (module PostSolver.EqIncrSolverFromEqSolver (S1p))); (* same as S1-4 above but with side-effects *) - Selector.add_solver ("slr2p", (module PostSolver.EqIncrSolverFromEqSolver (S2p))); - Selector.add_solver ("slr3p", (module PostSolver.EqIncrSolverFromEqSolver (S3p))); - Selector.add_solver ("slr4p", (module PostSolver.EqIncrSolverFromEqSolver (S4p))); + Selector.add_solver ("slr1p", (module EqIncrSolverFromEqSolver (S1p))); (* same as S1-4 above but with side-effects *) + Selector.add_solver ("slr2p", (module EqIncrSolverFromEqSolver (S2p))); + Selector.add_solver ("slr3p", (module EqIncrSolverFromEqSolver (S3p))); + Selector.add_solver ("slr4p", (module EqIncrSolverFromEqSolver (S4p))); diff --git a/src/solver/sLRphased.ml b/src/solvers/sLRphased.ml similarity index 98% rename from src/solver/sLRphased.ml rename to src/solvers/sLRphased.ml index 17571f0138a..c120a7bc6c6 100644 --- a/src/solver/sLRphased.ml +++ b/src/solvers/sLRphased.ml @@ -1,7 +1,8 @@ (** Two-phased terminating SLR3 solver ([slr3tp]). *) open Batteries -open ConstrSys +open Analyses +open Constraints open Messages open SLR @@ -204,4 +205,4 @@ module Make = end let _ = - Selector.add_solver ("slr3tp", (module PostSolver.EqIncrSolverFromEqSolver (Make))); (* two-phased slr3t *) + Selector.add_solver ("slr3tp", (module EqIncrSolverFromEqSolver (Make))); (* two-phased slr3t *) diff --git a/src/solver/sLRterm.ml b/src/solvers/sLRterm.ml similarity index 97% rename from src/solver/sLRterm.ml rename to src/solvers/sLRterm.ml index 8ec34c7dc27..eb11447d11e 100644 --- a/src/solver/sLRterm.ml +++ b/src/solvers/sLRterm.ml @@ -2,7 +2,8 @@ Simpler version of {!SLRphased} without phases. *) open Batteries -open ConstrSys +open Analyses +open Constraints open Messages open SLR @@ -223,4 +224,4 @@ module SLR3term = end let _ = - Selector.add_solver ("slr3t", (module PostSolver.EqIncrSolverFromEqSolver (SLR3term))); (* same as S2 but number of W-points may also shrink + terminating? *) + Selector.add_solver ("slr3t", (module EqIncrSolverFromEqSolver (SLR3term))); (* same as S2 but number of W-points may also shrink + terminating? *) diff --git a/src/solver/selector.ml b/src/solvers/selector.ml similarity index 99% rename from src/solver/selector.ml rename to src/solvers/selector.ml index 854b8e10369..664cbe05131 100644 --- a/src/solver/selector.ml +++ b/src/solvers/selector.ml @@ -1,7 +1,7 @@ (** Solver, which delegates at runtime to the configured solver. *) open Batteries -open ConstrSys +open Analyses open GobConfig (* Registered solvers. *) diff --git a/src/solver/solverBox.ml b/src/solvers/solverBox.ml similarity index 100% rename from src/solver/solverBox.ml rename to src/solvers/solverBox.ml diff --git a/src/solver/solverStats.ml b/src/solvers/solverStats.ml similarity index 100% rename from src/solver/solverStats.ml rename to src/solvers/solverStats.ml diff --git a/src/solver/td3.ml b/src/solvers/td3.ml similarity index 99% rename from src/solver/td3.ml rename to src/solvers/td3.ml index 54b7520cd62..07edc632c75 100644 --- a/src/solver/td3.ml +++ b/src/solvers/td3.ml @@ -15,11 +15,9 @@ *) open Batteries -open ConstrSys +open Analyses open Messages -module M = Messages - module type Hooks = sig module S: EqConstrSys @@ -194,7 +192,7 @@ module Base = type phase = Widen | Narrow [@@deriving show] (* used in inner solve *) - module CurrentVarS = ConstrSys.CurrentVarEqConstrSys (S) + module CurrentVarS = Constraints.CurrentVarEqConstrSys (S) module S = CurrentVarS.S let solve st vs marshal = diff --git a/src/solver/topDown.ml b/src/solvers/topDown.ml similarity index 98% rename from src/solver/topDown.ml rename to src/solvers/topDown.ml index f7da560057c..c6b20d28db2 100644 --- a/src/solver/topDown.ml +++ b/src/solvers/topDown.ml @@ -2,7 +2,8 @@ Simpler version of {!Td3} without terminating, space-efficiency and incremental. *) open Batteries -open ConstrSys +open Analyses +open Constraints open Messages module WP = @@ -154,4 +155,4 @@ module WP = end let _ = - Selector.add_solver ("topdown", (module PostSolver.EqIncrSolverFromEqSolver (WP))); + Selector.add_solver ("topdown", (module EqIncrSolverFromEqSolver (WP))); diff --git a/src/solver/topDown_deprecated.ml b/src/solvers/topDown_deprecated.ml similarity index 97% rename from src/solver/topDown_deprecated.ml rename to src/solvers/topDown_deprecated.ml index 4e9799cf78b..1f512444583 100644 --- a/src/solver/topDown_deprecated.ml +++ b/src/solvers/topDown_deprecated.ml @@ -1,7 +1,8 @@ (** Deprecated top-down solver ([topdown_deprecated]). *) open Batteries -open ConstrSys +open Analyses +open Constraints open Messages exception SolverCannotDoGlobals @@ -163,4 +164,4 @@ module TD3 = end let _ = - Selector.add_solver ("topdown_deprecated", (module PostSolver.EqIncrSolverFromEqSolver (TD3))); + Selector.add_solver ("topdown_deprecated", (module EqIncrSolverFromEqSolver (TD3))); diff --git a/src/solver/topDown_space_cache_term.ml b/src/solvers/topDown_space_cache_term.ml similarity index 98% rename from src/solver/topDown_space_cache_term.ml rename to src/solvers/topDown_space_cache_term.ml index f6c256517c4..a78d90559d7 100644 --- a/src/solver/topDown_space_cache_term.ml +++ b/src/solvers/topDown_space_cache_term.ml @@ -2,7 +2,8 @@ Simpler version of {!Td3} without incremental. *) open Batteries -open ConstrSys +open Analyses +open Constraints open Messages module WP = @@ -196,4 +197,4 @@ module WP = end let _ = - Selector.add_solver ("topdown_space_cache_term", (module PostSolver.EqIncrSolverFromEqSolver (WP))); + Selector.add_solver ("topdown_space_cache_term", (module EqIncrSolverFromEqSolver (WP))); diff --git a/src/solver/topDown_term.ml b/src/solvers/topDown_term.ml similarity index 97% rename from src/solver/topDown_term.ml rename to src/solvers/topDown_term.ml index d15493b5a19..ec07995586e 100644 --- a/src/solver/topDown_term.ml +++ b/src/solvers/topDown_term.ml @@ -2,7 +2,8 @@ Simpler version of {!Td3} without space-efficiency and incremental. *) open Batteries -open ConstrSys +open Analyses +open Constraints open Messages module WP = @@ -133,4 +134,4 @@ module WP = end let _ = - Selector.add_solver ("topdown_term", (module PostSolver.EqIncrSolverFromEqSolver (WP))); + Selector.add_solver ("topdown_term", (module EqIncrSolverFromEqSolver (WP))); diff --git a/src/solver/worklist.ml b/src/solvers/worklist.ml similarity index 93% rename from src/solver/worklist.ml rename to src/solvers/worklist.ml index b1a5d7e8343..b525764c74b 100644 --- a/src/solver/worklist.ml +++ b/src/solvers/worklist.ml @@ -1,7 +1,8 @@ (** Worklist solver ([WL]). *) open Batteries -open ConstrSys +open Analyses +open Constraints module Make = functor (S:EqConstrSys) -> @@ -62,4 +63,4 @@ module Make = let _ = - Selector.add_solver ("WL", (module PostSolver.EqIncrSolverFromEqSolver (Make))); + Selector.add_solver ("WL", (module EqIncrSolverFromEqSolver (Make))); diff --git a/src/spec/dune b/src/spec/dune new file mode 100644 index 00000000000..47c22a0d464 --- /dev/null +++ b/src/spec/dune @@ -0,0 +1,2 @@ +(ocamllex specLexer) +(ocamlyacc specParser) diff --git a/src/spec/file.dot b/src/spec/file.dot new file mode 100644 index 00000000000..a78c64d3fc3 --- /dev/null +++ b/src/spec/file.dot @@ -0,0 +1,37 @@ +digraph file { + // changed file pointer {fp} (no longer safe) + + // file handle is not saved! + // overwriting still opened file handle + // file is never closed + // file may be never closed + // closeing unopened file handle + // closeing already closed file handle + // writing to closed file handle + // writing to unopened file handle + // writing to read-only file handle + + // unclosed files: ... + // maybe unclosed files: ... + + w1 [label="file handle is not saved!"]; + w2 [label="closeing unopened file handle"]; + w3 [label="writing to unopened file handle"]; + w4 [label="writing to read-only file handle"]; + w5 [label="closeing already closed file handle"]; + w6 [label="writing to closed file handle"]; + + 1 -> w1 [label="fopen(_)"]; + 1 -> w2 [label="fclose($fp)"]; + 1 -> w3 [label="fprintf($fp, _)"]; + 1 -> open_read [label="$fp = fopen($path, \"r\")"]; + 1 -> open_write [label="$fp = fopen($path, \"w\")"]; + 1 -> open_write [label="$fp = fopen($path, \"a\")"]; + open_read -> w4 [label="fprintf($fp, _)"]; + open_write -> open_write [label="fprintf($fp, _)"]; + open_read -> closed [label="fclose($fp)"]; + open_write -> closed [label="fclose($fp)"]; + closed -> w5 [label="fclose($fp)"]; + closed -> w6 [label="fprintf($fp, _)"]; + closed -> 1 [label="->"]; +} \ No newline at end of file diff --git a/src/spec/render.sh b/src/spec/render.sh new file mode 100755 index 00000000000..91e486c247e --- /dev/null +++ b/src/spec/render.sh @@ -0,0 +1,31 @@ +# command -v ls >&- || {echo >&2 bla; exit 1;} +function check(){ + set -e # needed to exit script from function + hash $1 2>&- || (echo >&2 "$1 is needed but not installed! $2"; exit 1;) + set +e # do not exit shell if some command fails (default) +} +check dot +mode=${1-"png"} +file=${2-"file"} +dst=graph +viewcmd=gpicview + +mkdir -p ${dst} +cp ${file}.dot ${dst} +file=${file##*/} # use basename in case the file was somewhere else +cd ${dst} +trap 'cd ..' EXIT # leave dst again on exit +case "$mode" in + png) dot -Tpng -o${file}.png ${file}.dot; + check ${viewcmd} "Please edit viewcmd accordingly." + pkill ${viewcmd}; + ${viewcmd} ${file}.png & + ;; + pdf) rm -f ${file}.tex; + check dot2tex + dot -Txdot ${file}.dot | dot2tex > ${file}.tex; + check pdflatex + pdflatex ${file}.tex + echo "generated $dst/$file.pdf" + ;; +esac diff --git a/src/spec/specCore.ml b/src/spec/specCore.ml new file mode 100644 index 00000000000..9d0ce356246 --- /dev/null +++ b/src/spec/specCore.ml @@ -0,0 +1,152 @@ +(* types used by specParser and functions for handling the constructed types *) + +open Batteries + +exception Endl +exception Eof + +(* type value = String of string | Bool of bool | Int of int | Float of float *) +type lval = Ptr of lval | Var of string | Ident of string +type fcall = {fname: string; args: exp list} +and exp = + Fun of fcall | + Exp_ | + Lval of lval | + Regex of string | + String of string | Bool of bool | Int of int | Float of float | + Binop of string * exp * exp | + Unop of string * exp +type stmt = {lval: lval option; exp: exp} +type def = Node of (string * string) (* node warning *) + | Edge of (string * string list * bool * string * stmt) (* start-node, warning-nodes, forwarding, target-node, constraint *) + +(* let stmts edges = List.map (fun (a,b,c) -> c) edges + let get_fun stmt = match stmt.exp with Fun x -> Some x | _ -> None + let fun_records edges = List.filter_map get_fun (stmts edges) + let fun_names edges = fun_records edges |> List.map (fun x -> x.fname) + let fun_by_fname fname edges = List.filter (fun x -> x.fname=fname) (fun_records edges) *) +let fname_is fname stmt = + match stmt.exp with + | Fun x -> x.fname=fname + | _ -> false + +let is_wildcard stmt = stmt.exp = Exp_ + +let branch_exp stmt = + match stmt.exp with + | Fun { fname="branch"; args=[exp; Bool tv] } -> Some (exp,tv) + | _ -> None + +let is_branch stmt = branch_exp stmt <> None + +let startnode edges = + (* The start node of the first transition is the start node of the automaton. *) + let a,ws,fwd,b,c = List.hd edges in a + +let warning state nodes = + try + Some (snd (List.find (fun x -> fst x = state) nodes)) (* find node for state and return its warning *) + with + | Not_found -> None (* no node for state *) + +let get_lval stmt = + let f = function + | Ptr x -> `Ptr (* TODO recursive *) + | Var s -> `Var + | Ident s -> `Ident + in + Option.map f stmt.lval + +let get_exp = function + | Regex x -> `Regex x + | String x -> `String x + | Bool x -> `Bool x + | Int x -> `Int x + | Float x -> `Float x + | Lval (Var x) -> `Var x + | Lval (Ident x) -> `Ident x + | Fun x -> `Error "Functions aren't allowed to have functions as an argument (put the function as a previous state instead)" + | Exp_ -> `Free + | Unop ("!", Bool x) -> `Bool (not x) + | _ -> `Error "Unsupported operation inside function argument, use a simpler expression instead." + +let get_rval stmt = get_exp stmt.exp + +let get_key_variant stmt = + let rec get_from_exp = function + | Fun f -> get_from_args f.args (* TODO for special we only consider constraints where the root of the exp is Fun (see fname_is) *) + | Lval (Var s) -> `Rval s + | _ -> `None + (* walks over arguments until it finds something or returns `None *) + and get_from_argsi i = function + | [] -> `None + | x::xs -> + match get_from_exp x with + | `Rval s -> `Arg(s, i) + | _ -> get_from_argsi (i+1) xs (* matches `None and `Arg -> `Arg of `Arg not supported *) + and get_from_args args = get_from_argsi 0 args (* maybe better use List.findi *) + in + let rec get_from_lval = function + | Ptr x -> get_from_lval x + | Var s -> Some s + | Ident s -> None + in + match stmt.lval with + | Some lval when Option.is_some (get_from_lval lval) -> `Lval (Option.get (get_from_lval lval)) + | _ -> get_from_exp stmt.exp + +let equal_form lval stmt = + match lval, stmt.lval with + | Some _, Some _ + | None, None -> true + | _ -> false + +(* get function arguments with tags corresponding to the type -> should only be called for functions, returns [] for everything else *) +let get_fun_args stmt = match stmt.exp with + | Fun f -> List.map get_exp f.args + | _ -> [] + +(* functions for output *) +let rec lval_to_string = function + | Ptr x -> "*"^(lval_to_string x) + | Var x -> "$"^x + | Ident x -> x +let rec exp_to_string = function + | Fun x -> x.fname^"("^String.concat ", " (List.map exp_to_string x.args)^")" + | Exp_ -> "_" + | Lval x -> lval_to_string x + | Regex x -> "r\""^x^"\"" + | String x -> "\""^x^"\"" + | Bool x -> string_of_bool x + | Int x -> string_of_int x + | Float x -> string_of_float x + | Binop (op, a, b) -> exp_to_string a ^ " " ^ op ^ " " ^ exp_to_string b + | Unop (op, a) -> op ^ " " ^ exp_to_string a +let stmt_to_string stmt = match stmt.lval, stmt.exp with + | Some lval, exp -> lval_to_string lval^" = "^exp_to_string exp + | None, exp -> exp_to_string exp +let arrow_to_string ws fwd = (String.concat "," ws)^if fwd then ">" else "" +let def_to_string = function + | Node(n, m) -> n^"\t\""^m^"\"" + | Edge(a, ws, fwd, b, s) -> a^" -"^arrow_to_string ws fwd^"> "^b^"\t"^stmt_to_string s + +let to_dot_graph defs = + let no_warnings = true in + let def_to_string = function + | Node(n, m) -> + if no_warnings then "" + else n^"\t[style=filled, fillcolor=orange, label=\""^n^": "^m^"\"];" + | Edge(a, ws, fwd, b, s) -> + let style = if fwd then "style=dotted, " else "" in + let ws = if List.is_empty ws then "" else (String.concat "," ws)^" | " in + a^" -> "^b^"\t["^style^"label=\""^ws^String.escaped (stmt_to_string s)^"\"];" + in + let ends,defs = List.partition (function Edge (a,ws,fwd,b,s) -> b="end" && s.exp=Exp_ | _ -> false) defs in + let endstates = List.filter_map (function Edge (a,ws,fwd,b,s) -> Some a | _ -> None) ends in + (* set the default style for nodes *) + let defaultstyle = "node [shape=box, style=rounded];" in + (* style end nodes and then reset *) + let endstyle = if List.is_empty endstates then "" else "node [peripheries=2]; "^(String.concat " " endstates)^"; node [peripheries=1];" in + let lines = "digraph file {"::defaultstyle::endstyle::(List.map def_to_string defs |> List.filter (fun s -> s<>"")) in + (* List.iter print_endline lines *) + String.concat "\n " lines ^ "\n}" diff --git a/src/spec/specLexer.mll b/src/spec/specLexer.mll new file mode 100644 index 00000000000..64ac69359ec --- /dev/null +++ b/src/spec/specLexer.mll @@ -0,0 +1,67 @@ +{ + open SpecParser (* The type token is defined in specParser.mli *) + exception Token of string + let line = ref 1 +} + +let digit = ['0'-'9'] +let alpha = ['a'-'z' 'A'-'Z'] +let nl = '\r'?'\n' (* new line *) +let s = [' ' '\t'] (* whitespace *) +let w = '_' | alpha | digit (* word *) +let endlinecomment = "//" [^'\n']* +let multlinecomment = "/*"([^'*']|('*'+[^'*''/'])|nl)*'*'+'/' +let comments = endlinecomment | multlinecomment +let str = ('\"'(([^'\"']|"\\\"")* as s)'\"') | ('\''(([^'\'']|"\\'")* as s)'\'') + +rule token = parse + | s { token lexbuf } (* skip blanks *) + | comments { token lexbuf } (* skip comments *) + | nl { incr line; EOL } + + (* operators *) + | '(' { LPAREN } + | ')' { RPAREN } + | '[' { LBRACK } + | ']' { RBRACK } + | '{' { LCURL } + | '}' { RCURL } + (*| '.' { DOT } *) + (*| "->" { ARROW } *) + | '+' { PLUS } + | '-' { MINUS } + | '*' { MUL } + | '/' { DIV } + | '%' { MOD } + | '<' { LT } + | '>' { GT } + | "==" { EQEQ } + | "!=" { NE } + | "<=" { LE } + | ">=" { GE } + | "&&" { AND } + | "||" { OR } + | '!' { NOT } + | '=' { EQ } + | ',' { COMMA } + | ';' { SEMICOLON } + + (* literals, identifiers *) + | "true" { BOOL(true) } + | "false" { BOOL(false) } + | "null" { NULL } + | digit+ as x { INT(int_of_string x) } + | str { STRING(s) } + | '_' { UNDERS } (* used for spec, but has to be before Ident! *) + | ('_'|alpha) w* as x { IDENT(x) } + + (* spec *) + | ':' { COLON } + | "$"(w+ as x) { VAR(x) } + | "r" str { REGEX(s) } + | (w+ as n) s+ str + { NODE(n, s) } + | (w+ as a) s* "-" ((w+ ("," w+)*)? as ws) (">"? as fwd) ">" s* (w+ as b) s+ + { EDGE(a, BatString.split_on_string ~by:"," ws, fwd=">", b) } + | eof { EOF } + | _ as x { raise(Token (Char.escaped x^": unknown token in line "^string_of_int !line)) } diff --git a/src/spec/specParser.mly b/src/spec/specParser.mly new file mode 100644 index 00000000000..fe8fe90ec87 --- /dev/null +++ b/src/spec/specParser.mly @@ -0,0 +1,116 @@ +%{ + (* necessary to open a different compilation unit + because exceptions directly defined here aren't visible outside + (e.g. SpecParser.Eof is raised, but Error: Unbound constructor + if used to catch in a different module) *) + open SpecCore +%} + +%token EOL EOF +/* operators */ +%token LPAREN RPAREN LCURL RCURL LBRACK RBRACK +%token PLUS MINUS MUL DIV MOD +%token LT GT EQEQ NE LE GE AND OR NOT +%token EQ COMMA SEMICOLON +/* literals, identifiers */ +%token BOOL +%token NULL +%token INT +%token STRING +%token IDENT +/* spec */ +%token UNDERS COLON +%token VAR +%token REGEX +%token NODE +%token EDGE + +/* precedence groups from low to high */ +%right EQ +%left OR +%left AND +%left EQEQ NE +%left LT GT LE GE +%left PLUS MINUS +%left MUL DIV MOD +%right NOT UPLUS UMINUS DEREF + +%start file +%type file + +%% + +file: + | def EOL { $1 } + | def EOF { $1 } /* no need for an empty line at the end */ + | EOL { raise Endl } /* empty line */ + | EOF { raise Eof } /* end of file */ +; + +def: + | NODE { Node($1) } + | EDGE stmt { let a, ws, fwd, b = $1 in Edge(a, ws, fwd, b, $2) } +; + +stmt: + | lval EQ expr { {lval = Some $1; exp = $3} } /* TODO expression would be better */ + | expr { {lval = None; exp = $1} } +; + +lval: + | MUL lval %prec DEREF { Ptr $2 } + | IDENT { Ident $1 } /* C identifier, e.g. foo, _foo, _1, but not 1b */ + | VAR { Var $1 } /* spec variable, e.g. $foo, $123, $__ */ +; + +expr: + | LPAREN expr RPAREN { $2 } + | REGEX { Regex $1 } + | STRING { String $1 } + | BOOL { Bool $1 } + | lval { Lval $1 } + | IDENT args { Fun {fname=$1; args=$2} } /* function */ + | UNDERS { Exp_ } + | nexpr { Int $1 } + /* | nexpr LT nexpr { Bool ($1<$3) } + | nexpr GT nexpr { Bool ($1>$3) } + | nexpr EQEQ nexpr { Bool ($1=$3) } + | nexpr NE nexpr { Bool ($1<>$3) } + | nexpr LE nexpr { Bool ($1<=$3) } + | nexpr GE nexpr { Bool ($1>=$3) } */ + | expr OR expr { Binop ("||", $1, $3) } + | expr AND expr { Binop ("&&", $1, $3) } + | expr EQEQ expr { Binop ("==", $1, $3) } + | expr NE expr { Binop ("!=", $1, $3) } + | expr LT expr { Binop ("<", $1, $3) } + | expr GT expr { Binop (">", $1, $3) } + | expr LE expr { Binop ("<=", $1, $3) } + | expr GE expr { Binop (">=", $1, $3) } + | expr PLUS expr { Binop ("+", $1, $3) } + | expr MINUS expr { Binop ("-", $1, $3) } + | expr MUL expr { Binop ("*", $1, $3) } + | expr DIV expr { Binop ("/", $1, $3) } + | expr MOD expr { Binop ("%", $1, $3) } + | NOT expr { Unop ("!", $2) } +; + +nexpr: + | INT { $1 } + | MINUS nexpr %prec UMINUS { - $2 } + | PLUS nexpr %prec UPLUS { $2 } + /* | LPAREN nexpr RPAREN { $2 } + | nexpr PLUS nexpr { $1 + $3 } + | nexpr MINUS nexpr { $1 - $3 } + | nexpr MUL nexpr { $1 * $3 } + | nexpr DIV nexpr { $1 / $3 } */ +; + +args: + | LPAREN RPAREN { [] } + | LPAREN expr_list RPAREN { $2 } +; + +expr_list: + | expr { [$1] } + | expr COMMA expr_list { $1 :: $3 } +; diff --git a/src/spec/specUtil.ml b/src/spec/specUtil.ml new file mode 100644 index 00000000000..55e0b51135f --- /dev/null +++ b/src/spec/specUtil.ml @@ -0,0 +1,52 @@ +(* functions for driving specParser *) + +open Batteries + +(* config *) +let save_dot = true + +let line = ref 1 +exception Parse_error of string + +let parse ?repl:(repl=false) ?print:(print=false) ?dot:(dot=false) cin = + let lexbuf = Lexing.from_channel cin in + let defs = ref [] in + (* Printf.printf "\nrepl: %B, print: %B, dot: %B, save_dot: %B\n" repl print dot save_dot; *) + try + while true do (* loop over all lines *) + try + let result = SpecParser.file SpecLexer.token lexbuf in + defs := !defs@[result]; + incr line; + if print then (print_endline (SpecCore.def_to_string result); flush stdout) + with + (* just an empty line -> don't print *) + | SpecCore.Endl -> incr line + (* somehow gets raised in some cases instead of SpecCore.Eof *) + | BatInnerIO.Input_closed -> raise SpecCore.Eof + (* catch and print in repl-mode *) + | e when repl -> print_endline (Printexc.to_string e) + done; + ([], []) (* never happens, but ocaml needs it for type *) + with + (* done *) + | SpecCore.Eof -> + let nodes = List.filter_map (function SpecCore.Node x -> Some x | _ -> None) !defs in + let edges = List.filter_map (function SpecCore.Edge x -> Some x | _ -> None) !defs in + if print then Printf.printf "\n#Definitions: %i, #Nodes: %i, #Edges: %i\n" + (List.length !defs) (List.length nodes) (List.length edges); + if save_dot && not dot then ( + let dotgraph = SpecCore.to_dot_graph !defs in + output_file ~filename:"result/graph.dot" ~text:dotgraph; + print_endline ("saved graph as "^Sys.getcwd ()^"/result/graph.dot"); + ); + if dot then ( + print_endline (SpecCore.to_dot_graph !defs) + ); + (nodes, edges) + (* stop on parsing error if not in REPL and include line number *) + | e -> raise (Parse_error ("Line "^string_of_int !line^": "^Printexc.to_string e)) + +let parseFile filename = parse (open_in filename) + +(* print ~first:"[" ~sep:", " ~last:"]" print_any stdout @@ 5--10 *) diff --git a/src/common/util/analysisStateUtil.ml b/src/util/analysisStateUtil.ml similarity index 100% rename from src/common/util/analysisStateUtil.ml rename to src/util/analysisStateUtil.ml diff --git a/src/util/cilCfg.ml b/src/util/cilCfg.ml index 923cf7600bb..2c8ec646c3a 100644 --- a/src/util/cilCfg.ml +++ b/src/util/cilCfg.ml @@ -42,7 +42,6 @@ let loopCount file = let createCFG (fileAST: file) = - Cilfacade.do_preprocess fileAST; (* The analyzer keeps values only for blocks. So if you want a value for every program point, each instruction *) (* needs to be in its own block. end_basic_blocks does that. *) (* After adding support for VLAs, there are new VarDecl instructions at the point where a variable was declared and *) @@ -50,7 +49,6 @@ let createCFG (fileAST: file) = (* BB causes the output CIL file to no longer compile. *) (* Since we want the output of justcil to compile, we do not run allBB visitor if justcil is enable, regardless of *) (* exp.basic-blocks. This does not matter, as we will not run any analysis anyway, when justcil is enabled. *) - (* the preprocessing must be done here, to add the changes of CIL to the CFG*) if not (get_bool "exp.basic-blocks") && not (get_bool "justcil") then end_basic_blocks fileAST; (* We used to renumber vids but CIL already generates them fresh, so no need. @@ -68,4 +66,6 @@ let createCFG (fileAST: file) = computeCFGInfo fd true | _ -> () ); - if get_bool "dbg.run_cil_check" then assert (Check.checkFile [] fileAST); \ No newline at end of file + if get_bool "dbg.run_cil_check" then assert (Check.checkFile [] fileAST); + + Cilfacade.do_preprocess fileAST diff --git a/src/incremental/cilMaps.ml b/src/util/cilMaps.ml similarity index 100% rename from src/incremental/cilMaps.ml rename to src/util/cilMaps.ml diff --git a/src/common/util/contextUtil.ml b/src/util/contextUtil.ml similarity index 100% rename from src/common/util/contextUtil.ml rename to src/util/contextUtil.ml diff --git a/src/common/util/intOps.ml b/src/util/intOps.ml similarity index 100% rename from src/common/util/intOps.ml rename to src/util/intOps.ml diff --git a/src/util/library/dune b/src/util/library/dune deleted file mode 100644 index c7797db33f9..00000000000 --- a/src/util/library/dune +++ /dev/null @@ -1,19 +0,0 @@ -(include_subdirs no) - -(library - (name goblint_library) - (public_name goblint.library) - (wrapped false) ; TODO: wrap - (libraries - batteries.unthreaded - goblint_common - goblint_domain - goblint_config - goblint-cil) - (preprocess - (pps - ppx_deriving.std - ppx_deriving_hash)) - (instrumentation (backend bisect_ppx))) - -(documentation) diff --git a/src/util/library/library.mld b/src/util/library/library.mld deleted file mode 100644 index f55db3f2ff9..00000000000 --- a/src/util/library/library.mld +++ /dev/null @@ -1,14 +0,0 @@ -{0 Library goblint.library} -This library is unwrapped and provides the following top-level modules. -For better context, see {!Goblint_lib} which also documents these modules. - - -{1 Utilities} - -{2 Library specification} -{!modules: -AccessKind -LibraryDesc -LibraryDsl -LibraryFunctions -} diff --git a/src/util/loopUnrolling.ml b/src/util/loopUnrolling.ml index e1a8ad542b4..62d0f662f3d 100644 --- a/src/util/loopUnrolling.ml +++ b/src/util/loopUnrolling.ml @@ -320,13 +320,13 @@ class loopUnrollingCallVisitor = object | Unlock _ | ThreadCreate _ | Assert _ - | Bounded _ | ThreadJoin _ -> raise Found; | _ -> if List.mem "specification" @@ get_string_list "ana.autotune.activated" && get_string "ana.specification" <> "" then ( - if Svcomp.is_error_function' info (SvcompSpec.of_option ()) then - raise Found + match SvcompSpec.of_option () with + | UnreachCall s -> if info.vname = s then raise Found + | _ -> () ); DoChildren ) diff --git a/src/cdomain/value/util/precisionUtil.ml b/src/util/precisionUtil.ml similarity index 100% rename from src/cdomain/value/util/precisionUtil.ml rename to src/util/precisionUtil.ml diff --git a/src/util/returnUtil.ml b/src/util/returnUtil.ml deleted file mode 100644 index d80ab48ee4f..00000000000 --- a/src/util/returnUtil.ml +++ /dev/null @@ -1,11 +0,0 @@ -(** Special variable for return value. *) - -open GoblintCil -module AD = ValueDomain.AD - -let return_varstore = ref dummyFunDec.svar -let return_varinfo () = !return_varstore -let return_var () = AD.of_var (return_varinfo ()) -let return_lval (): lval = (Var (return_varinfo ()), NoOffset) - -let longjmp_return = ref dummyFunDec.svar \ No newline at end of file diff --git a/src/util/server.ml b/src/util/server.ml index 829ee92ee8f..22f5a033501 100644 --- a/src/util/server.ml +++ b/src/util/server.ml @@ -280,7 +280,6 @@ let analyze ?(reset=false) (s: t) = InvariantCil.reset_lazy (); WideningThresholds.reset_lazy (); IntDomain.reset_lazy (); - StringDomain.reset_lazy (); PrecisionUtil.reset_lazy (); ApronDomain.reset_lazy (); AutoTune.reset_lazy (); diff --git a/src/util/std/dune b/src/util/std/dune index 2b814c677a7..c6961a1725e 100644 --- a/src/util/std/dune +++ b/src/util/std/dune @@ -9,11 +9,9 @@ goblint-cil fpath yojson - yaml - qcheck-core) + yaml) (preprocess (pps ppx_deriving.std ppx_deriving_hash - ppx_deriving_yojson)) - (instrumentation (backend bisect_ppx))) + ppx_deriving_yojson))) diff --git a/src/util/std/gobHashtbl.ml b/src/util/std/gobHashtbl.ml index c93244eb47f..c14bafc0cbd 100644 --- a/src/util/std/gobHashtbl.ml +++ b/src/util/std/gobHashtbl.ml @@ -1,5 +1,9 @@ module Pretty = GoblintCil.Pretty +let magic_stats h = + let h: _ Hashtbl.t = Obj.magic h in (* Batteries Hashtables don't expose stats yet...: https://github.com/ocaml-batteries-team/batteries-included/pull/1079 *) + Hashtbl.stats h + let pretty_statistics () (s: Hashtbl.statistics) = let load_factor = float_of_int s.num_bindings /. float_of_int s.num_buckets in Pretty.dprintf "bindings=%d buckets=%d max_length=%d histo=%a load=%f" s.num_bindings s.num_buckets s.max_bucket_length (Pretty.docList (Pretty.dprintf "%d")) (Array.to_list s.bucket_histogram) load_factor diff --git a/src/util/std/gobYaml.ml b/src/util/std/gobYaml.ml index 131daaaebbf..a4f3e597aa7 100644 --- a/src/util/std/gobYaml.ml +++ b/src/util/std/gobYaml.ml @@ -1,14 +1,3 @@ -let to_string' ?(len=65535 * 4) ?encoding ?scalar_style ?layout_style v = - assert (len >= 1); - let rec aux len = - match Yaml.to_string ~len ?encoding ?scalar_style ?layout_style v with - | Ok _ as o -> o - | Error (`Msg ("scalar failed" | "doc_end failed")) when len < Sys.max_string_length / 2 -> - aux (len * 2) - | Error (`Msg _) as e -> e - in - aux len - include Yaml.Util include GobResult.Syntax diff --git a/src/util/std/goblint_std.ml b/src/util/std/goblint_std.ml index 0d548cac08b..e716d1df5bd 100644 --- a/src/util/std/goblint_std.ml +++ b/src/util/std/goblint_std.ml @@ -19,7 +19,6 @@ module GobUnix = GobUnix module GobFpath = GobFpath module GobPretty = GobPretty -module GobQCheck = GobQCheck module GobYaml = GobYaml module GobYojson = GobYojson module GobZ = GobZ diff --git a/src/util/terminationPreprocessing.ml b/src/util/terminationPreprocessing.ml deleted file mode 100644 index 9023a68f8a7..00000000000 --- a/src/util/terminationPreprocessing.ml +++ /dev/null @@ -1,76 +0,0 @@ -open GoblintCil -(* module Z = Big_int_Z *) - -module VarToStmt = Map.Make(CilType.Varinfo) (* maps varinfos (= loop counter variable) to the statement of the corresponding loop*) - -let counter_ikind = IULongLong -let counter_typ = TInt (counter_ikind, []) -let min_int_exp = - (* Currently only tested for IInt type, which is signed *) - if Cil.isSigned counter_ikind then - Const(CInt(Z.shift_left Cilint.mone_cilint ((bytesSizeOfInt counter_ikind)*8-1), IInt, None)) - else - Const(CInt(Z.zero, counter_ikind, None)) - -class loopCounterVisitor lc (fd : fundec) = object(self) - inherit nopCilVisitor - - (* Counter of variables inserted for termination *) - val mutable vcounter = ref 0 - - method! vfunc _ = - vcounter := 0; - DoChildren - - method! vstmt s = - - let specialFunction name = - { svar = makeGlobalVar name (TFun(voidType, Some [("exp", counter_typ, [])], false,[])); - smaxid = 0; - slocals = []; - sformals = []; - sbody = mkBlock []; - smaxstmtid = None; - sallstmts = []; - } in - - let f_bounded = Lval (var (specialFunction "__goblint_bounded").svar) in - - (* Yields increment expression e + 1 where the added "1" that has the same type as the expression [e]. - Using Cil.increm instead does not work for non-[IInt] ikinds. *) - let increment_expression e = - let et = typeOf e in - let bop = PlusA in - let one = Const (CInt (Cilint.one_cilint, counter_ikind, None)) in - constFold false (BinOp(bop, e, one, et)) in - - let action s = match s.skind with - | Loop (b, loc, eloc, _, _) -> - let vname = "term" ^ string_of_int loc.line ^ "_" ^ string_of_int loc.column ^ "_id" ^ (string_of_int !vcounter) in - incr vcounter; - let v = Cil.makeLocalVar fd vname counter_typ in (*Not tested for incremental mode*) - let lval = Lval (Var v, NoOffset) in - let init_stmt = mkStmtOneInstr @@ Set (var v, min_int_exp, loc, eloc) in - let inc_stmt = mkStmtOneInstr @@ Set (var v, increment_expression lval, loc, eloc) in - let exit_stmt = mkStmtOneInstr @@ Call (None, f_bounded, [lval], loc, locUnknown) in - b.bstmts <- exit_stmt :: inc_stmt :: b.bstmts; - lc := VarToStmt.add (v: varinfo) (s: stmt) !lc; - let nb = mkBlock [init_stmt; mkStmt s.skind] in - s.skind <- Block nb; - s - | Goto (sref, l) -> - let goto_jmp_stmt = sref.contents.skind in - let loc_stmt = Cil.get_stmtLoc goto_jmp_stmt in - if CilType.Location.compare l loc_stmt >= 0 then ( - (* is pos if first loc is greater -> below the second loc *) - (* problem: the program might not terminate! *) - let open Cilfacade in - let current = FunLocH.find_opt funs_with_upjumping_gotos fd in - let current = BatOption.default (LocSet.create 13) current in - LocSet.replace current l (); - FunLocH.replace funs_with_upjumping_gotos fd current; - ); - s - | _ -> s - in ChangeDoChildrenPost (s, action); -end diff --git a/src/util/tracing/dune b/src/util/tracing/dune deleted file mode 100644 index 7e371395679..00000000000 --- a/src/util/tracing/dune +++ /dev/null @@ -1,9 +0,0 @@ -(include_subdirs no) - -(library - (name goblint_tracing) - (public_name goblint.tracing) - (libraries - goblint_std - goblint-cil - goblint_build_info)) diff --git a/src/cdomain/value/util/wideningThresholds.ml b/src/util/wideningThresholds.ml similarity index 100% rename from src/cdomain/value/util/wideningThresholds.ml rename to src/util/wideningThresholds.ml diff --git a/src/cdomain/value/util/wideningThresholds.mli b/src/util/wideningThresholds.mli similarity index 100% rename from src/cdomain/value/util/wideningThresholds.mli rename to src/util/wideningThresholds.mli diff --git a/src/util/wideningTokens.ml b/src/util/wideningTokens.ml index 1816de90c75..75f0e4f81d5 100644 --- a/src/util/wideningTokens.ml +++ b/src/util/wideningTokens.ml @@ -179,7 +179,7 @@ struct let combine_env ctx r fe f args fc es f_ask = lift_fun ctx lift' S.combine_env (fun p -> p r fe f args fc (D.unlift es) f_ask) (* TODO: use tokens from es *) let combine_assign ctx r fe f args fc es f_ask = lift_fun ctx lift' S.combine_assign (fun p -> p r fe f args fc (D.unlift es) f_ask) (* TODO: use tokens from es *) - let threadenter ctx ~multiple lval f args = lift_fun ctx (fun l ts -> List.map (Fun.flip lift' ts) l) (S.threadenter ~multiple) ((|>) args % (|>) f % (|>) lval ) - let threadspawn ctx ~multiple lval f args fctx = lift_fun ctx lift' (S.threadspawn ~multiple) ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) + let threadenter ctx lval f args = lift_fun ctx (fun l ts -> List.map (Fun.flip lift' ts) l) S.threadenter ((|>) args % (|>) f % (|>) lval) + let threadspawn ctx lval f args fctx = lift_fun ctx lift' S.threadspawn ((|>) (conv fctx) % (|>) args % (|>) f % (|>) lval) let event ctx e octx = lift_fun ctx lift' S.event ((|>) (conv octx) % (|>) e) end diff --git a/src/witness/myARG.ml b/src/witness/myARG.ml index 373a66d3d6f..62c705f5b1a 100644 --- a/src/witness/myARG.ml +++ b/src/witness/myARG.ml @@ -141,7 +141,7 @@ struct let equal_node_context _ _ = failwith "StackNode: equal_node_context" end -module Stack (Arg: S with module Edge = InlineEdge): +module Stack (Cfg:CfgForward) (Arg: S): S with module Node = StackNode (Arg.Node) and module Edge = Arg.Edge = struct module Node = StackNode (Arg.Node) @@ -156,30 +156,45 @@ struct | n :: stack -> let cfgnode = Arg.Node.cfgnode n in match cfgnode with - | Function _ -> (* TODO: can this be done without cfgnode? *) + | Function _ -> (* TODO: can this be done without Cfg? *) begin match stack with (* | [] -> failwith "StackArg.next: return stack empty" *) | [] -> [] (* main return *) | call_n :: call_stack -> + let call_cfgnode = Arg.Node.cfgnode call_n in let call_next = - Arg.next call_n + Cfg.next call_cfgnode (* filter because infinite loops starting with function call will have another Neg(1) edge from the head *) - |> List.filter_map (fun (edge, to_n) -> - match edge with - | InlinedEdge _ -> Some to_n - | _ -> None + |> List.filter (fun (locedges, to_node) -> + List.exists (function + | (_, Proc _) -> true + | (_, _) -> false + ) locedges ) in - Arg.next n - |> List.filter_map (fun (edge, to_n) -> - if BatList.mem_cmp Arg.Node.compare to_n call_next then ( - let to_n' = to_n :: call_stack in - Some (edge, to_n') - ) - else - None - ) + begin match call_next with + | [] -> failwith "StackArg.next: call next empty" + | [(_, return_node)] -> + begin match Arg.Node.move_opt call_n return_node with + (* TODO: Is it possible to have a calling node without a returning node? *) + (* | None -> [] *) + | None -> failwith "StackArg.next: no return node" + | Some return_n -> + (* TODO: Instead of next & filter, construct unique return_n directly. Currently edge missing. *) + Arg.next n + |> List.filter (fun (edge, to_n) -> + (* let to_cfgnode = Arg.Node.cfgnode to_n in + MyCFG.Node.equal to_cfgnode return_node *) + Arg.Node.equal_node_context to_n return_n + ) + |> List.map (fun (edge, to_n) -> + let to_n' = to_n :: call_stack in + (edge, to_n') + ) + end + | _ :: _ :: _ -> failwith "StackArg.next: call next ambiguous" + end end | _ -> let+ (edge, to_n) = Arg.next n in @@ -305,7 +320,7 @@ struct let rec next_opt' n = match n with - | Statement {sid; skind=If (_, _, _, loc, eloc); _} when GobConfig.get_bool "witness.graphml.uncil" -> (* TODO: use elocs instead? *) + | Statement {sid; skind=If (_, _, _, loc, eloc); _} when GobConfig.get_bool "witness.uncil" -> (* TODO: use elocs instead? *) let (e, if_true_next_n, if_false_next_n) = partition_if_next (Arg.next n) in (* avoid infinite recursion with sid <> sid2 in if_nondet_var *) (* TODO: why physical comparison if_false_next_n != n doesn't work? *) @@ -358,7 +373,7 @@ struct Question(e_cond, e_true, e_false, Cilfacade.typeOf e_false) let next_opt' n = match n with - | Statement {skind=If (_, _, _, loc, eloc); _} when GobConfig.get_bool "witness.graphml.uncil" -> (* TODO: use eloc instead? *) + | Statement {skind=If (_, _, _, loc, eloc); _} when GobConfig.get_bool "witness.uncil" -> (* TODO: use eloc instead? *) let (e_cond, if_true_next_n, if_false_next_n) = partition_if_next (Arg.next n) in if Node.location if_true_next_n = loc && Node.location if_false_next_n = loc then match Arg.next if_true_next_n, Arg.next if_false_next_n with diff --git a/src/witness/observerAnalysis.ml b/src/witness/observerAnalysis.ml index 58b5b31fe41..c8d85639096 100644 --- a/src/witness/observerAnalysis.ml +++ b/src/witness/observerAnalysis.ml @@ -29,7 +29,7 @@ struct let n () = -1 let names x = "state " ^ string_of_int x end - module D = Lattice.Flat (Printable.Chain (ChainParams)) + module D = Lattice.Flat (Printable.Chain (ChainParams)) (Printable.DefaultNames) module C = D module P = IdentityP (D) (* fully path-sensitive *) @@ -76,8 +76,8 @@ struct step_ctx ctx let startstate v = `Lifted Automaton.initial - let threadenter ctx ~multiple lval f args = [D.top ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local + let threadenter ctx lval f args = [D.top ()] + let threadspawn ctx lval f args fctx = ctx.local let exitstate v = D.top () end diff --git a/src/witness/svcomp.ml b/src/witness/svcomp.ml index 6d22a511664..22543d48a93 100644 --- a/src/witness/svcomp.ml +++ b/src/witness/svcomp.ml @@ -8,7 +8,7 @@ module Specification = SvcompSpec module type Task = sig val file: Cil.file - val specification: Specification.multi + val specification: Specification.t module Cfg: MyCFG.CfgBidir end @@ -16,15 +16,11 @@ end let task: (module Task) option ref = ref None -let is_error_function' f spec = - List.exists (function - | Specification.UnreachCall f_spec -> f.vname = f_spec - | _ -> false - ) spec - let is_error_function f = let module Task = (val (Option.get !task)) in - is_error_function' f Task.specification + match Task.specification with + | UnreachCall f_spec -> f.vname = f_spec + | _ -> false (* TODO: unused, but should be used? *) let is_special_function f = @@ -32,7 +28,11 @@ let is_special_function f = 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_verifier = match f.vname with | fname when String.starts_with fname "__VERIFIER" -> true - | fname -> is_error_function f + | fname -> + let module Task = (val (Option.get !task)) in + match Task.specification with + | UnreachCall f_spec -> fname = f_spec + | _ -> false in is_svcomp && is_verifier @@ -52,10 +52,10 @@ struct | UnreachCall _ -> "unreach-call" | NoOverflow -> "no-overflow" | NoDataRace -> "no-data-race" (* not yet in SV-COMP/Benchexec *) - | Termination -> "termination" | ValidFree -> "valid-free" | ValidDeref -> "valid-deref" | ValidMemtrack -> "valid-memtrack" + | MemorySafety -> "memory-safety" (* TODO: Currently here only to complete the pattern match *) | ValidMemcleanup -> "valid-memcleanup" in "false(" ^ result_spec ^ ")" @@ -76,9 +76,9 @@ sig val is_sink: Arg.Node.t -> bool end -module StackTaskResult (TaskResult: TaskResult with module Arg.Edge = MyARG.InlineEdge) = +module StackTaskResult (Cfg:MyCFG.CfgForward) (TaskResult: TaskResult) = struct - module Arg = MyARG.Stack (TaskResult.Arg) + module Arg = MyARG.Stack (Cfg) (TaskResult.Arg) let result = TaskResult.result diff --git a/src/witness/svcompSpec.ml b/src/witness/svcompSpec.ml index c7601ef6375..4a3da23d9bc 100644 --- a/src/witness/svcompSpec.ml +++ b/src/witness/svcompSpec.ml @@ -6,19 +6,17 @@ type t = | UnreachCall of string | NoDataRace | NoOverflow - | Termination | ValidFree | ValidDeref | ValidMemtrack + | MemorySafety (* Internal property for use in Goblint; serves as a summary for ValidFree, ValidDeref and ValidMemtrack *) | ValidMemcleanup -type multi = t list - let of_string s = let s = String.strip s in + let regexp_multiple = Str.regexp "CHECK( init(main()), LTL(G \\(.*\\)) )\nCHECK( init(main()), LTL(G \\(.*\\)) )\nCHECK( init(main()), LTL(G \\(.*\\)) )" in let regexp_single = Str.regexp "CHECK( init(main()), LTL(G \\(.*\\)) )" in let regexp_negated = Str.regexp "CHECK( init(main()), LTL(G ! \\(.*\\)) )" in - let regexp_finally = Str.regexp "CHECK( init(main()), LTL(F \\(.*\\)) )" in if Str.string_match regexp_negated s 0 then let global_not = Str.matched_group 1 s in if global_not = "data-race" then @@ -32,36 +30,24 @@ let of_string s = UnreachCall f else failwith "Svcomp.Specification.of_string: unknown global not expression" + else if Str.string_match regexp_multiple s 0 then + let global1 = Str.matched_group 1 s in + let global2 = Str.matched_group 2 s in + let global3 = Str.matched_group 3 s in + let mem_safety_props = ["valid-free"; "valid-deref"; "valid-memtrack";] in + if (global1 <> global2 && global1 <> global3 && global2 <> global3) && List.for_all (fun x -> List.mem x mem_safety_props) [global1; global2; global3] then + MemorySafety + else + failwith "Svcomp.Specification.of_string: unknown global expression" else if Str.string_match regexp_single s 0 then let global = Str.matched_group 1 s in - if global = "valid-free" then - ValidFree - else if global = "valid-deref" then - ValidDeref - else if global = "valid-memtrack" then - ValidMemtrack - else if global = "valid-memcleanup" then + if global = "valid-memcleanup" then ValidMemcleanup else failwith "Svcomp.Specification.of_string: unknown global expression" - else if Str.string_match regexp_finally s 0 then - let finally = Str.matched_group 1 s in - if finally = "end" then - Termination - else - failwith "Svcomp.Specification.of_string: unknown finally expression" else failwith "Svcomp.Specification.of_string: unknown expression" -let of_string s: multi = - List.filter_map (fun line -> - let line = String.strip line in - if line = "" then - None - else - Some (of_string line) - ) (String.split_on_char '\n' s) - let of_file path = let s = BatFile.with_file_in path BatIO.read_all in of_string s @@ -74,32 +60,20 @@ let of_option () = of_string s let to_string spec = - let module Prop = struct - type prop = F | G - let string_of_prop = function - | F -> "F" - | G -> "G" - end - in - let open Prop in - let print_output prop spec_str is_neg = - let prop = string_of_prop prop in + let print_output spec_str is_neg = if is_neg then - Printf.sprintf "CHECK( init(main()), LTL(%s ! %s) )" prop spec_str + Printf.sprintf "CHECK( init(main()), LTL(G ! %s) )" spec_str else - Printf.sprintf "CHECK( init(main()), LTL(%s %s) )" prop spec_str + Printf.sprintf "CHECK( init(main()), LTL(G %s) )" spec_str in - let prop, spec_str, is_neg = match spec with - | UnreachCall f -> G, "call(" ^ f ^ "())", true - | NoDataRace -> G, "data-race", true - | NoOverflow -> G, "overflow", true - | ValidFree -> G, "valid-free", false - | ValidDeref -> G, "valid-deref", false - | ValidMemtrack -> G, "valid-memtrack", false - | ValidMemcleanup -> G, "valid-memcleanup", false - | Termination -> F, "end", false + let spec_str, is_neg = match spec with + | UnreachCall f -> "call(" ^ f ^ "())", true + | NoDataRace -> "data-race", true + | NoOverflow -> "overflow", true + | ValidFree -> "valid-free", false + | ValidDeref -> "valid-deref", false + | ValidMemtrack -> "valid-memtrack", false + | MemorySafety -> "memory-safety", false (* TODO: That's false, it's currently here just to complete the pattern match *) + | ValidMemcleanup -> "valid-memcleanup", false in - print_output prop spec_str is_neg - -let to_string spec = - String.concat "\n" (List.map to_string spec) + print_output spec_str is_neg diff --git a/src/witness/witness.ml b/src/witness/witness.ml index 29f337a668d..9f5a3c18015 100644 --- a/src/witness/witness.ml +++ b/src/witness/witness.ml @@ -13,8 +13,8 @@ let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult) let module Invariant = WitnessUtil.Invariant (Task) in let module TaskResult = - (val if get_bool "witness.graphml.stack" then - (module StackTaskResult (TaskResult) : WitnessTaskResult) + (val if get_bool "witness.stack" then + (module StackTaskResult (Task.Cfg) (TaskResult) : WitnessTaskResult) else (module TaskResult) ) @@ -24,7 +24,7 @@ let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult) struct (* type node = N.t type edge = TaskResult.Arg.Edge.t *) - let minwitness = get_bool "witness.graphml.minimize" + let minwitness = get_bool "witness.minimize" let is_interesting_real from_node edge to_node = (* TODO: don't duplicate this logic with write_node, write_edge *) (* startlines aren't currently interesting because broken, see below *) @@ -58,12 +58,12 @@ let write_file filename (module Task:Task) (module TaskResult:WitnessTaskResult) let module N = Arg.Node in let module GML = XmlGraphMlWriter in let module GML = - (val match get_string "witness.graphml.id" with + (val match get_string "witness.id" with | "node" -> (module ArgNodeGraphMlWriter (N) (GML) : GraphMlWriter with type node = N.t) | "enumerate" -> (module EnumerateNodeGraphMlWriter (N) (GML)) - | _ -> failwith "witness.graphml.id: illegal value" + | _ -> failwith "witness.id: illegal value" ) in let module GML = DeDupGraphMlWriter (N) (GML) in @@ -303,9 +303,9 @@ struct val find_invariant: Node.t -> Invariant.t end - let determine_result entrystates (module Task:Task) (spec: Svcomp.Specification.t): (module WitnessTaskResult) = + let determine_result entrystates (module Task:Task): (module WitnessTaskResult) = let module Arg: BiArgInvariant = - (val if GobConfig.get_bool "witness.graphml.enabled" then ( + (val if GobConfig.get_bool "witness.enabled" then ( let module Arg = (val ArgTool.create entrystates) in let module Arg = struct @@ -338,7 +338,7 @@ struct ) in - match spec with + match Task.specification with | UnreachCall _ -> (* error function name is globally known through Svcomp.task *) let is_unreach_call = @@ -410,7 +410,7 @@ struct let module TaskResult = struct module Arg = PathArg - let result = Result.False (Some spec) + let result = Result.False (Some Task.specification) let invariant _ = Invariant.none let is_violation = is_violation let is_sink _ = false @@ -475,36 +475,6 @@ struct in (module TaskResult:WitnessTaskResult) ) - | Termination -> - let module TrivialArg = - struct - include Arg - let next _ = [] - end - in - if not !AnalysisState.svcomp_may_not_terminate then - let module TaskResult = - struct - module Arg = TrivialArg - let result = Result.True - let invariant _ = Invariant.none - let is_violation _ = false - let is_sink _ = false - end - in - (module TaskResult:WitnessTaskResult) - else ( - let module TaskResult = - struct - module Arg = TrivialArg - let result = Result.Unknown - let invariant _ = Invariant.none - let is_violation _ = false - let is_sink _ = false - end - in - (module TaskResult:WitnessTaskResult) - ) | NoOverflow -> let module TrivialArg = struct @@ -535,74 +505,17 @@ struct in (module TaskResult:WitnessTaskResult) ) - | ValidFree -> + | ValidFree + | ValidDeref + | ValidMemtrack + | MemorySafety -> let module TrivialArg = struct include Arg let next _ = [] end in - if not !AnalysisState.svcomp_may_invalid_free then ( - let module TaskResult = - struct - module Arg = Arg - let result = Result.True - let invariant _ = Invariant.none - let is_violation _ = false - let is_sink _ = false - end - in - (module TaskResult:WitnessTaskResult) - ) else ( - let module TaskResult = - struct - module Arg = TrivialArg - let result = Result.Unknown - let invariant _ = Invariant.none - let is_violation _ = false - let is_sink _ = false - end - in - (module TaskResult:WitnessTaskResult) - ) - | ValidDeref -> - let module TrivialArg = - struct - include Arg - let next _ = [] - end - in - if not !AnalysisState.svcomp_may_invalid_deref then ( - let module TaskResult = - struct - module Arg = Arg - let result = Result.True - let invariant _ = Invariant.none - let is_violation _ = false - let is_sink _ = false - end - in - (module TaskResult:WitnessTaskResult) - ) else ( - let module TaskResult = - struct - module Arg = TrivialArg - let result = Result.Unknown - let invariant _ = Invariant.none - let is_violation _ = false - let is_sink _ = false - end - in - (module TaskResult:WitnessTaskResult) - ) - | ValidMemtrack -> - let module TrivialArg = - struct - include Arg - let next _ = [] - end - in - if not !AnalysisState.svcomp_may_invalid_memtrack then ( + if not !AnalysisState.svcomp_may_invalid_free && not !AnalysisState.svcomp_may_invalid_deref && not !AnalysisState.svcomp_may_invalid_memtrack then ( let module TaskResult = struct module Arg = Arg @@ -656,38 +569,16 @@ struct (module TaskResult:WitnessTaskResult) ) - let determine_result entrystates (module Task:Task): (module WitnessTaskResult) = - Task.specification - |> List.fold_left (fun acc spec -> - let module TaskResult = (val determine_result entrystates (module Task) spec) in - match acc with - | None -> Some (module TaskResult: WitnessTaskResult) - | Some (module Acc: WitnessTaskResult) -> - match Acc.result, TaskResult.result with - (* keep old violation/unknown *) - | False _, True - | False _, Unknown - | Unknown, True -> Some (module Acc: WitnessTaskResult) - (* use new violation/unknown *) - | True, False _ - | Unknown, False _ - | True, Unknown -> Some (module TaskResult: WitnessTaskResult) - (* both same, arbitrarily keep old *) - | True, True -> Some (module Acc: WitnessTaskResult) - | Unknown, Unknown -> Some (module Acc: WitnessTaskResult) - | False _, False _ -> failwith "multiple violations" - ) None - |> Option.get let write entrystates = let module Task = (val (BatOption.get !task)) in - let module TaskResult = (val (Timing.wrap "sv-comp result" (determine_result entrystates) (module Task))) in + let module TaskResult = (val (Timing.wrap "determine" (determine_result entrystates) (module Task))) in print_task_result (module TaskResult); - if get_bool "witness.graphml.enabled" && (TaskResult.result <> Result.Unknown || get_bool "witness.graphml.unknown") then ( - let witness_path = get_string "witness.graphml.path" in - Timing.wrap "graphml witness" (write_file witness_path (module Task)) (module TaskResult) + if get_bool "witness.enabled" && (TaskResult.result <> Result.Unknown || get_bool "witness.unknown") then ( + let witness_path = get_string "witness.path" in + Timing.wrap "write" (write_file witness_path (module Task)) (module TaskResult) ) let write entrystates = @@ -695,20 +586,16 @@ struct | 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 -> + if !YamlWitness.cnt_refuted > 0 then print_svcomp_result (Result.to_string (False None)) - | _ when !YamlWitness.cnt_unconfirmed > 0 -> + else if !YamlWitness.cnt_unconfirmed > 0 then print_svcomp_result (Result.to_string Unknown) - | _ -> + else write entrystates ) else write entrystates + + let write entrystates = + Timing.wrap "witness" write entrystates end diff --git a/src/witness/witnessConstraints.ml b/src/witness/witnessConstraints.ml index 8dedf77a79a..2ce16a59972 100644 --- a/src/witness/witnessConstraints.ml +++ b/src/witness/witnessConstraints.ml @@ -199,7 +199,7 @@ struct let r = Dom.bindings a in List.map (fun (x,v) -> (Dom.singleton x v, b)) r - let threadenter ctx ~multiple lval f args = + let threadenter ctx lval f args = let g xs x' ys = let ys' = List.map (fun y -> let yr = step ctx.prev_node (ctx.context ()) x' (ThreadEntry (lval, f, args)) (nosync x') in (* threadenter called on before-sync state *) @@ -208,10 +208,10 @@ struct in ys' @ xs in - fold' ctx (Spec.threadenter ~multiple) (fun h -> h lval f args) g [] - let threadspawn ctx ~multiple lval f args fctx = + fold' ctx Spec.threadenter (fun h -> h lval f args) g [] + let threadspawn ctx lval f args fctx = let fd1 = Dom.choose_key (fst fctx.local) in - map ctx (Spec.threadspawn ~multiple) (fun h -> h lval f args (conv fctx fd1)) + map ctx Spec.threadspawn (fun h -> h lval f args (conv fctx fd1)) let sync ctx reason = fold'' ctx Spec.sync (fun h -> h reason) (fun (a, async) x r a' -> diff --git a/src/witness/yamlWitness.ml b/src/witness/yamlWitness.ml index 253ee5eecd2..72ff21f6bdb 100644 --- a/src/witness/yamlWitness.ml +++ b/src/witness/yamlWitness.ml @@ -25,7 +25,7 @@ struct let uuid = Uuidm.v4_gen uuid_random_state () in let creation_time = TimeUtil.iso8601_now () in { - format_version = GobConfig.get_string "witness.yaml.format-version"; + format_version = "0.1"; uuid = Uuidm.to_string uuid; creation_time; producer; @@ -91,29 +91,6 @@ struct metadata = metadata ~task (); } - let location_invariant' ~location ~(invariant): InvariantSet.Invariant.t = { - invariant_type = LocationInvariant { - location; - value = invariant; - format = "c_expression"; - }; - } - - let loop_invariant' ~location ~(invariant): InvariantSet.Invariant.t = { - invariant_type = LoopInvariant { - location; - value = invariant; - format = "c_expression"; - }; - } - - let invariant_set ~task ~(invariants): Entry.t = { - entry_type = InvariantSet { - content = invariants; - }; - metadata = metadata ~task (); - } - let target ~uuid ~type_ ~(file_name): Target.t = { uuid; type_; @@ -136,9 +113,9 @@ struct let precondition_loop_invariant_certificate ~target ~(certification): Entry.t = { entry_type = PreconditionLoopInvariantCertificate { - target; - certification; - }; + target; + certification; + }; metadata = metadata (); } end @@ -147,7 +124,8 @@ let yaml_entries_to_file yaml_entries file = let yaml = `A yaml_entries in (* Yaml_unix.to_file_exn file yaml *) (* to_file/to_string uses a fixed-size buffer... *) - let text = match GobYaml.to_string' yaml with + (* estimate how big it should be + extra in case empty *) + let text = match Yaml.to_string ~len:(List.length yaml_entries * 4096 + 2048) yaml with | Ok text -> text | Error (`Msg m) -> failwith ("Yaml.to_string: " ^ m) in @@ -156,9 +134,6 @@ let yaml_entries_to_file yaml_entries file = let entry_type_enabled entry_type = List.mem entry_type (GobConfig.get_string_list "witness.yaml.entry-types") -let invariant_type_enabled invariant_type = - List.mem invariant_type (GobConfig.get_string_list "witness.yaml.invariant-types") - module Make (R: ResultQuery.SpecSysSol2) = struct open R @@ -170,16 +145,6 @@ struct module FCMap = BatHashtbl.Make (Printable.Prod (CilType.Fundec) (Spec.C)) type con_inv = {node: Node.t; context: Spec.C.t; invariant: Invariant.t; state: Spec.D.t} - (* TODO: fix location hack *) - module LH = BatHashtbl.Make (CilType.Location) - let location2nodes: Node.t list LH.t Lazy.t = lazy ( - let lh = LH.create 113 in - NH.iter (fun n _ -> - LH.modify_def [] (Node.location n) (List.cons n) lh - ) (Lazy.force nh); - lh - ) - let write () = let input_files = GobConfig.get_string_list "files" in let data_model = match GobConfig.get_string "exp.architecture" with @@ -243,21 +208,16 @@ struct (* Generate location invariants (without precondition) *) let entries = if entry_type_enabled YamlWitnessType.LocationInvariant.entry_type then ( - LH.fold (fun loc ns acc -> - if List.exists is_invariant_node ns then ( - let inv = List.fold_left (fun acc n -> - let local = try NH.find (Lazy.force nh) n with Not_found -> Spec.D.bot () in - let lvals = local_lvals n local in - Invariant.(acc || R.ask_local_node n ~local (Invariant {Invariant.default_context with lvals})) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ns - in - match inv with + NH.fold (fun n local acc -> + let loc = Node.location n in + if is_invariant_node n then ( + let lvals = local_lvals n local in + match R.ask_local_node n ~local (Invariant {Invariant.default_context with lvals}) with | `Lifted inv -> - let fundec = Node.find_fundec (List.hd ns) in (* TODO: fix location hack *) - let location_function = fundec.svar.vname in - let location = Entry.location ~location:loc ~location_function in let invs = WitnessUtil.InvariantExp.process_exp inv in List.fold_left (fun acc inv -> + let location_function = (Node.find_fundec n).svar.vname in + let location = Entry.location ~location:loc ~location_function in let invariant = Entry.invariant (CilType.Exp.show inv) in let entry = Entry.location_invariant ~task ~location ~invariant in entry :: acc @@ -267,7 +227,7 @@ struct ) else acc - ) (Lazy.force location2nodes) entries + ) (Lazy.force nh) entries ) else entries @@ -276,20 +236,15 @@ struct (* Generate loop invariants (without precondition) *) let entries = if entry_type_enabled YamlWitnessType.LoopInvariant.entry_type then ( - LH.fold (fun loc ns acc -> - if WitnessInvariant.emit_loop_head && List.exists (WitnessUtil.NH.mem WitnessInvariant.loop_heads) ns then ( - let inv = List.fold_left (fun acc n -> - let local = try NH.find (Lazy.force nh) n with Not_found -> Spec.D.bot () in - Invariant.(acc || R.ask_local_node n ~local (Invariant Invariant.default_context)) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ns - in - match inv with + NH.fold (fun n local acc -> + let loc = Node.location n in + if WitnessInvariant.emit_loop_head && WitnessUtil.NH.mem WitnessInvariant.loop_heads n then ( + match R.ask_local_node n ~local (Invariant Invariant.default_context) with | `Lifted inv -> - let fundec = Node.find_fundec (List.hd ns) in (* TODO: fix location hack *) - let location_function = fundec.svar.vname in - let location = Entry.location ~location:loc ~location_function in let invs = WitnessUtil.InvariantExp.process_exp inv in List.fold_left (fun acc inv -> + let location_function = (Node.find_fundec n).svar.vname in + let location = Entry.location ~location:loc ~location_function in let invariant = Entry.invariant (CilType.Exp.show inv) in let entry = Entry.loop_invariant ~task ~location ~invariant in entry :: acc @@ -299,7 +254,7 @@ struct ) else acc - ) (Lazy.force location2nodes) entries + ) (Lazy.force nh) entries ) else entries @@ -430,84 +385,6 @@ struct entries in - (* Generate invariant set *) - let entries = - if entry_type_enabled YamlWitnessType.InvariantSet.entry_type then ( - let invariants = [] in - - (* Generate location invariants *) - let invariants = - if invariant_type_enabled YamlWitnessType.InvariantSet.LocationInvariant.invariant_type then ( - LH.fold (fun loc ns acc -> - if List.exists is_invariant_node ns then ( - let inv = List.fold_left (fun acc n -> - let local = try NH.find (Lazy.force nh) n with Not_found -> Spec.D.bot () in - let lvals = local_lvals n local in - Invariant.(acc || R.ask_local_node n ~local (Invariant {Invariant.default_context with lvals})) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ns - in - match inv with - | `Lifted inv -> - let fundec = Node.find_fundec (List.hd ns) in (* TODO: fix location hack *) - let location_function = fundec.svar.vname in - let location = Entry.location ~location:loc ~location_function in - let invs = WitnessUtil.InvariantExp.process_exp inv in - List.fold_left (fun acc inv -> - let invariant = CilType.Exp.show inv in - let invariant = Entry.location_invariant' ~location ~invariant in - invariant :: acc - ) acc invs - | `Bot | `Top -> (* TODO: 0 for bot (dead code)? *) - acc - ) - else - acc - ) (Lazy.force location2nodes) invariants - ) - else - invariants - in - - (* Generate loop invariants *) - let invariants = - if invariant_type_enabled YamlWitnessType.InvariantSet.LoopInvariant.invariant_type then ( - LH.fold (fun loc ns acc -> - if WitnessInvariant.emit_loop_head && List.exists (WitnessUtil.NH.mem WitnessInvariant.loop_heads) ns then ( - let inv = List.fold_left (fun acc n -> - let local = try NH.find (Lazy.force nh) n with Not_found -> Spec.D.bot () in - Invariant.(acc || R.ask_local_node n ~local (Invariant Invariant.default_context)) [@coverage off] (* bisect_ppx cannot handle redefined (||) *) - ) (Invariant.bot ()) ns - in - match inv with - | `Lifted inv -> - let fundec = Node.find_fundec (List.hd ns) in (* TODO: fix location hack *) - let location_function = fundec.svar.vname in - let location = Entry.location ~location:loc ~location_function in - let invs = WitnessUtil.InvariantExp.process_exp inv in - List.fold_left (fun acc inv -> - let invariant = CilType.Exp.show inv in - let invariant = Entry.loop_invariant' ~location ~invariant in - invariant :: acc - ) acc invs - | `Bot | `Top -> (* TODO: 0 for bot (dead code)? *) - acc - ) - else - acc - ) (Lazy.force location2nodes) invariants - ) - else - invariants - in - - let invariants = List.rev invariants in - let entry = Entry.invariant_set ~task ~invariants in - entry :: entries - ) - else - entries - in - let yaml_entries = List.rev_map YamlWitnessType.Entry.to_yaml entries in (* reverse to make entries in file in the same order as generation messages *) M.msg_group Info ~category:Witness "witness generation summary" [ @@ -515,9 +392,6 @@ struct ]; yaml_entries_to_file yaml_entries (Fpath.v (GobConfig.get_string "witness.yaml.path")) - - let write () = - Timing.wrap "yaml witness" write () end @@ -762,48 +636,6 @@ struct None in - let validate_invariant_set (invariant_set: YamlWitnessType.InvariantSet.t) = - - let validate_location_invariant (location_invariant: YamlWitnessType.InvariantSet.LocationInvariant.t) = - let loc = loc_of_location location_invariant.location in - let inv = location_invariant.value in - - match Locator.find_opt locator loc with - | Some lvars -> - ignore (validate_lvars_invariant ~entry_certificate:None ~loc ~lvars inv) - | None -> - incr cnt_error; - M.warn ~category:Witness ~loc:(CilLocation loc) "couldn't locate invariant: %s" inv; - in - - let validate_loop_invariant (loop_invariant: YamlWitnessType.InvariantSet.LoopInvariant.t) = - let loc = loc_of_location loop_invariant.location in - let inv = loop_invariant.value in - - match Locator.find_opt loop_locator loc with - | Some lvars -> - ignore (validate_lvars_invariant ~entry_certificate:None ~loc ~lvars inv) - | None -> - incr cnt_error; - M.warn ~category:Witness ~loc:(CilLocation loc) "couldn't locate invariant: %s" inv; - in - - let validate_invariant (invariant: YamlWitnessType.InvariantSet.Invariant.t) = - let target_type = YamlWitnessType.InvariantSet.InvariantType.invariant_type invariant.invariant_type in - match invariant_type_enabled target_type, invariant.invariant_type with - | true, LocationInvariant x -> - validate_location_invariant x - | true, LoopInvariant x -> - validate_loop_invariant x - | false, (LocationInvariant _ | LoopInvariant _) -> - incr cnt_disabled; - M.info_noloc ~category:Witness "disabled invariant of type %s" target_type; - in - - List.iter validate_invariant invariant_set.content; - None - in - match entry_type_enabled target_type, entry.entry_type with | true, LocationInvariant x -> validate_location_invariant x @@ -811,9 +643,7 @@ struct validate_loop_invariant x | true, PreconditionLoopInvariant x -> validate_precondition_loop_invariant x - | true, InvariantSet x -> - validate_invariant_set x - | false, (LocationInvariant _ | LoopInvariant _ | PreconditionLoopInvariant _ | InvariantSet _) -> + | false, (LocationInvariant _ | LoopInvariant _ | PreconditionLoopInvariant _) -> incr cnt_disabled; M.info_noloc ~category:Witness "disabled entry of type %s" target_type; None diff --git a/src/witness/yamlWitnessType.ml b/src/witness/yamlWitnessType.ml index de9fa151d88..3390c1e3ab0 100644 --- a/src/witness/yamlWitnessType.ml +++ b/src/witness/yamlWitnessType.ml @@ -242,103 +242,6 @@ struct {location; loop_invariant; precondition} end -module InvariantSet = -struct - module LoopInvariant = - struct - type t = { - location: Location.t; - value: string; - format: string; - } - - let invariant_type = "loop_invariant" - - let to_yaml' {location; value; format} = - [ - ("location", Location.to_yaml location); - ("value", `String value); - ("format", `String format); - ] - - let of_yaml y = - let open GobYaml in - let+ location = y |> find "location" >>= Location.of_yaml - and+ value = y |> find "value" >>= to_string - and+ format = y |> find "format" >>= to_string in - {location; value; format} - end - - module LocationInvariant = - struct - include LoopInvariant - - let invariant_type = "location_invariant" - end - - (* TODO: could maybe use GADT, but adds ugly existential layer to entry type pattern matching *) - module InvariantType = - struct - type t = - | LocationInvariant of LocationInvariant.t - | LoopInvariant of LoopInvariant.t - - let invariant_type = function - | LocationInvariant _ -> LocationInvariant.invariant_type - | LoopInvariant _ -> LoopInvariant.invariant_type - - let to_yaml' = function - | LocationInvariant x -> LocationInvariant.to_yaml' x - | LoopInvariant x -> LoopInvariant.to_yaml' x - - let of_yaml y = - let open GobYaml in - let* invariant_type = y |> find "type" >>= to_string in - if invariant_type = LocationInvariant.invariant_type then - let+ x = y |> LocationInvariant.of_yaml in - LocationInvariant x - else if invariant_type = LoopInvariant.invariant_type then - let+ x = y |> LoopInvariant.of_yaml in - LoopInvariant x - else - Error (`Msg "type") - end - - module Invariant = - struct - type t = { - invariant_type: InvariantType.t; - } - - let to_yaml {invariant_type} = - `O [ - ("invariant", `O ([ - ("type", `String (InvariantType.invariant_type invariant_type)); - ] @ InvariantType.to_yaml' invariant_type) - ) - ] - - let of_yaml y = - let open GobYaml in - let+ invariant_type = y |> find "invariant" >>= InvariantType.of_yaml in - {invariant_type} - end - - type t = { - content: Invariant.t list; - } - - let entry_type = "invariant_set" - - let to_yaml' {content} = - [("content", `A (List.map Invariant.to_yaml content))] - - let of_yaml y = - let open GobYaml in - let+ content = y |> find "content" >>= list >>= list_map Invariant.of_yaml in - {content} -end - module Target = struct type t = { @@ -423,7 +326,6 @@ struct | PreconditionLoopInvariant of PreconditionLoopInvariant.t | LoopInvariantCertificate of LoopInvariantCertificate.t | PreconditionLoopInvariantCertificate of PreconditionLoopInvariantCertificate.t - | InvariantSet of InvariantSet.t let entry_type = function | LocationInvariant _ -> LocationInvariant.entry_type @@ -432,7 +334,6 @@ struct | PreconditionLoopInvariant _ -> PreconditionLoopInvariant.entry_type | LoopInvariantCertificate _ -> LoopInvariantCertificate.entry_type | PreconditionLoopInvariantCertificate _ -> PreconditionLoopInvariantCertificate.entry_type - | InvariantSet _ -> InvariantSet.entry_type let to_yaml' = function | LocationInvariant x -> LocationInvariant.to_yaml' x @@ -441,7 +342,6 @@ struct | PreconditionLoopInvariant x -> PreconditionLoopInvariant.to_yaml' x | LoopInvariantCertificate x -> LoopInvariantCertificate.to_yaml' x | PreconditionLoopInvariantCertificate x -> PreconditionLoopInvariantCertificate.to_yaml' x - | InvariantSet x -> InvariantSet.to_yaml' x let of_yaml y = let open GobYaml in @@ -464,9 +364,6 @@ struct else if entry_type = PreconditionLoopInvariantCertificate.entry_type then let+ x = y |> PreconditionLoopInvariantCertificate.of_yaml in PreconditionLoopInvariantCertificate x - else if entry_type = InvariantSet.entry_type then - let+ x = y |> InvariantSet.of_yaml in - InvariantSet x else Error (`Msg "entry_type") end diff --git a/sv-comp/README.md b/sv-comp/README.md new file mode 100644 index 00000000000..9f5c203213e --- /dev/null +++ b/sv-comp/README.md @@ -0,0 +1,28 @@ +# Goblint for SV-COMP +All the SV-COMP configuration is in `conf/svcomp.json`. + +## Run Goblint in SV-COMP mode +### ReachSafety +``` +./goblint --conf conf/svcomp.json --set ana.specification ../sv-benchmarks/c/properties/unreach-call.prp ../sv-benchmarks/c/DIR/FILE.i +``` + +### NoDataRace +``` +./goblint --conf conf/svcomp.json --set ana.specification ../sv-benchmarks/c/properties/no-data-race.prp ../sv-benchmarks/c/DIR/FILE.i +``` + + +# Inspecting witnesses +## yEd + +1. Open (Ctrl+o) `witness.graphml` from Goblint root directory. +2. Click menu "Edit" → "Properties Mapper". + 1. _First time:_ Click button "Imports additional configurations" and open `yed-sv-comp.cnfx` from this directory. + 2. Select "SV-COMP (Node)" and click "Apply". + 3. Select "SV-COMP (Edge)" and click "Ok". +3. Click menu "Layout" → "Hierarchial" (Alt+shift+h). + 1. _First time:_ Click tab "Labeling", select "Hierarchic" in "Edge Labeling". + 2. Click "Ok". + +yEd manual for the Properties Mapper: https://yed.yworks.com/support/manual/properties_mapper.html. diff --git a/scripts/sv-comp/archive.sh b/sv-comp/archive.sh similarity index 78% rename from scripts/sv-comp/archive.sh rename to sv-comp/archive.sh index 37fa2758d9d..9bab49f70da 100755 --- a/scripts/sv-comp/archive.sh +++ b/sv-comp/archive.sh @@ -4,7 +4,7 @@ make clean -git tag -m "SV-COMP 2024" svcomp24 +git tag -m "SV-COMP 2023" svcomp23 dune build --profile=release src/goblint.exe rm -f goblint @@ -18,22 +18,21 @@ cp _opam/share/apron/lib/libapron.so lib/ cp _opam/share/apron/lib/liboctD.so lib/ cp _opam/share/apron/lib/libboxD.so lib/ cp _opam/share/apron/lib/libpolkaMPQ.so lib/ -wget -O lib/LICENSE.APRON https://raw.githubusercontent.com/antoinemine/apron/master/COPYING +cp _opam/.opam-switch/sources/apron/COPYING lib/LICENSE.APRON # done outside to ensure archive contains goblint/ directory cd .. -rm goblint/scripts/sv-comp/goblint.zip +rm goblint/sv-comp/goblint.zip -zip goblint/scripts/sv-comp/goblint.zip \ +zip goblint/sv-comp/goblint.zip \ goblint/goblint \ goblint/lib/libapron.so \ goblint/lib/liboctD.so \ goblint/lib/libboxD.so \ goblint/lib/libpolkaMPQ.so \ goblint/lib/LICENSE.APRON \ - goblint/conf/svcomp24.json \ - goblint/conf/svcomp24-validate.json \ + goblint/conf/svcomp23.json \ goblint/lib/libc/stub/include/assert.h \ goblint/lib/goblint/runtime/include/goblint.h \ goblint/lib/libc/stub/src/stdlib.c \ diff --git a/sv-comp/my-bench-sv-comp/.gitignore b/sv-comp/my-bench-sv-comp/.gitignore new file mode 100644 index 00000000000..2eb047c8d6d --- /dev/null +++ b/sv-comp/my-bench-sv-comp/.gitignore @@ -0,0 +1 @@ +*-tmp.xml diff --git a/sv-comp/my-bench-sv-comp/README.md b/sv-comp/my-bench-sv-comp/README.md new file mode 100644 index 00000000000..b401a1898cd --- /dev/null +++ b/sv-comp/my-bench-sv-comp/README.md @@ -0,0 +1,46 @@ +# my-bench-sv-comp +This directory contains BenchExec benchmark and table definitions for a number of use cases and shell scripts for running them. + +## goblint-all-fast +Run Goblint on a large number of reachability benchmarks with decreased timeout. + +Files: +* `goblint-all-fast.sh` +* `goblint-all-fast.xml` +* `table-generator-all-fast.xml` + + +## goblint-data-race +Run Goblint on data-race benchmarks. + +Files: +* `goblint-data-race.sh` +* `goblint-data-race.xml` +* `table-generator-data-race.xml` + + +## goblint-lint +Run Goblint and validate witnesses using witnesslinter. + +Files: +* `goblint-lint.sh` +* `goblint-lint.xml` +* `table-generator-lint.xml` +* `witnesslint-validate.xml` + + +## goblint +Run Goblint and validate witnesses using: +* CPAChecker, +* Ultimate Automizer, +* witnesslinter. + +Files: +* `cpa-validate-correctness.xml` +* `cpa-validate-violation.xml` +* `goblint.sh` +* `goblint.xml` +* `table-generator-witness.xml` +* `uautomizer-validate-correctness.xml` +* `uautomizer-validate-violation.xml` +* `witnesslint-validate2.xml` diff --git a/sv-comp/my-bench-sv-comp/cpa-validate-correctness.xml b/sv-comp/my-bench-sv-comp/cpa-validate-correctness.xml new file mode 100644 index 00000000000..dca5c52c6de --- /dev/null +++ b/sv-comp/my-bench-sv-comp/cpa-validate-correctness.xml @@ -0,0 +1,25 @@ + + + + + + **.graphml + + + + + + + RESULTSDIR/LOGDIR/${rundefinition_name}/${taskdef_name}/witness.graphml + + + + /home/simmo/benchexec/sv-benchmarks/c/SoftwareSystems-DeviceDriversLinux64-ReachSafety.set + /home/simmo/benchexec/sv-benchmarks/c/properties/unreach-call.prp + + + + diff --git a/sv-comp/my-bench-sv-comp/cpa-validate-violation.xml b/sv-comp/my-bench-sv-comp/cpa-validate-violation.xml new file mode 100644 index 00000000000..8fcffd7321a --- /dev/null +++ b/sv-comp/my-bench-sv-comp/cpa-validate-violation.xml @@ -0,0 +1,30 @@ + + + + + + **.graphml + + + + + + + + + + + + RESULTSDIR/LOGDIR/${rundefinition_name}/${taskdef_name}/witness.graphml + + + + /home/simmo/benchexec/sv-benchmarks/c/SoftwareSystems-DeviceDriversLinux64-ReachSafety.set + /home/simmo/benchexec/sv-benchmarks/c/properties/unreach-call.prp + + + + diff --git a/sv-comp/my-bench-sv-comp/goblint-all-fast.sh b/sv-comp/my-bench-sv-comp/goblint-all-fast.sh new file mode 100755 index 00000000000..c47ff101416 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/goblint-all-fast.sh @@ -0,0 +1,26 @@ +#!/usr/bin/env bash + +shopt -s extglob + +MYBENCHDIR=/mnt/goblint-svcomp/benchexec/my-bench-sv-comp +RESULTSDIR=/mnt/goblint-svcomp/benchexec/results/70-all-fast-no-interval +GOBLINTPARALLEL=14 + +mkdir $RESULTSDIR + +# Run verification +cd /mnt/goblint-svcomp/sv-comp/goblint +# read-only and overlay dirs for Value too large for defined data type workaround +benchexec --read-only-dir / --overlay-dir . --hidden-dir /home --outputpath $RESULTSDIR --numOfThreads $GOBLINTPARALLEL $MYBENCHDIR/goblint-all-fast.xml + +# Extract witness directory +cd $RESULTSDIR +LOGDIR=`echo goblint*.files` +echo $LOGDIR + +# Generate table with merged results and witness validation results +sed -e "s/LOGDIR/$LOGDIR/" $MYBENCHDIR/table-generator-all-fast.xml > table-generator.xml +table-generator -x table-generator.xml + +# Decompress all tool outputs for table HTML links +unzip -o goblint*.logfiles.zip \ No newline at end of file diff --git a/sv-comp/my-bench-sv-comp/goblint-all-fast.xml b/sv-comp/my-bench-sv-comp/goblint-all-fast.xml new file mode 100644 index 00000000000..6d4bb8fc3c4 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/goblint-all-fast.xml @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/ConcurrencySafety-Main.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/unreach-call.prp + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/pthread-wmm/* + + + + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/SoftwareSystems-DeviceDriversLinux64-ReachSafety.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/unreach-call.prp + + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/SoftwareSystems-DeviceDriversLinux64Large-ReachSafety.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/unreach-call.prp + + + + diff --git a/sv-comp/my-bench-sv-comp/goblint-data-race.sh b/sv-comp/my-bench-sv-comp/goblint-data-race.sh new file mode 100755 index 00000000000..b42e69d5cec --- /dev/null +++ b/sv-comp/my-bench-sv-comp/goblint-data-race.sh @@ -0,0 +1,26 @@ +#!/usr/bin/env bash + +shopt -s extglob + +MYBENCHDIR=/mnt/goblint-svcomp/benchexec/my-bench-sv-comp +RESULTSDIR=/mnt/goblint-svcomp/benchexec/results/data-race-results21-concurrencysafety-new +GOBLINTPARALLEL=14 + +mkdir $RESULTSDIR + +# Run verification +cd /mnt/goblint-svcomp/sv-comp/goblint +# read-only and overlay dirs for Value too large for defined data type workaround +benchexec --read-only-dir / --overlay-dir . --hidden-dir /home --outputpath $RESULTSDIR --numOfThreads $GOBLINTPARALLEL $MYBENCHDIR/goblint-data-race.xml + +# Extract witness directory +cd $RESULTSDIR +LOGDIR=`echo goblint*.files` +echo $LOGDIR + +# Generate table with merged results and witness validation results +sed -e "s/LOGDIR/$LOGDIR/" $MYBENCHDIR/table-generator-data-race.xml > table-generator.xml +table-generator -x table-generator.xml + +# Decompress all tool outputs for table HTML links +unzip -o goblint*.logfiles.zip \ No newline at end of file diff --git a/sv-comp/my-bench-sv-comp/goblint-data-race.xml b/sv-comp/my-bench-sv-comp/goblint-data-race.xml new file mode 100644 index 00000000000..f8c00b582ac --- /dev/null +++ b/sv-comp/my-bench-sv-comp/goblint-data-race.xml @@ -0,0 +1,17 @@ + + + + + + + + + + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/NoDataRace-ConcurrencySafety.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/no-data-race.prp + + + + diff --git a/sv-comp/my-bench-sv-comp/goblint-lint.sh b/sv-comp/my-bench-sv-comp/goblint-lint.sh new file mode 100755 index 00000000000..bbd1270a31a --- /dev/null +++ b/sv-comp/my-bench-sv-comp/goblint-lint.sh @@ -0,0 +1,42 @@ +#!/bin/bash + +shopt -s extglob + +MYBENCHDIR=/mnt/goblint-svcomp/benchexec/my-bench-sv-comp +RESULTSDIR=/mnt/goblint-svcomp/benchexec/results/new-results28-all-fast-systems-witness-linter +GOBLINTPARALLEL=15 +VALIDATEPARALLEL=15 + +mkdir $RESULTSDIR + +# Run verification +cd /mnt/goblint-svcomp/sv-comp/goblint +# read-only and overlay dirs for Value too large for defined data type workaround +benchexec --read-only-dir / --overlay-dir . --hidden-dir /home --outputpath $RESULTSDIR --numOfThreads $GOBLINTPARALLEL $MYBENCHDIR/goblint-lint.xml + +# Extract witness directory +cd $RESULTSDIR +LOGDIR=`echo goblint*.files` +echo $LOGDIR + +# Construct validation XMLs +cd $MYBENCHDIR +# witnesslint +sed -e "s|RESULTSDIR|$RESULTSDIR|" -e "s/LOGDIR/$LOGDIR/" witnesslint-validate.xml > witnesslint-validate-tmp.xml + +# Run validation +# witnesslint +cd /mnt/goblint-svcomp/benchexec/tools/witnesslint +benchexec --read-only-dir / --overlay-dir . --hidden-dir /home --outputpath $RESULTSDIR --numOfThreads $VALIDATEPARALLEL $MYBENCHDIR/witnesslint-validate-tmp.xml + +# Merge witness validation results +cd $RESULTSDIR +python3 /mnt/goblint-svcomp/benchexec/benchexec/contrib/mergeBenchmarkSets.py goblint*.results.!(*merged*).xml.bz2 witnesslint-validate-tmp.*.results.*.xml.bz2 + +# Generate table with merged results and witness validation results +sed -e "s/LOGDIR/$LOGDIR/" $MYBENCHDIR/table-generator-lint.xml > table-generator.xml +table-generator -x table-generator.xml + +# Decompress all tool outputs for table HTML links +unzip -o goblint*.logfiles.zip +unzip -o witnesslint-validate-tmp.*.logfiles.zip \ No newline at end of file diff --git a/sv-comp/my-bench-sv-comp/goblint-lint.xml b/sv-comp/my-bench-sv-comp/goblint-lint.xml new file mode 100644 index 00000000000..8cae0a2c696 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/goblint-lint.xml @@ -0,0 +1,68 @@ + + + + + + **.graphml + + + + + + + + + + + + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/SoftwareSystems-DeviceDriversLinux64-ReachSafety.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/unreach-call.prp + + + + diff --git a/sv-comp/my-bench-sv-comp/goblint.sh b/sv-comp/my-bench-sv-comp/goblint.sh new file mode 100755 index 00000000000..eaf74350de7 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/goblint.sh @@ -0,0 +1,63 @@ +#!/bin/bash + +shopt -s extglob + +MYBENCHDIR=/mnt/goblint-svcomp/benchexec/my-bench-sv-comp +RESULTSDIR=/mnt/goblint-svcomp/benchexec/results/new-results32-overflow +GOBLINTPARALLEL=15 +VALIDATEPARALLEL=4 # not enough memory for more + +mkdir $RESULTSDIR + +# Run verification +cd /mnt/goblint-svcomp/sv-comp/goblint +# read-only and overlay dirs for Value too large for defined data type workaround +benchexec --read-only-dir / --overlay-dir . --hidden-dir /home --outputpath $RESULTSDIR --numOfThreads $GOBLINTPARALLEL $MYBENCHDIR/goblint.xml + +# Extract witness directory +cd $RESULTSDIR +LOGDIR=`echo goblint.*.files` +echo $LOGDIR + +# Construct validation XMLs +cd $MYBENCHDIR +# witnesslint +sed -e "s|RESULTSDIR|$RESULTSDIR|" -e "s/LOGDIR/$LOGDIR/" witnesslint-validate2.xml > witnesslint-validate2-tmp.xml +# CPAChecker +# sed -e "s|RESULTSDIR|$RESULTSDIR|" -e "s/LOGDIR/$LOGDIR/" cpa-validate-correctness.xml > cpa-validate-correctness-tmp.xml +# sed -e "s|RESULTSDIR|$RESULTSDIR|" -e "s/LOGDIR/$LOGDIR/" cpa-validate-violation.xml > cpa-validate-violation-tmp.xml +# Ultimate +sed -e "s|RESULTSDIR|$RESULTSDIR|" -e "s/LOGDIR/$LOGDIR/" uautomizer-validate-correctness.xml > uautomizer-validate-correctness-tmp.xml +sed -e "s|RESULTSDIR|$RESULTSDIR|" -e "s/LOGDIR/$LOGDIR/" uautomizer-validate-violation.xml > uautomizer-validate-violation-tmp.xml + +# Run validation +# witnesslint +cd /mnt/goblint-svcomp/benchexec/tools/witnesslint +benchexec --read-only-dir / --overlay-dir . --hidden-dir /home --outputpath $RESULTSDIR --numOfThreads $VALIDATEPARALLEL $MYBENCHDIR/witnesslint-validate2-tmp.xml +# CPAChecker +# cd /home/simmo/benchexec/tools/CPAchecker-1.9-unix +# benchexec --outputpath $RESULTSDIR --numOfThreads $VALIDATEPARALLEL $MYBENCHDIR/cpa-validate-correctness-tmp.xml +# benchexec --outputpath $RESULTSDIR --numOfThreads $VALIDATEPARALLEL $MYBENCHDIR/cpa-validate-violation-tmp.xml +# Ultimate +cd /mnt/goblint-svcomp/benchexec/tools/UAutomizer-linux +benchexec --read-only-dir / --overlay-dir . --hidden-dir /home --outputpath $RESULTSDIR --numOfThreads $VALIDATEPARALLEL $MYBENCHDIR/uautomizer-validate-correctness-tmp.xml +benchexec --read-only-dir / --overlay-dir . --hidden-dir /home --outputpath $RESULTSDIR --numOfThreads $VALIDATEPARALLEL $MYBENCHDIR/uautomizer-validate-violation-tmp.xml + +# Merge witness validation results +cd $RESULTSDIR +# python3 /mnt/goblint-svcomp/benchexec/benchexec/contrib/mergeBenchmarkSets.py goblint.*.results.!(*merged*).xml.bz2 cpa-validate-correctness-tmp.*.results.*.xml.bz2 cpa-validate-violation-tmp.*.results.*.xml.bz2 uautomizer-validate-correctness-tmp.*.results.*.xml.bz2 uautomizer-validate-violation-tmp.*.results.*.xml.bz2 +# python3 /mnt/goblint-svcomp/benchexec/benchexec/contrib/mergeBenchmarkSets.py goblint.*.results.!(*merged*).xml.bz2 uautomizer-validate-correctness-tmp.*.results.*.xml.bz2 uautomizer-validate-violation-tmp.*.results.*.xml.bz2 witnesslint-validate2-tmp.*.results.*.xml.bz2 +python3 /mnt/goblint-svcomp/benchexec/benchexec/contrib/mergeBenchmarkSets.py goblint.*.results.*no-overflow.xml.bz2 uautomizer-validate-correctness-tmp.*.results.*no-overflow.xml.bz2 uautomizer-validate-violation-tmp.*.results.*no-overflow.xml.bz2 witnesslint-validate2-tmp.*.results.*no-overflow.xml.bz2 + +# Generate table with merged results and witness validation results +# table-generator goblint.*.results.*.xml.bz2.merged.xml.bz2 cpa-validate-correctness-tmp.*.results.*.xml.bz2 cpa-validate-violation-tmp.*.results.*.xml.bz2 uautomizer-validate-correctness-tmp.*.results.*.xml.bz2 uautomizer-validate-violation-tmp.*.results.*.xml.bz2 +sed -e "s/LOGDIR/$LOGDIR/" $MYBENCHDIR/table-generator-witness.xml > table-generator.xml +table-generator -x table-generator.xml + +# Decompress all tool outputs for table HTML links +unzip -o goblint.*.logfiles.zip +# unzip -o cpa-validate-correctness-tmp.*.logfiles.zip +# unzip -o cpa-validate-violation-tmp.*.logfiles.zip +unzip -o uautomizer-validate-correctness-tmp.*.logfiles.zip +unzip -o uautomizer-validate-violation-tmp.*.logfiles.zip +unzip -o witnesslint-validate2-tmp.*.logfiles.zip \ No newline at end of file diff --git a/sv-comp/my-bench-sv-comp/goblint.xml b/sv-comp/my-bench-sv-comp/goblint.xml new file mode 100644 index 00000000000..c5773f3569d --- /dev/null +++ b/sv-comp/my-bench-sv-comp/goblint.xml @@ -0,0 +1,38 @@ + + + + + + **.graphml + + + + + + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/NoOverflows-BitVectors.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/no-overflow.prp + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/NoOverflows-Other.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/no-overflow.prp + + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/SoftwareSystems-BusyBox-NoOverflows.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/no-overflow.prp + + + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/SoftwareSystems-uthash-NoOverflows.set + /mnt/goblint-svcomp/benchexec/sv-benchmarks/c/properties/no-overflow.prp + + + + + diff --git a/sv-comp/my-bench-sv-comp/table-generator-all-fast.xml b/sv-comp/my-bench-sv-comp/table-generator-all-fast.xml new file mode 100644 index 00000000000..c9b9932390f --- /dev/null +++ b/sv-comp/my-bench-sv-comp/table-generator-all-fast.xml @@ -0,0 +1,17 @@ + + + + + + + + + + + + + + + + +
diff --git a/sv-comp/my-bench-sv-comp/table-generator-data-race.xml b/sv-comp/my-bench-sv-comp/table-generator-data-race.xml new file mode 100644 index 00000000000..28410d18056 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/table-generator-data-race.xml @@ -0,0 +1,13 @@ + + + + + + + + + + + + +
diff --git a/sv-comp/my-bench-sv-comp/table-generator-lint.xml b/sv-comp/my-bench-sv-comp/table-generator-lint.xml new file mode 100644 index 00000000000..6ca64dc84e8 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/table-generator-lint.xml @@ -0,0 +1,16 @@ + + + + + + + + + witness + + + + + + +
diff --git a/sv-comp/my-bench-sv-comp/table-generator-witness.xml b/sv-comp/my-bench-sv-comp/table-generator-witness.xml new file mode 100644 index 00000000000..876c08d3922 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/table-generator-witness.xml @@ -0,0 +1,20 @@ + + + + + + + + + witness + + + + + + + + + + +
diff --git a/sv-comp/my-bench-sv-comp/uautomizer-validate-correctness.xml b/sv-comp/my-bench-sv-comp/uautomizer-validate-correctness.xml new file mode 100644 index 00000000000..efb08617755 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/uautomizer-validate-correctness.xml @@ -0,0 +1,33 @@ + + + + + **.graphml + + diff --git a/sv-comp/my-bench-sv-comp/uautomizer-validate-violation.xml b/sv-comp/my-bench-sv-comp/uautomizer-validate-violation.xml new file mode 100644 index 00000000000..fdf61b1bab6 --- /dev/null +++ b/sv-comp/my-bench-sv-comp/uautomizer-validate-violation.xml @@ -0,0 +1,32 @@ + + + + + **.graphml + + diff --git a/sv-comp/my-bench-sv-comp/witnesslint-validate.xml b/sv-comp/my-bench-sv-comp/witnesslint-validate.xml new file mode 100644 index 00000000000..96a41ef731e --- /dev/null +++ b/sv-comp/my-bench-sv-comp/witnesslint-validate.xml @@ -0,0 +1,17 @@ + + + + + diff --git a/sv-comp/my-bench-sv-comp/witnesslint-validate2.xml b/sv-comp/my-bench-sv-comp/witnesslint-validate2.xml new file mode 100644 index 00000000000..475bc9846eb --- /dev/null +++ b/sv-comp/my-bench-sv-comp/witnesslint-validate2.xml @@ -0,0 +1,31 @@ + + + + + diff --git a/scripts/sv-comp/sv-comp-run-no-overflow.py b/sv-comp/sv-comp-run-no-overflow.py similarity index 97% rename from scripts/sv-comp/sv-comp-run-no-overflow.py rename to sv-comp/sv-comp-run-no-overflow.py index 88ee2c0e531..a3461b1a643 100755 --- a/scripts/sv-comp/sv-comp-run-no-overflow.py +++ b/sv-comp/sv-comp-run-no-overflow.py @@ -13,7 +13,7 @@ OVERVIEW = False # with True Goblint isn't executed # TODO: don't hard-code specification -GOBLINT_COMMAND = "./goblint --conf conf/svcomp21.json --set ana.specification ./tests/sv-comp/no-overflow.prp --set witness.graphml.path {witness_filename} {code_filename} -v" +GOBLINT_COMMAND = "./goblint --conf conf/svcomp21.json --set ana.specification ./tests/sv-comp/no-overflow.prp --set witness.path {witness_filename} {code_filename} -v" TIMEOUT = 10 # with some int that's Goblint timeout for single execution START = 1 EXIT_ON_ERROR = True diff --git a/scripts/sv-comp/sv-comp-run.py b/sv-comp/sv-comp-run.py similarity index 98% rename from scripts/sv-comp/sv-comp-run.py rename to sv-comp/sv-comp-run.py index 977aa69ab6d..af7cada0511 100755 --- a/scripts/sv-comp/sv-comp-run.py +++ b/sv-comp/sv-comp-run.py @@ -13,7 +13,7 @@ OVERVIEW = False # with True Goblint isn't executed # TODO: don't hard-code specification -GOBLINT_COMMAND = "./goblint --conf conf/svcomp21.json --set ana.specification ./tests/sv-comp/unreach-call-__VERIFIER_error.prp --set witness.graphml.path {witness_filename} {code_filename}" +GOBLINT_COMMAND = "./goblint --conf conf/svcomp21.json --set ana.specification ./tests/sv-comp/unreach-call-__VERIFIER_error.prp --set witness.path {witness_filename} {code_filename}" TIMEOUT = 30 # with some int that's Goblint timeout for single execution START = 1 EXIT_ON_ERROR = True diff --git a/scripts/sv-comp/witness-isomorphism.py b/sv-comp/witness-isomorphism.py similarity index 100% rename from scripts/sv-comp/witness-isomorphism.py rename to sv-comp/witness-isomorphism.py diff --git a/scripts/sv-comp/yed-sv-comp.cnfx b/sv-comp/yed-sv-comp.cnfx similarity index 100% rename from scripts/sv-comp/yed-sv-comp.cnfx rename to sv-comp/yed-sv-comp.cnfx diff --git a/tests/regression/00-sanity/51-base-special-lval.c b/tests/regression/00-sanity/51-base-special-lval.c deleted file mode 100644 index 8f74a1babed..00000000000 --- a/tests/regression/00-sanity/51-base-special-lval.c +++ /dev/null @@ -1,13 +0,0 @@ -// Making sure special function lval is not invalidated recursively -#include - -extern int * anIntPlease(); -int main() { - int x = 0; - int *p = &x; - p = anIntPlease(); - - __goblint_check(x == 0); - - return 0; -} diff --git a/tests/regression/00-sanity/52-thread-unsafe-libfuns-single-thread.c b/tests/regression/00-sanity/52-thread-unsafe-libfuns-single-thread.c deleted file mode 100644 index 94c0f3efeb7..00000000000 --- a/tests/regression/00-sanity/52-thread-unsafe-libfuns-single-thread.c +++ /dev/null @@ -1,16 +0,0 @@ -// PARAM: --enable allglobs --set ana.activated[+] threadJoins -#include -#include - -void *t_benign(void *arg) { - return NULL; -} - -int main() { - rand(); - pthread_t id; - pthread_create(&id, NULL, t_benign, NULL); - pthread_join(id, NULL); - rand(); - return 0; -} \ No newline at end of file diff --git a/tests/regression/00-sanity/52-thread-unsafe-libfuns-single-thread.t b/tests/regression/00-sanity/52-thread-unsafe-libfuns-single-thread.t deleted file mode 100644 index 64413bae365..00000000000 --- a/tests/regression/00-sanity/52-thread-unsafe-libfuns-single-thread.t +++ /dev/null @@ -1,5 +0,0 @@ - $ goblint --enable allglobs --set ana.activated[+] threadJoins 52-thread-unsafe-libfuns-single-thread.c - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 8 - dead: 0 - total lines: 8 diff --git a/tests/regression/02-base/88-string-ptrs-limited.c b/tests/regression/02-base/88-string-ptrs-limited.c index c4f39dc7118..ab8b2fefe83 100644 --- a/tests/regression/02-base/88-string-ptrs-limited.c +++ b/tests/regression/02-base/88-string-ptrs-limited.c @@ -1,4 +1,4 @@ -//PARAM: --set ana.base.strings.domain flat +//PARAM: --enable ana.base.limit-string-addresses #include #include diff --git a/tests/regression/02-base/89-string-ptrs-not-limited.c b/tests/regression/02-base/89-string-ptrs-not-limited.c index ab30e21fd8f..96100d230de 100644 --- a/tests/regression/02-base/89-string-ptrs-not-limited.c +++ b/tests/regression/02-base/89-string-ptrs-not-limited.c @@ -1,4 +1,4 @@ -//PARAM: --set ana.base.strings.domain disjoint +//PARAM: --disable ana.base.limit-string-addresses #include #include diff --git a/tests/regression/03-practical/32-smtprc-tid.c b/tests/regression/03-practical/32-smtprc-tid.c deleted file mode 100644 index 1d4810ee2ef..00000000000 --- a/tests/regression/03-practical/32-smtprc-tid.c +++ /dev/null @@ -1,38 +0,0 @@ -#include -#include - -int threads_total = 4; -pthread_t *tids; - -void *cleaner(void *arg) { - while (1) { - for (int i = 0; i < threads_total; i++) { - if (tids[i]) { // RACE! - if (!pthread_join(tids[i], NULL)) // RACE! - tids[i] = 0; // RACE! - } - } - } - return NULL; -} - -void *thread(int i) { // wrong argument type is important - tids[i] = pthread_self(); // RACE! - return NULL; -} - -int main() { - pthread_t tid; - tids = malloc(threads_total * sizeof(pthread_t)); - - for(int i = 0; i < threads_total; i++) - tids[i] = 0; - - pthread_create(&tid, NULL, cleaner, NULL); - - for(int i = 0; i < threads_total; i++) { - pthread_create(&tid, NULL, thread, (int *)i); // cast is important - } - - return 0; -} diff --git a/tests/regression/04-mutex/49-type-invariants.t b/tests/regression/04-mutex/49-type-invariants.t index b6c43d21bcc..4c105d15598 100644 --- a/tests/regression/04-mutex/49-type-invariants.t +++ b/tests/regression/04-mutex/49-type-invariants.t @@ -14,10 +14,12 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (49-type-invariants.c:21:3-21:21) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (49-type-invariants.c:21:3-21:21) [Info][Unsound] Write to unknown address: privatization is unsound. (49-type-invariants.c:21:3-21:21) [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:21:3-21:21) - [Info][Imprecise] Invalidating expressions: & s (49-type-invariants.c:21:3-21:21) - [Info][Imprecise] Invalidating expressions: & tmp (49-type-invariants.c:21:3-21:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:21:3-21:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (49-type-invariants.c:21:3-21:21) [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:21:3-21:21) [Error][Imprecise][Unsound] Function definition missing @@ -37,9 +39,11 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (49-type-invariants.c:21:3-21:21) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (49-type-invariants.c:21:3-21:21) [Info][Unsound] Write to unknown address: privatization is unsound. (49-type-invariants.c:21:3-21:21) [Info][Imprecise] INVALIDATING ALL GLOBALS! (49-type-invariants.c:21:3-21:21) - [Info][Imprecise] Invalidating expressions: & s (49-type-invariants.c:21:3-21:21) - [Info][Imprecise] Invalidating expressions: & tmp (49-type-invariants.c:21:3-21:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (49-type-invariants.c:21:3-21:21) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (49-type-invariants.c:21:3-21:21) [Error][Imprecise][Unsound] Function definition missing for getS (49-type-invariants.c:21:3-21:21) [Error][Imprecise][Unsound] Function definition missing diff --git a/tests/regression/04-mutex/77-type-nested-fields.t b/tests/regression/04-mutex/77-type-nested-fields.t index 0ecf0515783..bb935cb0ed1 100644 --- a/tests/regression/04-mutex/77-type-nested-fields.t +++ b/tests/regression/04-mutex/77-type-nested-fields.t @@ -15,12 +15,16 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (77-type-nested-fields.c:31:3-31:20) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (77-type-nested-fields.c:31:3-31:20) [Info][Unsound] Write to unknown address: privatization is unsound. (77-type-nested-fields.c:31:3-31:20) + [Info][Unsound] Unknown address in {&tmp} has escaped. (77-type-nested-fields.c:38:3-38:22) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (77-type-nested-fields.c:38:3-38:22) [Info][Unsound] Write to unknown address: privatization is unsound. (77-type-nested-fields.c:38:3-38:22) [Info][Imprecise] INVALIDATING ALL GLOBALS! (77-type-nested-fields.c:31:3-31:20) - [Info][Imprecise] Invalidating expressions: & tmp (77-type-nested-fields.c:31:3-31:20) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (77-type-nested-fields.c:31:3-31:20) [Info][Imprecise] INVALIDATING ALL GLOBALS! (77-type-nested-fields.c:38:3-38:22) - [Info][Imprecise] Invalidating expressions: & tmp (77-type-nested-fields.c:38:3-38:22) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (77-type-nested-fields.c:38:3-38:22) [Error][Imprecise][Unsound] Function definition missing for getS (77-type-nested-fields.c:31:3-31:20) [Error][Imprecise][Unsound] Function definition missing for getT (77-type-nested-fields.c:38:3-38:22) [Error][Imprecise][Unsound] Function definition missing diff --git a/tests/regression/04-mutex/79-type-nested-fields-deep1.t b/tests/regression/04-mutex/79-type-nested-fields-deep1.t index 611a70a7c31..ba1399d225c 100644 --- a/tests/regression/04-mutex/79-type-nested-fields-deep1.t +++ b/tests/regression/04-mutex/79-type-nested-fields-deep1.t @@ -15,12 +15,16 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (79-type-nested-fields-deep1.c:36:3-36:20) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (79-type-nested-fields-deep1.c:36:3-36:20) [Info][Unsound] Write to unknown address: privatization is unsound. (79-type-nested-fields-deep1.c:36:3-36:20) + [Info][Unsound] Unknown address in {&tmp} has escaped. (79-type-nested-fields-deep1.c:43:3-43:24) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (79-type-nested-fields-deep1.c:43:3-43:24) [Info][Unsound] Write to unknown address: privatization is unsound. (79-type-nested-fields-deep1.c:43:3-43:24) [Info][Imprecise] INVALIDATING ALL GLOBALS! (79-type-nested-fields-deep1.c:36:3-36:20) - [Info][Imprecise] Invalidating expressions: & tmp (79-type-nested-fields-deep1.c:36:3-36:20) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (79-type-nested-fields-deep1.c:36:3-36:20) [Info][Imprecise] INVALIDATING ALL GLOBALS! (79-type-nested-fields-deep1.c:43:3-43:24) - [Info][Imprecise] Invalidating expressions: & tmp (79-type-nested-fields-deep1.c:43:3-43:24) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (79-type-nested-fields-deep1.c:43:3-43:24) [Error][Imprecise][Unsound] Function definition missing for getS (79-type-nested-fields-deep1.c:36:3-36:20) [Error][Imprecise][Unsound] Function definition missing for getU (79-type-nested-fields-deep1.c:43:3-43:24) [Error][Imprecise][Unsound] Function definition missing diff --git a/tests/regression/04-mutex/80-type-nested-fields-deep2.t b/tests/regression/04-mutex/80-type-nested-fields-deep2.t index 7ddbdc4fd7c..71bdcfb2e2b 100644 --- a/tests/regression/04-mutex/80-type-nested-fields-deep2.t +++ b/tests/regression/04-mutex/80-type-nested-fields-deep2.t @@ -15,12 +15,16 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (80-type-nested-fields-deep2.c:36:3-36:22) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (80-type-nested-fields-deep2.c:36:3-36:22) [Info][Unsound] Write to unknown address: privatization is unsound. (80-type-nested-fields-deep2.c:36:3-36:22) + [Info][Unsound] Unknown address in {&tmp} has escaped. (80-type-nested-fields-deep2.c:43:3-43:24) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (80-type-nested-fields-deep2.c:43:3-43:24) [Info][Unsound] Write to unknown address: privatization is unsound. (80-type-nested-fields-deep2.c:43:3-43:24) [Info][Imprecise] INVALIDATING ALL GLOBALS! (80-type-nested-fields-deep2.c:36:3-36:22) - [Info][Imprecise] Invalidating expressions: & tmp (80-type-nested-fields-deep2.c:36:3-36:22) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (80-type-nested-fields-deep2.c:36:3-36:22) [Info][Imprecise] INVALIDATING ALL GLOBALS! (80-type-nested-fields-deep2.c:43:3-43:24) - [Info][Imprecise] Invalidating expressions: & tmp (80-type-nested-fields-deep2.c:43:3-43:24) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (80-type-nested-fields-deep2.c:43:3-43:24) [Error][Imprecise][Unsound] Function definition missing for getT (80-type-nested-fields-deep2.c:36:3-36:22) [Error][Imprecise][Unsound] Function definition missing for getU (80-type-nested-fields-deep2.c:43:3-43:24) [Error][Imprecise][Unsound] Function definition missing diff --git a/tests/regression/04-mutex/90-distribute-fields-type-1.t b/tests/regression/04-mutex/90-distribute-fields-type-1.t index 587e943b363..46435045b96 100644 --- a/tests/regression/04-mutex/90-distribute-fields-type-1.t +++ b/tests/regression/04-mutex/90-distribute-fields-type-1.t @@ -17,12 +17,16 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (90-distribute-fields-type-1.c:31:3-31:20) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (90-distribute-fields-type-1.c:31:3-31:20) [Info][Unsound] Write to unknown address: privatization is unsound. (90-distribute-fields-type-1.c:31:3-31:20) + [Info][Unsound] Unknown address in {&tmp} has escaped. (90-distribute-fields-type-1.c:39:3-39:17) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (90-distribute-fields-type-1.c:39:3-39:17) [Info][Unsound] Write to unknown address: privatization is unsound. (90-distribute-fields-type-1.c:39:3-39:17) [Info][Imprecise] INVALIDATING ALL GLOBALS! (90-distribute-fields-type-1.c:31:3-31:20) - [Info][Imprecise] Invalidating expressions: & tmp (90-distribute-fields-type-1.c:31:3-31:20) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (90-distribute-fields-type-1.c:31:3-31:20) [Info][Imprecise] INVALIDATING ALL GLOBALS! (90-distribute-fields-type-1.c:39:3-39:17) - [Info][Imprecise] Invalidating expressions: & tmp (90-distribute-fields-type-1.c:39:3-39:17) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (90-distribute-fields-type-1.c:39:3-39:17) [Error][Imprecise][Unsound] Function definition missing for getS (90-distribute-fields-type-1.c:31:3-31:20) [Error][Imprecise][Unsound] Function definition missing for getT (90-distribute-fields-type-1.c:39:3-39:17) [Error][Imprecise][Unsound] Function definition missing diff --git a/tests/regression/04-mutex/91-distribute-fields-type-2.t b/tests/regression/04-mutex/91-distribute-fields-type-2.t index afb01fdceda..c7e66c0527e 100644 --- a/tests/regression/04-mutex/91-distribute-fields-type-2.t +++ b/tests/regression/04-mutex/91-distribute-fields-type-2.t @@ -17,12 +17,16 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (91-distribute-fields-type-2.c:32:3-32:17) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (91-distribute-fields-type-2.c:32:3-32:17) [Info][Unsound] Write to unknown address: privatization is unsound. (91-distribute-fields-type-2.c:32:3-32:17) + [Info][Unsound] Unknown address in {&tmp} has escaped. (91-distribute-fields-type-2.c:40:3-40:17) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (91-distribute-fields-type-2.c:40:3-40:17) [Info][Unsound] Write to unknown address: privatization is unsound. (91-distribute-fields-type-2.c:40:3-40:17) [Info][Imprecise] INVALIDATING ALL GLOBALS! (91-distribute-fields-type-2.c:32:3-32:17) - [Info][Imprecise] Invalidating expressions: & tmp (91-distribute-fields-type-2.c:32:3-32:17) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (91-distribute-fields-type-2.c:32:3-32:17) [Info][Imprecise] INVALIDATING ALL GLOBALS! (91-distribute-fields-type-2.c:40:3-40:17) - [Info][Imprecise] Invalidating expressions: & tmp (91-distribute-fields-type-2.c:40:3-40:17) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (91-distribute-fields-type-2.c:40:3-40:17) [Error][Imprecise][Unsound] Function definition missing for getS (91-distribute-fields-type-2.c:32:3-32:17) [Error][Imprecise][Unsound] Function definition missing for getT (91-distribute-fields-type-2.c:40:3-40:17) [Error][Imprecise][Unsound] Function definition missing diff --git a/tests/regression/04-mutex/92-distribute-fields-type-deep.t b/tests/regression/04-mutex/92-distribute-fields-type-deep.t index 1748b245e29..4fc1c7e1015 100644 --- a/tests/regression/04-mutex/92-distribute-fields-type-deep.t +++ b/tests/regression/04-mutex/92-distribute-fields-type-deep.t @@ -17,12 +17,16 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (92-distribute-fields-type-deep.c:36:3-36:20) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (92-distribute-fields-type-deep.c:36:3-36:20) [Info][Unsound] Write to unknown address: privatization is unsound. (92-distribute-fields-type-deep.c:36:3-36:20) + [Info][Unsound] Unknown address in {&tmp} has escaped. (92-distribute-fields-type-deep.c:44:3-44:17) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (92-distribute-fields-type-deep.c:44:3-44:17) [Info][Unsound] Write to unknown address: privatization is unsound. (92-distribute-fields-type-deep.c:44:3-44:17) [Info][Imprecise] INVALIDATING ALL GLOBALS! (92-distribute-fields-type-deep.c:36:3-36:20) - [Info][Imprecise] Invalidating expressions: & tmp (92-distribute-fields-type-deep.c:36:3-36:20) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (92-distribute-fields-type-deep.c:36:3-36:20) [Info][Imprecise] INVALIDATING ALL GLOBALS! (92-distribute-fields-type-deep.c:44:3-44:17) - [Info][Imprecise] Invalidating expressions: & tmp (92-distribute-fields-type-deep.c:44:3-44:17) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (92-distribute-fields-type-deep.c:44:3-44:17) [Error][Imprecise][Unsound] Function definition missing for getS (92-distribute-fields-type-deep.c:36:3-36:20) [Error][Imprecise][Unsound] Function definition missing for getU (92-distribute-fields-type-deep.c:44:3-44:17) [Error][Imprecise][Unsound] Function definition missing diff --git a/tests/regression/04-mutex/93-distribute-fields-type-global.t b/tests/regression/04-mutex/93-distribute-fields-type-global.t index 50c72aa2895..bf34d99936e 100644 --- a/tests/regression/04-mutex/93-distribute-fields-type-global.t +++ b/tests/regression/04-mutex/93-distribute-fields-type-global.t @@ -16,9 +16,11 @@ live: 7 dead: 0 total lines: 7 + [Info][Unsound] Unknown address in {&tmp} has escaped. (93-distribute-fields-type-global.c:13:3-13:29) + [Info][Unsound] Unknown value in {?} could be an escaped pointer address! (93-distribute-fields-type-global.c:13:3-13:29) [Info][Unsound] Write to unknown address: privatization is unsound. (93-distribute-fields-type-global.c:13:3-13:29) [Info][Imprecise] INVALIDATING ALL GLOBALS! (93-distribute-fields-type-global.c:13:3-13:29) - [Info][Imprecise] Invalidating expressions: & s (93-distribute-fields-type-global.c:13:3-13:29) - [Info][Imprecise] Invalidating expressions: & tmp (93-distribute-fields-type-global.c:13:3-13:29) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(s, NoOffset)) (93-distribute-fields-type-global.c:13:3-13:29) + [Info][Imprecise] Invalidating expressions: AddrOf(Var(tmp, NoOffset)) (93-distribute-fields-type-global.c:13:3-13:29) [Error][Imprecise][Unsound] Function definition missing for getS (93-distribute-fields-type-global.c:13:3-13:29) [Error][Imprecise][Unsound] Function definition missing diff --git a/tests/regression/09-regions/38-escape_malloc.c b/tests/regression/09-regions/38-escape_malloc.c index c849d5bbe3d..9f5b44531e2 100644 --- a/tests/regression/09-regions/38-escape_malloc.c +++ b/tests/regression/09-regions/38-escape_malloc.c @@ -9,7 +9,7 @@ pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER; void *t_fun(void *arg) { int *p = (int *) arg; pthread_mutex_lock(&mutex1); - (*p)++; // RACE! + (*p)++; // TODO RACE! pthread_mutex_unlock(&mutex1); return NULL; } @@ -20,7 +20,7 @@ int main(void) { // TODO: q escapes as region owner pthread_create(&id, NULL, t_fun, (void *) q); pthread_mutex_lock(&mutex2); - (*q)++; // RACE! + (*q)++; // TODO RACE! pthread_mutex_unlock(&mutex2); pthread_join (id, NULL); return 0; diff --git a/tests/regression/09-regions/41-per-thread-array-init-race.c b/tests/regression/09-regions/41-per-thread-array-init-race.c deleted file mode 100644 index f6d267495e0..00000000000 --- a/tests/regression/09-regions/41-per-thread-array-init-race.c +++ /dev/null @@ -1,40 +0,0 @@ -// PARAM: --set ana.activated[+] region --enable ana.sv-comp.functions -// Per-thread array pointers passed via argument but initialized before thread create. -// Extracted from silver searcher. -#include -#include -extern void abort(void); -void assume_abort_if_not(int cond) { - if(!cond) {abort();} -} -extern int __VERIFIER_nondet_int(); - -void *thread(void *arg) { - int *p = arg; - int i = *p; // RACE! - return NULL; -} - -int main() { - int threads_total = __VERIFIER_nondet_int(); - assume_abort_if_not(threads_total >= 0); - - pthread_t *tids = malloc(threads_total * sizeof(pthread_t)); - int *is = calloc(threads_total, sizeof(int)); - - // create threads - for (int i = 0; i < threads_total; i++) { - pthread_create(&tids[i], NULL, &thread, &is[i]); // may fail but doesn't matter - is[i] = i; // RACE! - } - - // join threads - for (int i = 0; i < threads_total; i++) { - pthread_join(tids[i], NULL); - } - - free(tids); - free(is); - - return 0; -} diff --git a/tests/regression/10-synch/20-race-2_1-container_of.c b/tests/regression/10-synch/20-race-2_1-container_of.c index 04d5facbb73..6083cf4ca09 100644 --- a/tests/regression/10-synch/20-race-2_1-container_of.c +++ b/tests/regression/10-synch/20-race-2_1-container_of.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.activated[+] thread --set ana.path_sens[+] threadflag --enable ana.sv-comp.functions +// PARAM: --set ana.activated[+] thread --set ana.path_sens[+] threadflag #include #include #include diff --git a/tests/regression/10-synch/28-join-array.c b/tests/regression/10-synch/28-join-array.c deleted file mode 100644 index 99813b9810d..00000000000 --- a/tests/regression/10-synch/28-join-array.c +++ /dev/null @@ -1,25 +0,0 @@ -// PARAM: --set ana.activated[+] thread -#include - -int data = 0; -pthread_mutex_t data_mutex; - -void *thread(void *arg) { - pthread_mutex_lock(&data_mutex); - data = 3; // RACE! - pthread_mutex_unlock(&data_mutex); - return NULL; -} - -int main() { - pthread_t tids[2]; - - pthread_create(&tids[0], NULL, &thread, NULL); - pthread_create(&tids[1], NULL, &thread, NULL); - - pthread_join(tids[0], NULL); - - data = 1; //RACE! - - return 1; -} diff --git a/tests/regression/18-file/01-ok.c b/tests/regression/18-file/01-ok.c new file mode 100644 index 00000000000..5c1f21ff1cd --- /dev/null +++ b/tests/regression/18-file/01-ok.c @@ -0,0 +1,12 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + fp = fopen("test.txt", "a"); + fprintf(fp, "Testing...\n"); + fclose(fp); +} + +// All ok! diff --git a/tests/regression/18-file/02-function.c b/tests/regression/18-file/02-function.c new file mode 100644 index 00000000000..fc3157c2641 --- /dev/null +++ b/tests/regression/18-file/02-function.c @@ -0,0 +1,17 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +void f(){ + fp = fopen("test.txt", "a"); +} + +int main(){ + f(); + fprintf(fp, "Testing...\n"); + fclose(fp); +} + +// All ok! diff --git a/tests/regression/18-file/03-if-close.c b/tests/regression/18-file/03-if-close.c new file mode 100644 index 00000000000..b2bf1ebe97f --- /dev/null +++ b/tests/regression/18-file/03-if-close.c @@ -0,0 +1,15 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + int b; + fp = fopen("test.txt", "a"); // WARN: MAYBE file is never closed + + fprintf(fp, "Testing...\n"); + + if (b) + fclose(fp); +} // WARN: MAYBE unclosed files: fp diff --git a/tests/regression/18-file/04-no-open.c b/tests/regression/18-file/04-no-open.c new file mode 100644 index 00000000000..70683f38521 --- /dev/null +++ b/tests/regression/18-file/04-no-open.c @@ -0,0 +1,10 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + fprintf(fp, "Testing...\n"); // WARN: writing to unopened file handle fp + fclose(fp); // WARN: closeing unopened file handle fp +} diff --git a/tests/regression/18-file/05-open-mode.c b/tests/regression/18-file/05-open-mode.c new file mode 100644 index 00000000000..77326d7a70f --- /dev/null +++ b/tests/regression/18-file/05-open-mode.c @@ -0,0 +1,11 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + fp = fopen("test.txt", "r"); + fprintf(fp, "Testing...\n"); // WARN: writing to read-only file handle fp + fclose(fp); +} diff --git a/tests/regression/18-file/06-2open.c b/tests/regression/18-file/06-2open.c new file mode 100644 index 00000000000..2826c2f1dcb --- /dev/null +++ b/tests/regression/18-file/06-2open.c @@ -0,0 +1,12 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + fp = fopen("test1.txt", "a"); // WARN: file is never closed + fp = fopen("test2.txt", "a"); // WARN: overwriting still opened file handle fp + fprintf(fp, "Testing...\n"); + fclose(fp); +} // WARN: unclosed files: fp diff --git a/tests/regression/18-file/07-2close.c b/tests/regression/18-file/07-2close.c new file mode 100644 index 00000000000..0545bf9814f --- /dev/null +++ b/tests/regression/18-file/07-2close.c @@ -0,0 +1,11 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + fp = fopen("test.txt", "a"); + fprintf(fp, "Testing...\n"); + fclose(fp); + fclose(fp); // WARN: closeing already closed file handle fp +} diff --git a/tests/regression/18-file/08-var-reuse.c b/tests/regression/18-file/08-var-reuse.c new file mode 100644 index 00000000000..1caa238517e --- /dev/null +++ b/tests/regression/18-file/08-var-reuse.c @@ -0,0 +1,15 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + fp = fopen("test.txt", "a"); + fprintf(fp, "Testing...\n"); + fclose(fp); + fp = fopen("test2.txt", "a"); + fprintf(fp, "Testing...\n"); + fclose(fp); +} + +// All ok! diff --git a/tests/regression/18-file/09-inf-loop-no-close.c b/tests/regression/18-file/09-inf-loop-no-close.c new file mode 100644 index 00000000000..e9563ef1954 --- /dev/null +++ b/tests/regression/18-file/09-inf-loop-no-close.c @@ -0,0 +1,17 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + int i; + fp = fopen("test.txt", "a"); // WARN: file is never closed + + while (i){ + fprintf(fp, "Testing...\n"); + i++; + } + + //fclose(fp); +} // WARN: unclosed files: fp diff --git a/tests/regression/18-file/10-inf-loop-ok.c b/tests/regression/18-file/10-inf-loop-ok.c new file mode 100644 index 00000000000..d88fde272e0 --- /dev/null +++ b/tests/regression/18-file/10-inf-loop-ok.c @@ -0,0 +1,19 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + int i; + fp = fopen("test.txt", "a"); + + while (i){ + fprintf(fp, "Testing...\n"); + i++; + } + + fclose(fp); +} + +// All ok. diff --git a/tests/regression/18-file/11-2if.c b/tests/regression/18-file/11-2if.c new file mode 100644 index 00000000000..e24fec6e462 --- /dev/null +++ b/tests/regression/18-file/11-2if.c @@ -0,0 +1,18 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + int b; + fp = fopen("test.txt", "a"); // WARN: MAYBE file is never closed + + if (b) + fclose(fp); + + fprintf(fp, "Testing...\n"); // WARN: MAYBE writing to closed file handle fp + + if (!b) + fclose(fp); // WARN: MAYBE closeing already closed file handle fp +} // WARN: MAYBE unclosed files: fp diff --git a/tests/regression/18-file/12-2close-if.c b/tests/regression/18-file/12-2close-if.c new file mode 100644 index 00000000000..4934b331140 --- /dev/null +++ b/tests/regression/18-file/12-2close-if.c @@ -0,0 +1,15 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + int b; + fp = fopen("test.txt", "a"); + fprintf(fp, "Testing...\n"); + + if (b) + fclose(fp); + + fclose(fp); // WARN: MAYBE closeing already closed file handle fp +} diff --git a/tests/regression/18-file/13-ptr-arith-ok.c b/tests/regression/18-file/13-ptr-arith-ok.c new file mode 100644 index 00000000000..f707110957d --- /dev/null +++ b/tests/regression/18-file/13-ptr-arith-ok.c @@ -0,0 +1,16 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + fp = fopen("test.txt", "a"); // WARN: MAYBE file is never closed + fprintf(fp, "Testing...\n"); + + fp++; // WARN: changed pointer fp (no longer safe) + fp--; // WARN: changed pointer fp (no longer safe) + + fclose(fp); // WARN: MAYBE closeing already closed file handle fp +} // WARN: MAYBE unclosed files: fp + +// OPT: All ok! diff --git a/tests/regression/18-file/14-ptr-arith-close.c b/tests/regression/18-file/14-ptr-arith-close.c new file mode 100644 index 00000000000..3f9cd21ee20 --- /dev/null +++ b/tests/regression/18-file/14-ptr-arith-close.c @@ -0,0 +1,13 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + fp = fopen("test.txt", "a"); // WARN: MAYBE file is never closed + fprintf(fp, "Testing...\n"); + + fp++; // WARN: changed pointer fp (no longer safe) + + fclose(fp); // WARN: MAYBE closeing already closed file handle fp +} // WARN: MAYBE unclosed files: fp diff --git a/tests/regression/18-file/15-var-switch.c b/tests/regression/18-file/15-var-switch.c new file mode 100644 index 00000000000..d7f74b85db8 --- /dev/null +++ b/tests/regression/18-file/15-var-switch.c @@ -0,0 +1,18 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp1; + fp1 = fopen("test.txt", "a"); + fprintf(fp1, "Testing...\n"); + + FILE *fp2; + fp2 = fopen("test.txt", "a"); // WARN: file is never closed + fprintf(fp2, "Testing...\n"); + + fp2 = fp1; + + fclose(fp1); + fclose(fp2); // WARN: closeing already closed file handle fp2 +} // WARN: unclosed files: fp2 diff --git a/tests/regression/18-file/16-var-reuse-close.c b/tests/regression/18-file/16-var-reuse-close.c new file mode 100644 index 00000000000..cb1fb5fd220 --- /dev/null +++ b/tests/regression/18-file/16-var-reuse-close.c @@ -0,0 +1,14 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + fp = fopen("test.txt", "a"); + fprintf(fp, "Testing...\n"); + fclose(fp); + + fp = fopen("test.txt", "a"); // WARN: file is never closed + fprintf(fp, "Testing...\n"); + // fclose(fp); +} // WARN: unclosed files: fp diff --git a/tests/regression/18-file/17-myfopen.c b/tests/regression/18-file/17-myfopen.c new file mode 100644 index 00000000000..3e005c6e700 --- /dev/null +++ b/tests/regression/18-file/17-myfopen.c @@ -0,0 +1,21 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + + +FILE* myfopen(){ + // FILE *fp_tmp = fopen("test.txt", "a"); // local! + return fopen("test.txt", "a"); +} + +int main(){ + FILE *fp1; + FILE *fp2; + fp1 = myfopen(); + fp2 = myfopen(); // WARN: file is never closed + + fprintf(fp1, "Testing...\n"); + fclose(fp1); + fprintf(fp2, "Testing...\n"); + // fclose(fp2); +} // WARN: unclosed files: fp2 diff --git a/tests/regression/18-file/18-myfopen-arg.c b/tests/regression/18-file/18-myfopen-arg.c new file mode 100644 index 00000000000..5d98db4c530 --- /dev/null +++ b/tests/regression/18-file/18-myfopen-arg.c @@ -0,0 +1,20 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + + +FILE* myfopen(char* f){ + return fopen(f, "a"); +} + +int main(){ + FILE *fp1; + FILE *fp2; + fp1 = myfopen("test1.txt"); + fp2 = myfopen("test2.txt"); // WARN: file is never closed + + fprintf(fp1, "Testing...\n"); + fclose(fp1); + fprintf(fp2, "Testing...\n"); + // fclose(fp2); +} // WARN: unclosed files: fp2 diff --git a/tests/regression/18-file/19-if-close-else.c b/tests/regression/18-file/19-if-close-else.c new file mode 100644 index 00000000000..049e8454b41 --- /dev/null +++ b/tests/regression/18-file/19-if-close-else.c @@ -0,0 +1,17 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + int b; + fp = fopen("test.txt", "a"); + + if (b) + fclose(fp); + else + fprintf(fp, "Testing...\n"); + + fclose(fp); // WARN: MAYBE closeing already closed file handle fp +} diff --git a/tests/regression/18-file/20-loop-close.c b/tests/regression/18-file/20-loop-close.c new file mode 100644 index 00000000000..981248c152a --- /dev/null +++ b/tests/regression/18-file/20-loop-close.c @@ -0,0 +1,18 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + int i; + fp = fopen("test.txt", "a"); // WARN: MAYBE file is never closed + + while (i){ // May closed (11, 3), open(test.txt, Write) (7, 3) + fprintf(fp, "Testing...\n"); // WARN: MAYBE writing to closed file handle fp + fclose(fp); // WARN: MAYBE closeing already closed file handle fp + i++; + } + // why: fp -> Must open(test.txt, Write) (7, 3) + // -> because loop wouldn't exit? +} // WARN: MAYBE unclosed files: fp diff --git a/tests/regression/18-file/21-for-i.c b/tests/regression/18-file/21-for-i.c new file mode 100644 index 00000000000..e41bb9b0053 --- /dev/null +++ b/tests/regression/18-file/21-for-i.c @@ -0,0 +1,26 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE *fp; + +int main(){ + int i; + fp = fopen("test.txt", "w"); // WARN: MAYBE file is never closed + + for(i=1; i<10; i++){ // join + // i -> Unknown int + if(i%2){ + // i -> Unknown int + // fprintf(fp, "Testing...%s\n", i); // Segmentation fault! + // actually shouldn't warn because open and close are always alternating... + fprintf(fp, "Testing...%i\n", i); // WARN: MAYBE writing to closed file handle fp + fclose(fp); // WARN: MAYBE closeing already closed file handle fp + }else{ + fp = fopen("test.txt", "a"); // WARN: MAYBE file is never closed + } + // why no join? + } + // fp opened or closed? (last i=9 -> open) + // widening -> Warn: might be unclosed +} // WARN: MAYBE unclosed files: fp diff --git a/tests/regression/18-file/22-f_int.c b/tests/regression/18-file/22-f_int.c new file mode 100644 index 00000000000..f0376fc5a97 --- /dev/null +++ b/tests/regression/18-file/22-f_int.c @@ -0,0 +1,13 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int f(int x){ + return 2*x; +} + +int main(){ + int a = 1; + a = f(2); + return 0; +} diff --git a/tests/regression/18-file/23-f_str.c b/tests/regression/18-file/23-f_str.c new file mode 100644 index 00000000000..81224d2e72e --- /dev/null +++ b/tests/regression/18-file/23-f_str.c @@ -0,0 +1,13 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +char* f(char* x){ + return x; +} + +int main(){ + char* a = "foo"; + a = f("bar"); + return 0; +} diff --git a/tests/regression/18-file/24-f_wstr.c b/tests/regression/18-file/24-f_wstr.c new file mode 100644 index 00000000000..2379c1f7188 --- /dev/null +++ b/tests/regression/18-file/24-f_wstr.c @@ -0,0 +1,14 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include +#include + +wchar_t* f(wchar_t* x){ + return x; +} + +int main(){ + wchar_t* a = L"foo"; + a = f(L"bar"); + return 0; +} diff --git a/tests/regression/18-file/25-mem-ok.c b/tests/regression/18-file/25-mem-ok.c new file mode 100644 index 00000000000..00ba189b8d3 --- /dev/null +++ b/tests/regression/18-file/25-mem-ok.c @@ -0,0 +1,29 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp[3]; + // Array -> varinfo with index-offset + fp[1] = fopen("test.txt", "a"); + fprintf(fp[1], "Testing...\n"); + fclose(fp[1]); + + + struct foo { + int i; + FILE *fp; + } bar; + // Struct -> varinfo with field-offset + bar.fp = fopen("test.txt", "a"); + fprintf(bar.fp, "Testing...\n"); + fclose(bar.fp); + + + // Pointer -> Mem exp + *(fp+2) = fopen("test.txt", "a"); + fprintf(*(fp+2), "Testing...\n"); + fclose(*(fp+2)); +} + +// All ok! diff --git a/tests/regression/18-file/26-open-error-ok.c b/tests/regression/18-file/26-open-error-ok.c new file mode 100644 index 00000000000..5cf3aaf7bb2 --- /dev/null +++ b/tests/regression/18-file/26-open-error-ok.c @@ -0,0 +1,15 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main (){ + FILE *fp; + fp = fopen("test.txt", "w"); + + if(fp!=NULL){ + fprintf(fp, "Testing..."); + fclose(fp); + } +} + +// All ok! diff --git a/tests/regression/18-file/27-open-error.c b/tests/regression/18-file/27-open-error.c new file mode 100644 index 00000000000..bd3048208fc --- /dev/null +++ b/tests/regression/18-file/27-open-error.c @@ -0,0 +1,13 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main (){ + FILE *fp; + fp = fopen("test.txt", "w"); // WARN: MAYBE file is never closed + + if(fp==NULL){ + fprintf(fp, "Testing..."); // WARN: writing to unopened file handle fp + fclose(fp); // WARN: closeing unopened file handle fp + } +} // WARN: MAYBE unclosed files: fp diff --git a/tests/regression/18-file/28-multiple-exits.c b/tests/regression/18-file/28-multiple-exits.c new file mode 100644 index 00000000000..04fa5abab0b --- /dev/null +++ b/tests/regression/18-file/28-multiple-exits.c @@ -0,0 +1,14 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + fp = fopen("test.txt", "a"); // WARN: MAYBE file is never closed + fprintf(fp, "Testing...\n"); + int b; + if(b) + return 1; // WARN: unclosed files: fp + fclose(fp); + return 0; +} diff --git a/tests/regression/18-file/29-alias-global.c b/tests/regression/18-file/29-alias-global.c new file mode 100644 index 00000000000..17b94748c06 --- /dev/null +++ b/tests/regression/18-file/29-alias-global.c @@ -0,0 +1,22 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE* fp; +FILE* myfopen(char* f){ + fp = fopen(f, "a"); + return fp; +} + +int main(){ + FILE *fp1; + FILE *fp2; + fp1 = myfopen("test1.txt"); + fp2 = myfopen("test2.txt"); + fprintf(fp1, "Testing...\n"); + fclose(fp1); + fprintf(fp2, "Testing...\n"); + fclose(fp2); +} + +// All ok! diff --git a/tests/regression/18-file/30-ptr-of-ptr.c b/tests/regression/18-file/30-ptr-of-ptr.c new file mode 100644 index 00000000000..5a8d1f97a9f --- /dev/null +++ b/tests/regression/18-file/30-ptr-of-ptr.c @@ -0,0 +1,14 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp1; + fp1 = fopen("test.txt", "a"); + FILE **fp2; + + fp2 = &fp1; + + fclose(fp1); + fclose(*fp2); // WARN: closeing already closed file handle fp1 +} diff --git a/tests/regression/18-file/31-var-reuse-fun.c b/tests/regression/18-file/31-var-reuse-fun.c new file mode 100644 index 00000000000..9c0ccb16a22 --- /dev/null +++ b/tests/regression/18-file/31-var-reuse-fun.c @@ -0,0 +1,16 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +FILE* myfopen(char* f){ + FILE* fp; + fp = fopen(f, "a"); + return fp; +} + +int main(){ + FILE *fp; + fp = fopen("test1.txt", "a"); // WARN: file is never closed + fp = myfopen("test2.txt"); // WARN: overwriting still opened file handle fp + fclose(fp); +} // WARN: unclosed files: fp diff --git a/tests/regression/18-file/32-multi-ptr-close.c b/tests/regression/18-file/32-multi-ptr-close.c new file mode 100644 index 00000000000..e252d563a55 --- /dev/null +++ b/tests/regression/18-file/32-multi-ptr-close.c @@ -0,0 +1,25 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp1; + fp1 = fopen("test1.txt", "a"); + fprintf(fp1, "Testing...\n"); + + FILE *fp2; + fp2 = fopen("test2.txt", "a"); + fprintf(fp2, "Testing...\n"); + + FILE **fp; + int b; + if(b){ + fp = &fp1; + }else{ + fp = &fp2; + } + + fclose(*fp); + fclose(fp1); // WARN: MAYBE closeing already closed file handle fp1 + fclose(fp2); // WARN: MAYBE closeing already closed file handle fp2 +} diff --git a/tests/regression/18-file/33-multi-ptr-open.c b/tests/regression/18-file/33-multi-ptr-open.c new file mode 100644 index 00000000000..b3cfa0ade4d --- /dev/null +++ b/tests/regression/18-file/33-multi-ptr-open.c @@ -0,0 +1,23 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp1; + fp1 = fopen("test1.txt", "a"); // WARN: MAYBE file is never closed + + FILE *fp2; + fp2 = fopen("test2.txt", "r"); // WARN: MAYBE file is never closed + + FILE **fp; + int b; + if(b){ + fp = &fp1; + }else{ + fp = &fp2; + } + + fprintf(*fp, "Testing...\n"); // WARN: MAYBE writing to read-only file handle fp + + fclose(*fp); +} // WARN: MAYBE unclosed files: fp1, fp2 diff --git a/tests/regression/18-file/34-multi-alias-close.c b/tests/regression/18-file/34-multi-alias-close.c new file mode 100644 index 00000000000..0ebb9ddd308 --- /dev/null +++ b/tests/regression/18-file/34-multi-alias-close.c @@ -0,0 +1,25 @@ +// SKIP PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp1; + fp1 = fopen("test1.txt", "a"); + fprintf(fp1, "Testing...\n"); + + FILE *fp2; + fp2 = fopen("test2.txt", "a"); + fprintf(fp2, "Testing...\n"); + + FILE *fp; + int b; + if(b){ + fp = fp1; + }else{ + fp = fp2; + } + + fclose(fp); + fclose(fp1); // WARN: MAYBE closeing already closed file handle fp1 + fclose(fp2); // WARN: MAYBE closeing already closed file handle fp2 +} diff --git a/tests/regression/18-file/35-multi-alias-open.c b/tests/regression/18-file/35-multi-alias-open.c new file mode 100644 index 00000000000..21a4a9cca6f --- /dev/null +++ b/tests/regression/18-file/35-multi-alias-open.c @@ -0,0 +1,23 @@ +// SKIP PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp1; + fp1 = fopen("test1.txt", "a"); // WARN: MAYBE file is never closed + + FILE *fp2; + fp2 = fopen("test2.txt", "r"); // WARN: MAYBE file is never closed + + FILE *fp; + int b; + if(b){ + fp = fp1; + }else{ + fp = fp2; + } + + fprintf(fp, "Testing...\n"); // WARN: MAYBE writing to read-only file handle fp + + fclose(fp); +} // WARN: MAYBE unclosed files: fp1, fp2 diff --git a/tests/regression/18-file/36-fun-ptr.c b/tests/regression/18-file/36-fun-ptr.c new file mode 100644 index 00000000000..4f70bf7382d --- /dev/null +++ b/tests/regression/18-file/36-fun-ptr.c @@ -0,0 +1,14 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp; + FILE* (*f)(const char *, const char*); + f = fopen; + fp = f("test.txt", "a"); + fprintf(fp, "Testing...\n"); + fclose(fp); +} + +// All ok! diff --git a/tests/regression/18-file/37-var-switch-alias.c b/tests/regression/18-file/37-var-switch-alias.c new file mode 100644 index 00000000000..5dfde5a2d9e --- /dev/null +++ b/tests/regression/18-file/37-var-switch-alias.c @@ -0,0 +1,18 @@ +// PARAM: --set ana.activated[+] "'file'" --enable ana.file.optimistic + +#include + +int main(){ + FILE *fp1; + fp1 = fopen("test.txt", "a"); + fprintf(fp1, "Testing...\n"); + + FILE *fp2; + fp2 = fopen("test.txt", "a"); // WARN: file is never closed + fprintf(fp2, "Testing...\n"); + + fp2 = fp1; + + fclose(fp2); + fclose(fp1); // WARN: closeing already closed file handle fp1 +} // WARN: unclosed files: fp2 diff --git a/tests/regression/18-file/README.md b/tests/regression/18-file/README.md deleted file mode 100644 index 0e93e175c66..00000000000 --- a/tests/regression/18-file/README.md +++ /dev/null @@ -1,2 +0,0 @@ -The file analysis has been removed from recent Goblint versions, please use Release 2.3.0 -Folder is left in place to avoid renumbering all tests diff --git a/tests/regression/18-file/file.c b/tests/regression/18-file/file.c new file mode 100644 index 00000000000..fc2ebe16992 --- /dev/null +++ b/tests/regression/18-file/file.c @@ -0,0 +1,44 @@ +#include + +int main(){ + + // no errors + FILE *fp; + fp = fopen("test.txt", "a"); + if(fp!=0) { + fprintf(fp, "Testing...\n"); + fclose(fp); + } + + // missing fopen -> compiles, but leads to Segmentation fault + FILE *fp2; + // fp2 = fopen("test.txt", "a"); + fprintf(fp2, "Testing...\n"); // WARN + fclose(fp2); // WARN + + // writing to a read-only file -> doesn't do anything + FILE *fp3; + fp3 = fopen("test.txt", "r"); + fprintf(fp3, "Testing...\n"); // (WARN) + fclose(fp3); + + // accessing closed file -> write doesn't do anything + FILE *fp4; + fp4 = fopen("test.txt", "a"); + fclose(fp4); + fprintf(fp4, "Testing...\n"); // WARN + + // missing fclose + FILE *fp5; + fp5 = fopen("test.txt", "a"); // WARN + fprintf(fp5, "Testing...\n"); + + // missing assignment to file handle + fopen("test.txt", "a"); // WARN + + + // bad style: + // opening file but not doing anything + + return 0; // WARN about all unclosed files +} \ No newline at end of file diff --git a/tests/regression/18-file/file.optimistic.spec b/tests/regression/18-file/file.optimistic.spec new file mode 100644 index 00000000000..d42e2217b7e --- /dev/null +++ b/tests/regression/18-file/file.optimistic.spec @@ -0,0 +1,34 @@ +w1 "file handle is not saved!" +w2 "closeing unopened file handle $" +w3 "writing to unopened file handle $" +w4 "writing to read-only file handle $" +w5 "closeing already closed file handle $" +w6 "writing to closed file handle $" +w7 "overwriting still opened file handle $" +w8 "unrecognized file open mode for file handle $" + +1 -> w1 fopen(_, _) +1 -> w2 fclose($fp) +1 -> w3 fprintf($fp, _) +1 -> open_read $fp = fopen(path, "r") +1 -> open_write $fp = fopen(path, r"[wa]") // see OCaml doc for details (e.g. \\| for alternatives) +1 -> w8 $fp = fopen(path, _) + +open_read -> w4 fprintf($fp, _) + +open_read -w7>> 1 $fp = fopen(path, _) +open_write -w7>> 1 $fp = fopen(path, _) + +open_read -> closed fclose($fp) +open_write -> closed fclose($fp) + +closed -> w5 fclose($fp) +closed -> w6 fprintf($fp, _) +closed ->> 1 _ // let state 1 handle the rest + +// setup which states are end states +1 -> end _ +closed -> end _ +// warning for all entries that are not in an end state +_end "file is never closed" +_END "unclosed files: $" \ No newline at end of file diff --git a/tests/regression/18-file/file.spec b/tests/regression/18-file/file.spec new file mode 100644 index 00000000000..aeb747abfde --- /dev/null +++ b/tests/regression/18-file/file.spec @@ -0,0 +1,57 @@ +w1 "file handle is not saved!" +w2 "closeing unopened file handle $" +w3 "writing to unopened file handle $" +w4 "writing to read-only file handle $" +w5 "closeing already closed file handle $" +w6 "writing to closed file handle $" +w7 "overwriting still opened file handle $" +w8 "unrecognized file open mode for file handle $" + +// TODO later add fputs and stuff +1 -> w1 fopen(_, _) +1 -> w2 fclose($fp) +1 -> w3 fprintf($fp, _) +//1 -> open_read $fp = fopen(path, "r") +//1 -> open_write $fp = fopen(path, r"[wa]") // see OCaml doc for details (e.g. \\| for alternatives) +//1 -> w8 $fp = fopen(path, _) + +// go to unchecked states first +1 -> u_open_read $fp = fopen(path, "r") +1 -> u_open_write $fp = fopen(path, r"[wa]") +1 -> w8 $fp = fopen(path, _) +// once branch(exp, tv) is matched, return dom with 1. arg (lval = exp) and true/false +// forwarding from branch is not possible (would need an extra map for storing states) -> ignore it +// warnings are also ignored +// then in branch take out lval, check exp and do the transition to a checked state +u_open_read -> 1 branch($key==0, true) +u_open_read -> open_read branch($key==0, false) +u_open_write -> 1 branch($key==0, true) +u_open_write -> open_write branch($key==0, false) + +// alternative: forward everything. Problem: saving arguments of call (special_fn -> branch -> special_fn) +// 1 ->> open_check $fp = fopen(path, _) +// open_check ->> 1 branch($fp==0, true) +// open_check ->> open branch($fp==0, false) +// open -> open_read $fp = fopen(path, "r") +// open -> open_write $fp = fopen(path, "[wa]") +// open -> w8 $fp = fopen(path, _) + +open_read -> w4 fprintf($fp, _) +// open_write -> open_write fprintf($fp, _) // not needed, but changes loc + +open_read -w7>> 1 $fp = fopen(path, _) +open_write -w7>> 1 $fp = fopen(path, _) + +open_read -> closed fclose($fp) +open_write -> closed fclose($fp) + +closed -> w5 fclose($fp) +closed -> w6 fprintf($fp, _) +closed ->> 1 _ // let state 1 handle the rest + +// setup which states are end states +1 -> end _ +closed -> end _ +// warning for all entries that are not in an end state +_end "file is never closed" +_END "unclosed files: $" \ No newline at end of file diff --git a/tests/regression/19-spec/01-malloc-free.c b/tests/regression/19-spec/01-malloc-free.c new file mode 100644 index 00000000000..43ee527dba8 --- /dev/null +++ b/tests/regression/19-spec/01-malloc-free.c @@ -0,0 +1,19 @@ +#include +#include + +int main(){ + int *ip; + //*ip = 5; // segfault + //printf("%i", *ip); // segfault + ip = malloc(sizeof(int)); // assume malloc never fails + + // do stuff + //*ip = 5; + + free(ip); + //free(ip); // crash: double free or corruption + *ip = 5; // undefined but no crash + printf("%i", *ip); // undefined but printed 5 + ip = NULL; // make sure the pointer is not used anymore + *ip = 5; // segfault +} diff --git a/tests/regression/19-spec/02-mutex_rc.c b/tests/regression/19-spec/02-mutex_rc.c new file mode 100644 index 00000000000..82c1642a935 --- /dev/null +++ b/tests/regression/19-spec/02-mutex_rc.c @@ -0,0 +1,23 @@ +#include +#include + +int myglobal; +pthread_mutex_t mutex1 = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER; + +void *t_fun(void *arg) { + pthread_mutex_lock(&mutex1); + myglobal=myglobal+1; // RACE! + pthread_mutex_unlock(&mutex1); + return NULL; +} + +int main(void) { + pthread_t id; + pthread_create(&id, NULL, t_fun, NULL); + pthread_mutex_lock(&mutex2); + myglobal=myglobal+1; // RACE! + pthread_mutex_unlock(&mutex2); + pthread_join (id, NULL); + return 0; +} diff --git a/tests/regression/19-spec/README.md b/tests/regression/19-spec/README.md deleted file mode 100644 index d7e3ae3c8e5..00000000000 --- a/tests/regression/19-spec/README.md +++ /dev/null @@ -1,2 +0,0 @@ -The spec analysis has been removed from recent Goblint versions, please use Release 2.3.0 -Folder is left in place to avoid renumbering all tests diff --git a/tests/regression/19-spec/malloc.optimistic.spec b/tests/regression/19-spec/malloc.optimistic.spec new file mode 100644 index 00000000000..860c5738145 --- /dev/null +++ b/tests/regression/19-spec/malloc.optimistic.spec @@ -0,0 +1,23 @@ +w1 "pointer is not saved [leak]" +w2 "freeing unallocated pointer $ [segfault?]" +w3 "writing to unallocated pointer $ [segfault?]" +w4 "overwriting unfreed pointer $ [leak]" +w5 "freeing already freed pointer $ [double free!]" + +1 -w1> 1 malloc(_) +1 -w2> 1 free($p) +1 -w3> 1 *$p = _ +1 -> alloc $p = malloc(_) // TODO does compiler check size? + +alloc -w4> alloc $p = malloc(_) +alloc -> freed free($p) + +freed -w5> freed free($p) +freed ->> 1 _ // let state 1 handle the rest + +// setup which states are end states +1 -> end _ +freed -> end _ +// warning for all entries that are not in an end state +_end "pointer is never freed" +_END "unfreed pointers: $" \ No newline at end of file diff --git a/tests/regression/19-spec/malloc.spec b/tests/regression/19-spec/malloc.spec new file mode 100644 index 00000000000..9f094300510 --- /dev/null +++ b/tests/regression/19-spec/malloc.spec @@ -0,0 +1,26 @@ +w1 "pointer is not saved [leak]" +w2 "freeing unallocated pointer $ [segfault?]" +w3 "writing to unallocated pointer $ [segfault?]" +w4 "overwriting unfreed pointer $ [leak]" +w5 "freeing already freed pointer $ [double free!]" + +1 -w1> 1 malloc(_) +1 -w2> 1 free($p) +1 -w3> 1 *$p = _ +1 -> u_alloc $p = malloc(_) + +u_alloc -> 1 branch($key==0, true) +u_alloc -> alloc branch($key==0, false) + +alloc -w4> alloc $p = malloc(_) +alloc -> freed free($p) + +freed -w5> freed free($p) +freed ->> 1 _ // let state 1 handle the rest + +// setup which states are end states +1 -> end _ +freed -> end _ +// warning for all entries that are not in an end state +_end "pointer is never freed" +_END "unfreed pointers: $" \ No newline at end of file diff --git a/tests/regression/19-spec/mutex-lock.spec b/tests/regression/19-spec/mutex-lock.spec new file mode 100644 index 00000000000..1ec82640786 --- /dev/null +++ b/tests/regression/19-spec/mutex-lock.spec @@ -0,0 +1,31 @@ +w1 "unlocking not locked mutex" +w2 "locking already locked mutex" + +1 -w1> 1 pthread_mutex_unlock($p) +1 -> lock pthread_mutex_lock($p) + +lock -w2> lock pthread_mutex_lock($p) +lock -> 1 pthread_mutex_unlock($p) + +// setup which states are end states +1 -> end _ +// warning for all entries that are not in an end state +_end "mutex is never unlocked" +_END "locked mutexes: $" + + + +//w1 "joining not created thread" +//w2 "overwriting id of already created thread" +// +//1 -w1> 1 pthread_join ($p, _) +//1 -> created pthread_create($p, _, _, _) +// +//created -w2> created pthread_create($p, _, _, _) +//created -> 1 pthread_join ($p, _) +// +//// setup which states are end states +//1 -> end _ +//// warning for all entries that are not in an end state +//_end "thread is never joined" +//_END "unjoined threads: $" \ No newline at end of file diff --git a/tests/regression/29-svcomp/32-no-ov.c b/tests/regression/29-svcomp/32-no-ov.c deleted file mode 100644 index 0167098c294..00000000000 --- a/tests/regression/29-svcomp/32-no-ov.c +++ /dev/null @@ -1,7 +0,0 @@ -// PARAM: --enable ana.int.interval --enable ana.sv-comp.enabled --enable ana.sv-comp.functions --set ana.specification "CHECK( init(main()), LTL(G ! overflow) )" - -int main(){ - // This is not an overflow, just implementation defined behavior on a cast - int data = ((int)(rand() & 1 ? (((unsigned)rand()<<30) ^ ((unsigned)rand()<<15) ^ rand()) : -(((unsigned)rand()<<30) ^ ((unsigned)rand()<<15) ^ rand()) - 1)); - return 0; -} \ No newline at end of file diff --git a/tests/regression/29-svcomp/32-no-ov.t b/tests/regression/29-svcomp/32-no-ov.t deleted file mode 100644 index 1dc22ed89e0..00000000000 --- a/tests/regression/29-svcomp/32-no-ov.t +++ /dev/null @@ -1,11 +0,0 @@ - $ goblint --enable ana.int.interval --enable ana.sv-comp.enabled --enable ana.sv-comp.functions --set ana.specification "CHECK( init(main()), LTL(G ! overflow) )" 32-no-ov.c - SV-COMP specification: CHECK( init(main()), LTL(G ! overflow) ) - [Warning][Integer > Overflow][CWE-190] Unsigned integer overflow (32-no-ov.c:5:6-5:159) - [Warning][Integer > Overflow][CWE-190] Unsigned integer overflow (32-no-ov.c:5:6-5:159) - [Warning][Integer > Overflow][CWE-191] Unsigned integer underflow (32-no-ov.c:5:6-5:159) - [Warning][Integer > Overflow][CWE-190] Signed integer overflow (32-no-ov.c:5:6-5:159) - [Info][Deadcode] Logical lines of code (LLoC) summary: - live: 3 - dead: 0 - total lines: 3 - SV-COMP result: true diff --git a/tests/regression/29-svcomp/dune b/tests/regression/29-svcomp/dune deleted file mode 100644 index 23c0dd32901..00000000000 --- a/tests/regression/29-svcomp/dune +++ /dev/null @@ -1,2 +0,0 @@ -(cram - (deps (glob_files *.c))) diff --git a/tests/regression/38-int-refinements/06-narrow.c b/tests/regression/38-int-refinements/06-narrow.c deleted file mode 100644 index 513e9dde608..00000000000 --- a/tests/regression/38-int-refinements/06-narrow.c +++ /dev/null @@ -1,18 +0,0 @@ -// PARAM: --set ana.int.refinement fixpoint --enable ana.int.interval -// FIXPOINT -#include - -int g = 0; - -void main() -{ - int i = 0; - while (1) { - i++; - for (int j=0; j < 10; j++) { - if (i > 100) g = 1; - } - if (i>9) i=0; - } - return; -} diff --git a/tests/regression/39-signed-overflows/06-abs.c b/tests/regression/39-signed-overflows/06-abs.c deleted file mode 100644 index 1323434cbc4..00000000000 --- a/tests/regression/39-signed-overflows/06-abs.c +++ /dev/null @@ -1,29 +0,0 @@ -//PARAM: --enable ana.int.interval --set ana.activated[+] tmpSpecial -#include -int main() { - int data; - if (data > (-0x7fffffff - 1)) - { - if (abs(data) < 100) - { - __goblint_check(data < 100); - __goblint_check(-100 < data); - int result = data * data; //NOWARN - } - - if(abs(data) <= 100) - { - __goblint_check(data <= 100); - __goblint_check(-100 <= data); - int result = data * data; //NOWARN - } - - if(abs(data) - 1 <= 99) - { - __goblint_check(data <= 100); - __goblint_check(-100 <= data); - int result = data * data; //NOWARN - } - } - return 8; -} \ No newline at end of file diff --git a/tests/regression/39-signed-overflows/07-abs-sqrt.c b/tests/regression/39-signed-overflows/07-abs-sqrt.c deleted file mode 100644 index 13ed863e518..00000000000 --- a/tests/regression/39-signed-overflows/07-abs-sqrt.c +++ /dev/null @@ -1,10 +0,0 @@ -//PARAM: --enable ana.int.interval --enable ana.float.interval --set ana.activated[+] tmpSpecial -#include -int main() { - int data; - if (data > (-0x7fffffff - 1) && abs(data) < (long)sqrt((double)0x7fffffff)) - { - int result = data * data; //NOWARN - } - return 8; -} \ No newline at end of file diff --git a/tests/regression/39-signed-overflows/08-labs.c b/tests/regression/39-signed-overflows/08-labs.c deleted file mode 100644 index a9c6773d11d..00000000000 --- a/tests/regression/39-signed-overflows/08-labs.c +++ /dev/null @@ -1,22 +0,0 @@ -//PARAM: --enable ana.int.interval --set ana.activated[+] tmpSpecial -#include -int main() { - long data; - if (data > (-0xffffffff - 1)) - { - if (labs(data) < 100) - { - __goblint_check(data < 100); - __goblint_check(-100 < data); - int result = data * data; //NOWARN - } - - if(labs(data) <= 100) - { - __goblint_check(data <= 100); - __goblint_check(-100 <= data); - int result = data * data; //NOWARN - } - } - return 8; -} diff --git a/tests/regression/39-signed-overflows/09-labs-sqrt.c b/tests/regression/39-signed-overflows/09-labs-sqrt.c deleted file mode 100644 index 3a4b20a82b4..00000000000 --- a/tests/regression/39-signed-overflows/09-labs-sqrt.c +++ /dev/null @@ -1,10 +0,0 @@ -//PARAM: --enable ana.int.interval --enable ana.float.interval --set ana.activated[+] tmpSpecial -#include -int main() { - int data; - if (data > (-0x7fffffff - 1) && llabs(data) < (long)sqrt((double)0x7fffffff)) - { - int result = data * data; //NOWARN - } - return 8; -} diff --git a/tests/regression/39-signed-overflows/10-shiftleft.c b/tests/regression/39-signed-overflows/10-shiftleft.c deleted file mode 100644 index 7e790306ca9..00000000000 --- a/tests/regression/39-signed-overflows/10-shiftleft.c +++ /dev/null @@ -1,31 +0,0 @@ -// PARAM: --enable ana.int.interval -#include -#include -int main() -{ - int r; - int zero_or_one = 0; - int top; - char c; - r = c << 1U; //NOWARN - - r = c << 128U; //WARN - r = r << 1U; //WARN - r = 8 << -2; //WARN - - if(top) { zero_or_one = 1; } - - r = 8 << zero_or_one; - - __goblint_check(r >= 8); - __goblint_check(r <= 16); - - int regval = INT_MAX; - int shift = regval >> 6; //NOWARN - int blub = 1 << shift; //WARN - - int regval2; - unsigned long bla = (unsigned long )((1 << ((int )regval2 >> 6)) << 20); //WARN - - return 0; -} diff --git a/tests/regression/40-threadid/09-multiple.c b/tests/regression/40-threadid/09-multiple.c deleted file mode 100644 index 5510e5ae07f..00000000000 --- a/tests/regression/40-threadid/09-multiple.c +++ /dev/null @@ -1,15 +0,0 @@ -#include -#include - -int myglobal; - -void *t_fun(void *arg) { - myglobal=40; //RACE - return NULL; -} - -int main(void) { - // This should spawn a non-unique thread - unknown(t_fun); - return 0; -} diff --git a/tests/regression/40-threadid/10-multiple-thread.c b/tests/regression/40-threadid/10-multiple-thread.c deleted file mode 100644 index 0024d268ecc..00000000000 --- a/tests/regression/40-threadid/10-multiple-thread.c +++ /dev/null @@ -1,16 +0,0 @@ -// PARAM: --set ana.activated[+] thread -#include -#include - -int myglobal; - -void *t_fun(void *arg) { - myglobal=40; //RACE - return NULL; -} - -int main(void) { - // This should spawn a non-unique thread - unknown(t_fun); - return 0; -} diff --git a/tests/regression/40-threadid/11-multiple-unique-counter.c b/tests/regression/40-threadid/11-multiple-unique-counter.c deleted file mode 100644 index 37c08ae61aa..00000000000 --- a/tests/regression/40-threadid/11-multiple-unique-counter.c +++ /dev/null @@ -1,16 +0,0 @@ -// PARAM: --set ana.thread.unique_thread_id_count 4 -#include -#include - -int myglobal; - -void *t_fun(void *arg) { - myglobal=40; //RACE - return NULL; -} - -int main(void) { - // This should spawn a non-unique thread - unknown(t_fun); - return 0; -} diff --git a/tests/regression/45-escape/09-id-local-in-global.c b/tests/regression/45-escape/09-id-local-in-global.c deleted file mode 100644 index aa5a12c0128..00000000000 --- a/tests/regression/45-escape/09-id-local-in-global.c +++ /dev/null @@ -1,25 +0,0 @@ -#include -#include - -int* gptr; - -void *foo(void* p){ - *gptr = 17; - return NULL; -} - -int* id(int* x) { - return x; -} - -int main(){ - int x = 0; - gptr = id(&x); - __goblint_check(x==0); - pthread_t thread; - pthread_create(&thread, NULL, foo, NULL); - sleep(3); - __goblint_check(x == 0); // UNKNOWN! - pthread_join(thread, NULL); - return 0; -} diff --git a/tests/regression/51-threadjoins/07-trivial-unknowntid.c b/tests/regression/51-threadjoins/07-trivial-unknowntid.c deleted file mode 100644 index 2797291ee37..00000000000 --- a/tests/regression/51-threadjoins/07-trivial-unknowntid.c +++ /dev/null @@ -1,34 +0,0 @@ -//PARAM: --set ana.activated[+] threadJoins -#include - -int g = 10; -int h = 10; -pthread_mutex_t A = PTHREAD_MUTEX_INITIALIZER; - -void *t_fun(void *arg) { - g++; // RACE! - return NULL; -} - -void *t_benign(void *arg) { - h++; // NORACE - pthread_t id2; - pthread_create(&id2, NULL, t_fun, NULL); - foo(&id2); - pthread_join(id2, NULL); - return NULL; -} - -int main(void) { - int t; - - pthread_t id2; - pthread_create(&id2, NULL, t_benign, NULL); - pthread_join(id2, NULL); - // t_benign and t_fun should be in here - - g++; // RACE! - h++; // NORACE - - return 0; -} diff --git a/tests/regression/51-threadjoins/08-klever-multiple.c b/tests/regression/51-threadjoins/08-klever-multiple.c deleted file mode 100644 index 24b2c0b1ca5..00000000000 --- a/tests/regression/51-threadjoins/08-klever-multiple.c +++ /dev/null @@ -1,24 +0,0 @@ -//PARAM: --set ana.activated[+] threadJoins --set lib.activated[+] klever -#include -#include - -int g = 0; - -void *t_fun(void *arg) { - g++; // RACE! - return NULL; -} - -int main() { - pthread_t id; - pthread_create_N(&id, NULL, t_fun, NULL); // spawns multiple threads - pthread_join(id, NULL); - - g++; // RACE! - - pthread_join_N(id, NULL); // TODO: should this join one (do nothing) or all (like assume join)? - - g++; // RACE! - - return 0; -} diff --git a/tests/regression/56-witness/52-witness-lifter-ps2.c b/tests/regression/56-witness/52-witness-lifter-ps2.c deleted file mode 100644 index bcb7c1410cf..00000000000 --- a/tests/regression/56-witness/52-witness-lifter-ps2.c +++ /dev/null @@ -1,35 +0,0 @@ -// PARAM: --enable ana.sv-comp.enabled --enable ana.sv-comp.functions --enable witness.graphml.enabled --set ana.specification 'CHECK( init(main()), LTL(G valid-memtrack) )' --set ana.activated[+] memLeak --set ana.path_sens[+] memLeak --set ana.malloc.unique_address_count 1 -struct _twoIntsStruct { - int intOne ; - int intTwo ; -}; - -typedef struct _twoIntsStruct twoIntsStruct; - -void printStructLine(twoIntsStruct const *structTwoIntsStruct) -{ - return; -} - - -int main(int argc, char **argv) -{ - twoIntsStruct *data; - int tmp_1; - - - if (tmp_1 != 0) { - twoIntsStruct *dataBuffer = malloc(800UL); - data = dataBuffer; - } - else { - - twoIntsStruct *dataBuffer_0 = malloc(800UL); - data = dataBuffer_0; - } - - printStructLine((twoIntsStruct const *)data); - free((void *)data); - - return; -} diff --git a/tests/regression/56-witness/53-witness-lifter-ps3.c b/tests/regression/56-witness/53-witness-lifter-ps3.c deleted file mode 100644 index 06b73b38889..00000000000 --- a/tests/regression/56-witness/53-witness-lifter-ps3.c +++ /dev/null @@ -1,39 +0,0 @@ -// PARAM: --enable ana.sv-comp.enabled --enable ana.sv-comp.functions --enable witness.graphml.enabled --set ana.specification 'CHECK( init(main()), LTL(G valid-memtrack) )' --set ana.activated[+] memLeak --set ana.path_sens[+] memLeak --set ana.malloc.unique_address_count 1 -struct _twoIntsStruct { - int intOne ; - int intTwo ; -}; - -typedef struct _twoIntsStruct twoIntsStruct; - -void printStructLine(twoIntsStruct const *structTwoIntsStruct) -{ - return; -} - -twoIntsStruct *foo() { - twoIntsStruct *data; - int tmp_1; - - if (tmp_1 != 0) { - twoIntsStruct *dataBuffer = malloc(800UL); - data = dataBuffer; - } - else { - - twoIntsStruct *dataBuffer_0 = malloc(800UL); - data = dataBuffer_0; - } - return data; -} - -int main(int argc, char **argv) -{ - twoIntsStruct *data; - data = foo(); - - printStructLine((twoIntsStruct const *)data); - free((void *)data); - - return; -} diff --git a/tests/regression/63-affeq/19-witness.c b/tests/regression/63-affeq/19-witness.c deleted file mode 100644 index 541aceab292..00000000000 --- a/tests/regression/63-affeq/19-witness.c +++ /dev/null @@ -1,34 +0,0 @@ -//SKIP PARAM: --set ana.activated[+] affeq --set sem.int.signed_overflow assume_none --set ana.relation.privatization top --enable witness.yaml.enabled -// Identical to Example 63/01; additionally checking that writing out witnesses does not crash the analyzer -#include - -void main(void) { - int i; - int j; - int k; - i = 2; - j = k + 5; - - while (i < 100) { - __goblint_check(3 * i - j + k == 1); - i = i + 1; - j = j + 3; - } - __goblint_check(3 * i - j + k == 1); - - // Represented with fractional coefficients and thus not put into witness yet - - int a = 0; - int b = 0; - int z = 0; - - while(z < 100) { - a++; - b += 2; - z++; - - __goblint_check(2*z - b == 0); - // b == 2*z is put into the witness - } - -} diff --git a/tests/regression/73-strings/01-string_literals.c b/tests/regression/73-strings/01-string_literals.c index 4a43590bf5e..36e4ed121ca 100644 --- a/tests/regression/73-strings/01-string_literals.c +++ b/tests/regression/73-strings/01-string_literals.c @@ -1,8 +1,7 @@ -// PARAM: --set ana.base.strings.domain disjoint --enable ana.int.interval +// PARAM: --disable ana.base.limit-string-addresses --enable ana.int.interval #include #include -#include char* hello_world() { return "Hello world!"; @@ -11,49 +10,28 @@ char* hello_world() { void id(char* s) { char* ptr = NULL; // future usage of cmp should warn: workaround for macOS test #ifdef __APPLE__ - #define ID int i = *ptr + #define ID int i = strcmp(ptr, "trigger warning") #else #define ID strcpy(s, s) #endif ID; // WARN } -void example1() { - char* s1 = "bc\0test"; - char* s2 = "bc"; - char* s3; - if (rand()) - s3 = "aabbcc"; - else - s3 = "ebcdf"; - - int i = strcmp(s1, s2); - __goblint_check(i == 0); - - char* s4 = strstr(s3, s1); - __goblint_check(s4 != NULL); - - size_t len = strlen(s4); - __goblint_check(len >= 3); - __goblint_check(len <= 4); - __goblint_check(len == 3); // UNKNOWN! -} - -void example2() { +int main() { char* s1 = "abcde"; char* s2 = "abcdfg"; char* s3 = hello_world(); - size_t len = strlen(s1); - __goblint_check(len == 5); + int i = strlen(s1); + __goblint_check(i == 5); - len = strlen(s2); - __goblint_check(len == 6); + i = strlen(s2); + __goblint_check(i == 6); - len = strlen(s3); - __goblint_check(len == 12); + i = strlen(s3); + __goblint_check(i == 12); - int i = strcmp(s1, s2); + i = strcmp(s1, s2); __goblint_check(i < 0); i = strcmp(s2, "abcdfg"); @@ -92,49 +70,44 @@ void example2() { cmp = NULL; // future usage of cmp should warn: workaround for macOS test #ifdef __APPLE__ - #define STRCPY i = *cmp + #define STRCPY i = strcmp(cmp, "trigger warning") #else #define STRCPY strcpy(s1, "hi"); #endif STRCPY; // WARN #ifdef __APPLE__ - #define STRNCPY i = *cmp + #define STRNCPY i = strcmp(cmp, "trigger warning") #else # define STRNCPY strncpy(s1, "hi", 1) #endif STRNCPY; // WARN #ifdef __APPLE__ - #define STRCAT i = *cmp + #define STRCAT i = strcmp(cmp, "trigger warning") #else #define STRCAT strcat(s1, "hi") #endif STRCAT; // WARN #ifdef __APPLE__ - #define STRNCAT i = *cmp + #define STRNCAT i = strcmp(cmp, "trigger warning") #else #define STRNCAT strncat(s1, "hi", 1) #endif STRNCAT; // WARN - + #ifdef __APPLE__ // do nothing => no warning - #else + #else char s4[] = "hello"; - strcpy(s4, s2); // NOWARN -> null byte array domain not enabled + strcpy(s4, s2); // NOWARN strncpy(s4, s3, 2); // NOWARN char s5[13] = "hello"; strcat(s5, " world"); // NOWARN strncat(s5, "! some further text", 1); // NOWARN #endif -} - -int main() { - example1(); - example2(); return 0; } diff --git a/tests/regression/73-strings/02-string_literals_with_null.c b/tests/regression/73-strings/02-string_literals_with_null.c index 610390701ab..75d000bbb8b 100644 --- a/tests/regression/73-strings/02-string_literals_with_null.c +++ b/tests/regression/73-strings/02-string_literals_with_null.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.base.strings.domain disjoint --enable ana.int.interval +// PARAM: --disable ana.base.limit-string-addresses --enable ana.int.interval #include #include @@ -9,10 +9,10 @@ int main() { char* s3 = "hello world!"; char* s4 = "\0 i am the empty string"; - size_t len = strlen(s1); - __goblint_check(len == 5); + int i = strlen(s1); + __goblint_check(i == 5); - int i = strcmp(s1, s2); + i = strcmp(s1, s2); __goblint_check(i == 0); i = strcmp(s3, s1); diff --git a/tests/regression/73-strings/03-string_basics.c b/tests/regression/73-strings/03-string_basics.c index e4d6c5c5e47..db196c64b4e 100644 --- a/tests/regression/73-strings/03-string_basics.c +++ b/tests/regression/73-strings/03-string_basics.c @@ -1,4 +1,4 @@ -// PARAM: --set ana.base.strings.domain disjoint --enable ana.int.interval --enable ana.base.arrays.nullbytes +// PARAM: --disable ana.base.limit-string-addresses --enable ana.int.interval #include #include @@ -13,49 +13,35 @@ void concat_1(char* s, int i) { } int main() { - char s1[40] = "hello "; + char* s1 = malloc(40); + strcpy(s1, "hello "); char s2[] = "world!"; char s3[10] = "abcd"; char s4[20] = "abcdf"; - char* s5 = malloc(40); - strcpy(s5, "hello"); - size_t len = strlen(s1); - __goblint_check(len == 6); + int i = strlen(s1); + __goblint_check(i == 6); // UNKNOWN - len = strlen(s2); - __goblint_check(len == 6); + i = strlen(s2); + __goblint_check(i == 6); // UNKNOWN - len = strlen(s3); - __goblint_check(len == 4); - - len = strlen(s5); - __goblint_check(len == 5); + i = strlen(s3); + __goblint_check(i == 4); // UNKNOWN strcat(s1, s2); - len = strlen(s1); - int i = strcmp(s1, "hello world!"); - __goblint_check(len == 12); + i = strcmp(s1, "hello world!"); __goblint_check(i == 0); // UNKNOWN strcpy(s1, "hi "); - strncpy(s1, s3, 3); // WARN - len = strlen(s1); - __goblint_check(len == 3); - - char tmp[] = "hi "; - len = strlen(tmp); - __goblint_check(len == 3); - strcpy(s1, tmp); strncpy(s1, s3, 3); - len = strlen(s1); - __goblint_check(len == 3); + i = strlen(s1); + __goblint_check(i == 3); // UNKNOWN strcat(s1, "ababcd"); char* cmp = strstr(s1, "bab"); __goblint_check(cmp != NULL); // UNKNOWN - i = strcmp(cmp, "babcd"); // NOWARN: cmp != NULL + i = strcmp(cmp, "babcd"); // WARN: no check if cmp != NULL (even if it obviously is != NULL) __goblint_check(i == 0); // UNKNOWN i = strncmp(s4, s3, 4); @@ -64,27 +50,15 @@ int main() { i = strncmp(s4, s3, 5); __goblint_check(i > 0); // UNKNOWN - strncpy(s1, "", 20); // WARN - strcpy(tmp, "\0hi"); - i = strcmp(s1, tmp); - __goblint_check(i == 0); - - char tmp2[] = ""; - strcpy(s1, tmp2); - i = strcmp(s1, tmp2); - __goblint_check(i == 0); - - i = strcmp(s1, tmp); - __goblint_check(i == 0); - + strncpy(s1, "", 20); concat_1(s1, 30); - len = strlen(s1); - __goblint_check(len == 30); + i = strlen(s1); + __goblint_check(i == 30); // UNKNOWN cmp = strstr(s1, "0"); __goblint_check(cmp == NULL); // UNKNOWN - free(s5); + free(s1); return 0; -} +} \ No newline at end of file diff --git a/tests/regression/73-strings/05-string-unit-domain.c b/tests/regression/73-strings/05-string-unit-domain.c deleted file mode 100644 index 70e6bed5bf4..00000000000 --- a/tests/regression/73-strings/05-string-unit-domain.c +++ /dev/null @@ -1,15 +0,0 @@ -// PARAM: --set ana.base.strings.domain unit -#include -#include - -void foo(char *s) { - int l = strlen(s); - __goblint_check(l == 3 || l == 6); // UNKNOWN -} - -int main() { - foo("foo"); - foo("bar"); - foo("foobar"); - return 0; -} diff --git a/tests/regression/73-strings/06-juliet.c b/tests/regression/73-strings/06-juliet.c deleted file mode 100644 index a198c62948e..00000000000 --- a/tests/regression/73-strings/06-juliet.c +++ /dev/null @@ -1,166 +0,0 @@ -// PARAM: --set ana.base.strings.domain disjoint --enable ana.int.interval --set ana.base.arrays.domain partitioned --enable ana.base.arrays.nullbytes - -#include -#include -#include - -// TODO: tackle memset -> map it to for loop with set for each cell - -int main() { - CWE121_Stack_Based_Buffer_Overflow__src_char_declare_cpy_01_bad(); - CWE126_Buffer_Overread__CWE170_char_loop_01_bad(); - CWE126_Buffer_Overread__CWE170_char_strncpy_01_bad(); - CWE126_Buffer_Overread__char_declare_loop_01_bad(); - CWE571_Expression_Always_True__string_equals_01_bad(); - CWE665_Improper_Initialization__char_cat_01_bad(); - CWE665_Improper_Initialization__char_ncat_11_bad(); - - return 0; -} - -void CWE121_Stack_Based_Buffer_Overflow__src_char_declare_cpy_01_bad() -{ - char * data; - char dataBuffer[100]; - data = dataBuffer; - /* FLAW: Initialize data as a large buffer that is larger than the small buffer used in the sink */ - /* memset(data, 'A', 100-1); // fill with 'A's -- memset not supported currently, replaced with for-loop */ - for (size_t i = 0; i < 100-1; i++) - data[i] = 'A'; - data[100-1] = '\0'; /* null terminate */ - __goblint_check(data[42] == 'A'); - { - char dest[50] = ""; - /* POTENTIAL FLAW: Possible buffer overflow if data is larger than dest */ - strcpy(dest, data); // WARN - } -} - -void CWE126_Buffer_Overread__CWE170_char_loop_01_bad() -{ - { - char src[150], dest[100]; - int i; - /* Initialize src */ - /* memset(src, 'A', 149); */ - for (i = 0; i < 149; i++) - src[i] = 'A'; - src[149] = '\0'; - for(i=0; i < 99; i++) - { - dest[i] = src[i]; - } - /* FLAW: do not explicitly null terminate dest after the loop */ - __goblint_check(dest[42] != '\0'); // UNKNOWN - __goblint_check(dest[99] != '\0'); // UNKNOWN - } -} - -void CWE126_Buffer_Overread__CWE170_char_strncpy_01_bad() -{ - { - char data[150], dest[100]; - /* Initialize data */ - /* memset(data, 'A', 149); */ - for (size_t i = 0; i < 149; i++) - data[i] = 'A'; - data[149] = '\0'; - /* strncpy() does not null terminate if the string in the src buffer is larger than - * the number of characters being copied to the dest buffer */ - strncpy(dest, data, 99); // WARN - /* FLAW: do not explicitly null terminate dest after the use of strncpy() */ - } -} - -void CWE126_Buffer_Overread__char_declare_loop_01_bad() -{ - char * data; - char dataBadBuffer[50]; - char dataGoodBuffer[100]; - /* memset(dataBadBuffer, 'A', 50-1); // fill with 'A's */ - for (size_t i = 0; i < 50-1; i++) - dataBadBuffer[i] = 'A'; - dataBadBuffer[50-1] = '\0'; /* null terminate */ - /* memset(dataGoodBuffer, 'A', 100-1); // fill with 'A's */ - for (size_t i = 0; i < 100-1; i++) - dataGoodBuffer[i] = 'A'; - dataGoodBuffer[100-1] = '\0'; /* null terminate */ - /* FLAW: Set data pointer to a small buffer */ - data = dataBadBuffer; - { - size_t i, destLen; - char dest[100]; - /* memset(dest, 'C', 100-1); */ - for (i = 0; i < 100-1; i++) - dest[i] = 'C'; - dest[100-1] = '\0'; /* null terminate */ - destLen = strlen(dest); - __goblint_check(destLen <= 99); - /* POTENTIAL FLAW: using length of the dest where data - * could be smaller than dest causing buffer overread */ - for (i = 0; i < destLen; i++) - { - dest[i] = data[i]; - } - dest[100-1] = '\0'; - } -} - -void CWE665_Improper_Initialization__char_cat_01_bad() -{ - char * data; - char dataBuffer[100]; - data = dataBuffer; - /* FLAW: Do not initialize data */ - ; /* empty statement needed for some flow variants */ - { - char source[100]; - /* memset(source, 'C', 100-1); // fill with 'C's */ - for (size_t i = 0; i < 100-1; i++) - source[i] = 'C'; - source[100-1] = '\0'; /* null terminate */ - /* POTENTIAL FLAW: If data is not initialized properly, strcat() may not function correctly */ - strcat(data, source); // WARN - } -} - -void CWE571_Expression_Always_True__string_equals_01_bad() -{ - char charString[10] = "true"; - int cmp = strcmp(charString, "true"); - __goblint_check(cmp == 0); // UNKNOWN - - /* FLAW: This expression is always true */ - if (cmp == 0) - { - printf("always prints"); - } -} - -void CWE665_Improper_Initialization__char_ncat_11_bad() -{ - char * data; - char dataBuffer[100]; - data = dataBuffer; - if(rand()) - { - /* FLAW: Do not initialize data */ - ; /* empty statement needed for some flow variants */ - } - { - size_t sourceLen; - char source[100]; - /* memset(source, 'C', 100-1); // fill with 'C's */ - for (size_t i = 0; i < 100-1; i++) - source[i] = 'C'; - source[100-1] = '\0'; /* null terminate */ - sourceLen = strlen(source); - __goblint_check(sourceLen <= 99); - /* POTENTIAL FLAW: If data is not initialized properly, strncat() may not function correctly */ - #ifdef __APPLE__ - ; - #else - strncat(data, source, sourceLen); // NOWARN because sourceLen is not exactly known => array domain not consulted - #endif - } -} diff --git a/tests/regression/73-strings/07-larger_example.c b/tests/regression/73-strings/07-larger_example.c deleted file mode 100644 index 9e9c2985ce7..00000000000 --- a/tests/regression/73-strings/07-larger_example.c +++ /dev/null @@ -1,41 +0,0 @@ -// PARAM: --set ana.base.strings.domain disjoint --enable ana.int.interval --enable ana.base.arrays.nullbytes - -#include -#include -#include - -int main() { - char* user; - if (rand()) - user = "Alice"; - else - user = "Bob"; - - if (strcmp(user, "Alice") == 0) - strcpy(user, "++++++++"); // WARN - - __goblint_check(strcmp(user, "Alice") == 0); // UNKNOWN - __goblint_check(strcmp(user, "Bob") == 0); // UNKNOWN - __goblint_check(strcmp(user, "Eve") != 0); - - char pwd_gen[20]; - for (size_t i = 12; i < 20; i++) - pwd_gen[i] = (char) (rand() % 123); - - char* p1 = "hello"; - char* p2 = "12345"; - strcat(pwd_gen, p1); // WARN - strncpy(pwd_gen, p2, 6); - __goblint_check(pwd_gen[5] == '\0'); - strncat(pwd_gen, p1, 4); - __goblint_check(pwd_gen[5] != '\0'); - - int cmp = strcmp(pwd_gen, "12345hello"); - __goblint_check(cmp != 0); - - char* pwd = strstr(pwd_gen, p2); - size_t pwd_len = strlen(pwd_gen); - __goblint_check(pwd_len == 9); - - return 0; -} diff --git a/tests/regression/73-strings/08-cursed.c b/tests/regression/73-strings/08-cursed.c deleted file mode 100644 index 836b744da58..00000000000 --- a/tests/regression/73-strings/08-cursed.c +++ /dev/null @@ -1,31 +0,0 @@ -// PARAM: --set ana.base.strings.domain disjoint --enable ana.int.interval --enable ana.base.arrays.nullbytes --set ana.malloc.unique_address_count 1 - -#include -#include -#include - -int main() { - // These should behave identically - char s1[40]; - char* s5 = malloc(40); - char* s6 = malloc(40); - - strcpy(s1, "hello"); - strcpy(s5, "hello"); - - int len = strlen(s5); - __goblint_check(len == 5); - - int len2 = strlen(s1); - __goblint_check(len2 == 5); - - strcpy(s6,s5); - int len3 = strlen(s6); - __goblint_check(len3 == 5); - - strcpy(s5, "badabingbadaboom"); - int len2 = strlen(s5); - __goblint_check(len2 == 16); - - return 0; -} diff --git a/tests/regression/73-strings/09-malloc.c b/tests/regression/73-strings/09-malloc.c deleted file mode 100644 index 126872c6824..00000000000 --- a/tests/regression/73-strings/09-malloc.c +++ /dev/null @@ -1,16 +0,0 @@ -// PARAM: --set ana.base.strings.domain disjoint --enable ana.int.interval --enable ana.base.arrays.nullbytes -#include -#include -#include - -int main () { - char* s1 = malloc(50); - s1[0] = 'a'; - - char s2[50]; - s2[0] = 'a'; - - // Use size_t to avoid integer warnings hiding the lack of string warnings - size_t len1 = strlen(s1); //TODO - size_t len2 = strlen(s2); //WARN -} diff --git a/tests/regression/73-strings/10-char_arrays.c b/tests/regression/73-strings/10-char_arrays.c deleted file mode 100644 index 2454f2811b4..00000000000 --- a/tests/regression/73-strings/10-char_arrays.c +++ /dev/null @@ -1,383 +0,0 @@ -// PARAM: --set ana.base.strings.domain disjoint --enable ana.int.interval --enable ana.base.arrays.nullbytes - -#include -#include -#include - -int main() { - example1(); - example2(); - example3(); - example4(); - example5(); - example6(); - example7(); - example8(); - example9(); - example10(); - example11(); - example12(); - example13(); - example14(); - example15(); - example16(); - example17(); - example18(); - - return 0; -} - -void example1() { - char s1[] = "user1_"; // must and may null at 6 and 7 - char s2[] = "pwd:\0abc"; // must and may null at 4 and 8 - char s3[20]; // no must nulls, all may nulls - - strcpy(s3, s1); // must null at 6, may nulls starting from 6 - - if (rand()) { - s2[4] = ' '; - strncat(s3, s2, 10); // must null at 14, may nulls starting from 14 - } else - strcat(s3, s2); // must null at 10, may nulls starting from 10 - - // s3: no must nulls, may nulls starting from 10 - - s3[14] = '\0'; // must null at 14, may nulls starting from 10 - - size_t len = strlen(s3); - __goblint_check(len >= 10); - __goblint_check(len <= 14); - __goblint_check(len == 10); // UNKNOWN! - - strcpy(s1, s3); // WARN -} - -void example2() { - char s1[42]; - char s2[20] = "testing"; // must null at 7, may null starting from 7 - - strcpy(s1, s2); // must null and may null at 7 - - size_t len = strlen(s1); - __goblint_check(len == 7); - - strcat(s1, s2); // "testingtesting" - - len = strlen(s1); - __goblint_check(len == 14); -} - -void example3() { - char s1[42]; - char s2[20] = "testing"; // must null at 7, may null starting from 7 - - if (rand() == 42) - s2[1] = '\0'; - - strcpy(s1, s2); // may null at 1 and starting from 7 - - size_t len = strlen(s1); // WARN: no must null in s1 - __goblint_check(len >= 1); - __goblint_check(len <= 7); // UNKNOWN - - strcpy(s2, s1); // WARN: no must null in s1 -} - -void example4() { - char s1[5] = "abc\0d"; // must and may null at 3 - char s2[] = "a"; // must and may null at 1 - - strcpy(s1, s2); // "a\0c\0d" - - size_t len = strlen(s1); - __goblint_check(len == 1); - - s1[1] = 'b'; // "abc\0d" - len = strlen(s1); - __goblint_check(len == 3); -} - -void example5() { - char s1[7] = "hello!"; // must and may null at 6 - char s2[8] = "goblint"; // must and may null at 7 - - strncpy(s1, s2, 7); // WARN - - size_t len = strlen(s1); // WARN - __goblint_check(len >= 7); // no null byte in s1 -} - -void example6() { - char s1[42] = "a string, i.e. null-terminated char array"; // must and may null at 42 - for (int i = 0; i < 42; i += 3) { - if (rand() != 42) - s1[i] = '\0'; - } - s1[41] = '.'; // no must nulls, only may null a 0, 3, 6... - - char s2[42] = "actually containing some text"; // must and may null at 29 - char s3[60] = "text: "; // must and may null at 6 - - strcat(s3, s1); // WARN: no must nulls, may nulls at 6, 9, 12... - - size_t len = strlen(s3); // WARN - __goblint_check(len >= 6); - __goblint_check(len > 6); // UNKNOWN - - strncat(s2, s3, 10); // WARN: no must nulls, may nulls at 35 and 38 - - len = strlen(s2); // WARN - __goblint_check(len >= 35); - __goblint_check(len > 40); // UNKNOWN -} - -void example7() { - char s1[50] = "hello"; // must and may null at 5 - char s2[] = " world!"; // must and may null at 7 - char s3[] = " goblint."; // must and may null at 9 - - if (rand() < 42) - strcat(s1, s2); // "hello world!" -> must and may null at 12 - else - strncat(s1, s3, 8); // "hello goblint" -> must and may null at 13 - - char s4[20]; - strcpy(s4, s1); // WARN: no must nulls, may nulls at 12 and 13 - - size_t len = strlen(s4); - __goblint_check(len >= 12); - __goblint_check(len == 13); // UNKNOWN - - s4[14] = '\0'; // must null at 14, may nulls at 12, 13 and 14 - len = strlen(s4); - __goblint_check(len >= 12); - __goblint_check(len <= 14); - - char s5[20]; - strncpy(s5, s4, 16); // WARN: no must nulls, may nulls at 12, 13, 14, 15... - len = strlen(s5); // WARN - __goblint_check(len >= 12); - __goblint_check(len <= 14); // UNKNOWN - __goblint_check(len < 20); // UNKNOWN -} - -void example8() { - char s1[6] = "abc"; // must and may null at 3 - if (rand() == 42) - s1[5] = '\0'; // must null at 3, may nulls at 3 and 5 - - char s2[] = "hello world"; // must and may null at 11 - - strncpy(s2, s1, 8); // WARN: 8 > size of s1 -- must and may nulls at 3, 4, 5, 6 and 7 - - size_t len = strlen(s2); - __goblint_check(len == 3); - - s2[3] = 'a'; // must and may nulls at 4, 5, 6 and 7 - len = strlen(s2); - __goblint_check(len == 4); - - for (int i = 4; i <= 7; i++) - s2[i] = 'a'; - s2[11] = 'a'; // no must nulls, may nulls at 4, 5, 6 and 7 - - len = strlen(s2); // WARN - __goblint_check(len >= 12); // UNKNOWN: loop transformed to interval - - s2[4] = 'a'; - s2[5] = 'a'; - s2[6] = 'a'; - s2[7] = 'a'; - len = strlen(s2); // WARN: no must nulls and may nulls - __goblint_check(len >= 12); -} - -void example9() { - char empty[] = ""; - char s1[] = "hello world"; // must and may null at 11 - char s2[] = "test"; // must and may null at 4 - - char cmp[50]; - #ifdef __APPLE__ - size_t len = 11; - #else - strcpy(cmp, strstr(s1, empty)); // NOWARN: strstr(s1, empty) != NULL - size_t len = strlen(cmp); - #endif - __goblint_check(len == 11); - - char* cmp_ptr = strstr(s2, s1); - __goblint_check(cmp_ptr == NULL); -} - -void example10() { - char empty1[] = ""; - char empty2[] = "\0 also empty"; - char s1[] = "hi"; - char s2[] = "hello"; - - int i = strcmp(empty1, empty2); - __goblint_check(i == 0); - - i = strcmp(empty1, s1); - __goblint_check(i < 0); - - i = strcmp(s1, empty1); - __goblint_check(i > 0); - - i = strcmp(s1, s2); - __goblint_check(i != 0); - - i = strncmp(s1, s2, 2); - __goblint_check(i != 0); // UNKNOWN - - s1[2] = 'a'; - - i = strcmp(s1, s2); // WARN - __goblint_check(i != 0); // UNKNOWN - - i = strncmp(s1, s2, 10); // WARN - __goblint_check(i != 0); // UNKNOWN -} - -void example11() { - size_t i; - if (rand()) - i = 0; - else - i = 1; - - char s1[50] = "goblint"; // must null at 7, may nulls starting from 7 - __goblint_check(s1[i] != '\0'); - - char s2[6] = "\0\0\0\0\0"; // all must and may nulls - __goblint_check(s2[i] == '\0'); - - strcpy(s1, s2); // must null at 0 and 7, mays nulls at 0 and starting from 7 - __goblint_check(s1[i] == '\0'); // UNKNOWN - - s1[i] = 'a'; // must null at 7, mays nulls at 0 and starting from 7 - - size_t len = strlen(s1); - __goblint_check(len >= 0); - __goblint_check(len > 0); // UNKNOWN - __goblint_check(len <= 7); - - s2[0] = 'a'; // all must and may null >= 1 - __goblint_check(s2[i] == '\0'); // UNKNOWN -} - -void example12() { - char s1[50]; - for (size_t i = 0; i < 50; i++) - s1[i] = '\0'; - __goblint_check(s1[0] == '\0'); // no must null, all may nulls - __goblint_check(s1[1] == '\0'); // known by trivial array domain - - char s2[5]; - s2[0] = 'a'; s2[1] = 'a'; s2[2] = 'a'; s2[3] = 'a'; s2[4] ='a'; - __goblint_check(s2[10] != '\0'); // no must null and may nulls - - strcpy(s1, s2); // WARN: no must nulls, may nulls >= 5 - strcpy(s2, "definite buffer overflow"); // WARN - - s2[4] = '\0'; // must and may null at 4 - - strncpy(s1, s2, 4); // WARN -} - -void example13() { - char s1[10]; // no must null, all may nulls - char s2[10]; // no must null, all may nulls - strncpy(s1, s2, 4); // WARN: no must null, all may nulls - __goblint_check(s1[3] == '\0'); // UNKNOWN - - s1[0] = 'a'; - s1[1] = 'b'; // no must null, may nulls >= 2 - - strcat(s1, s2); // WARN: no must null, may nulls >= 2 - __goblint_check(s1[1] != '\0'); - __goblint_check(s1[2] == '\0'); // UNKNOWN - - int cmp = strncmp(s1, s2, 0); - __goblint_check(cmp == 0); -} - -void example14() { - size_t size; - if (rand()) - size = 15; - else - size = 20; - - char* s = malloc(size); - - strcpy(s, ""); // must null at 0, all may null - - strcat(s, "123456789012345678"); // WARN -} - -example15() { - char* s1 = malloc(8); - strcpy(s1, "goblint"); // must and may null at 7 - - char s2[42] = "static"; // must null at 6, may null >= 6 - - strcat(s2, s1); // must null at 13, may null >= 13 - __goblint_check(s2[12] != '\0'); - __goblint_check(s2[13] == '\0'); - __goblint_check(s2[14] == '\0'); // UNKNOWN - - char* s3 = strstr(s1, s2); - __goblint_check(s3 == NULL); -} - -example16() { - size_t i; - if (rand()) - i = 3; - else - i = 4; - - char s[5] = "abab"; - __goblint_check(s[i] != '\0'); // UNKNOWN - - s[4] = 'a'; - __goblint_check(s[i] != '\0'); - - s[4] = '\0'; - s[i] = '\0'; - __goblint_check(s[4] == '\0'); - __goblint_check(s[3] == '\0'); // UNKNOWN - - s[i] = 'a'; - __goblint_check(s[4] == '\0'); // UNKNOWN -} - -example17() { - char s1[20]; - char s2[10]; - strcat(s1, s2); // WARN - __goblint_check(s1[0] == '\0'); // UNKNOWN - __goblint_check(s1[5] == '\0'); // UNKNOWN - __goblint_check(s1[12] == '\0'); // UNKNOWN -} - -example18() { - char s1[20] = "hello"; - char s2[10] = "world"; - - size_t i; - if (rand()) - i = 1; - else - i = 2; - s1[i] = '\0'; - - strcat(s1, s2); - __goblint_check(s1[1] != '\0'); - __goblint_check(s1[6] == '\0'); // UNKNOWN - __goblint_check(s1[7] == '\0'); // UNKNOWN - __goblint_check(s1[8] != '\0'); // UNKNOWN because might still be uninitialized - __goblint_check(s1[10] == '\0'); // UNKNOWN -} diff --git a/tests/regression/74-invalid_deref/30-calloc.c b/tests/regression/74-invalid_deref/30-calloc.c deleted file mode 100644 index 624e9c212d8..00000000000 --- a/tests/regression/74-invalid_deref/30-calloc.c +++ /dev/null @@ -1,9 +0,0 @@ -//PARAM: --set ana.activated[+] useAfterFree --set ana.activated[+] threadJoins --set ana.activated[+] memOutOfBounds --enable ana.int.interval --set ana.base.arrays.domain partitioned -#include -#include - -int main(int argc, char **argv) -{ - int* ptrCalloc = calloc(100UL,8UL); - *ptrCalloc = 8; //NOWARN -} diff --git a/tests/regression/74-invalid_deref/32-mem-oob-struct.c b/tests/regression/74-invalid_deref/30-mem-oob-struct.c similarity index 100% rename from tests/regression/74-invalid_deref/32-mem-oob-struct.c rename to tests/regression/74-invalid_deref/30-mem-oob-struct.c diff --git a/tests/regression/74-invalid_deref/31-multithreaded.c b/tests/regression/74-invalid_deref/31-multithreaded.c deleted file mode 100644 index 8a0c12350b7..00000000000 --- a/tests/regression/74-invalid_deref/31-multithreaded.c +++ /dev/null @@ -1,21 +0,0 @@ -//PARAM: --set ana.path_sens[+] threadflag --set ana.activated[+] memOutOfBounds --set ana.base.privatization mutex-meet-tid -#include - -int data; -int *p = &data, *q; -pthread_mutex_t mutex; -void *t_fun(void *arg) { - pthread_mutex_lock(&mutex); - *p = 8; - pthread_mutex_unlock(&mutex); - return ((void *)0); -} -int main() { - pthread_t id; - pthread_create(&id, ((void *)0), t_fun, ((void *)0)); - q = p; - pthread_mutex_lock(&mutex); - *q = 8; //NOWARN - pthread_mutex_unlock(&mutex); - return 0; -} diff --git a/tests/regression/74-invalid_deref/33-negativ-.c b/tests/regression/74-invalid_deref/31-negativ-.c similarity index 100% rename from tests/regression/74-invalid_deref/33-negativ-.c rename to tests/regression/74-invalid_deref/31-negativ-.c diff --git a/tests/regression/76-memleak/08-unreachable-mem.c b/tests/regression/76-memleak/08-unreachable-mem.c deleted file mode 100644 index 08e7b4e7412..00000000000 --- a/tests/regression/76-memleak/08-unreachable-mem.c +++ /dev/null @@ -1,12 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include - -int *g; - -int main(int argc, char const *argv[]) { - g = malloc(sizeof(int)); - // Reference to g's heap contents is lost here - g = NULL; - - return 0; //WARN -} diff --git a/tests/regression/76-memleak/09-unreachable-with-local-var.c b/tests/regression/76-memleak/09-unreachable-with-local-var.c deleted file mode 100644 index bc71bb560ef..00000000000 --- a/tests/regression/76-memleak/09-unreachable-with-local-var.c +++ /dev/null @@ -1,15 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include - -int *g; - -int main(int argc, char const *argv[]) { - g = malloc(sizeof(int)); - // Reference to g's heap contents is lost here - g = NULL; - - // According to `valid-memtrack`, the memory of p is unreachable and we don't have a false positive - int *p = malloc(sizeof(int)); - - return 0; //WARN -} diff --git a/tests/regression/76-memleak/10-global-struct-no-ptr.c b/tests/regression/76-memleak/10-global-struct-no-ptr.c deleted file mode 100644 index 490b2bb4439..00000000000 --- a/tests/regression/76-memleak/10-global-struct-no-ptr.c +++ /dev/null @@ -1,16 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include - -typedef struct st { - int *a; - int b; -} st; - -st st_nonptr; - -int main(int argc, char const *argv[]) { - st_nonptr.a = malloc(sizeof(int)); - st_nonptr.a = NULL; - - return 0; //WARN -} diff --git a/tests/regression/76-memleak/11-global-struct-ptr.c b/tests/regression/76-memleak/11-global-struct-ptr.c deleted file mode 100644 index 4ebe1c16b80..00000000000 --- a/tests/regression/76-memleak/11-global-struct-ptr.c +++ /dev/null @@ -1,19 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include - -typedef struct st { - int *a; - int b; -} st; - -st *st_ptr; - -int main(int argc, char const *argv[]) { - st_ptr = malloc(sizeof(st)); - st_ptr->a = malloc(sizeof(int)); - st_ptr->a = NULL; - free(st_ptr); - - // Only st_ptr->a is causing trouble here - return 0; //WARN -} diff --git a/tests/regression/76-memleak/12-global-nested-struct-ptr.c b/tests/regression/76-memleak/12-global-nested-struct-ptr.c deleted file mode 100644 index e0f51750642..00000000000 --- a/tests/regression/76-memleak/12-global-nested-struct-ptr.c +++ /dev/null @@ -1,25 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include - -typedef struct st { - int *a; - int b; -} st; - -typedef struct st2 { - st *st_ptr; -} st2; - -st2 *st_var; - -int main(int argc, char const *argv[]) { - st_var = malloc(sizeof(st2)); - st_var->st_ptr = malloc(sizeof(st)); - st_var->st_ptr->a = malloc(sizeof(int)); - st_var->st_ptr->a = NULL; - free(st_var->st_ptr); - free(st_var); - - // Only st_var->st_ptr->a is causing trouble here - return 0; //WARN -} diff --git a/tests/regression/76-memleak/13-global-nested-struct-ptr-reachable.c b/tests/regression/76-memleak/13-global-nested-struct-ptr-reachable.c deleted file mode 100644 index 1726625a593..00000000000 --- a/tests/regression/76-memleak/13-global-nested-struct-ptr-reachable.c +++ /dev/null @@ -1,29 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include - -typedef struct st { - int *a; - int b; -} st; - -typedef struct st2 { - st *st_ptr; -} st2; - -st2 *st_var; - -int main(int argc, char const *argv[]) { - st_var = malloc(sizeof(st2)); - st_var->st_ptr = malloc(sizeof(st)); - int *local_ptr = malloc(sizeof(int)); - st_var->st_ptr->a = local_ptr; - local_ptr = NULL; - - free(st_var->st_ptr); - free(st_var); - - // local_ptr's memory is reachable through st_var->st_ptr->a - // It's leaked, because we don't call free() on it - // Hence, there should be a single warning for a memory leak, but not for unreachable memory - return 0; //WARN -} diff --git a/tests/regression/76-memleak/14-global-nested-struct-non-ptr-reachable.c b/tests/regression/76-memleak/14-global-nested-struct-non-ptr-reachable.c deleted file mode 100644 index 1153bd81e00..00000000000 --- a/tests/regression/76-memleak/14-global-nested-struct-non-ptr-reachable.c +++ /dev/null @@ -1,25 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include - -typedef struct st { - int *a; - int b; -} st; - -typedef struct st2 { - st *st_ptr; -} st2; - -st2 st_var; - -int main(int argc, char const *argv[]) { - st_var.st_ptr = malloc(sizeof(st)); - int *local_ptr = malloc(sizeof(int)); - st_var.st_ptr->a = local_ptr; - local_ptr = NULL; - free(st_var.st_ptr); - - // local_ptr's memory is reachable through st_var.st_ptr->a, but it's not freed - // Hence, there should be only a single warning for a memory leak, but not for unreachable memory - return 0; //WARN -} diff --git a/tests/regression/76-memleak/20-invalid-memcleanup-multi-threaded.c b/tests/regression/76-memleak/20-invalid-memcleanup-multi-threaded.c deleted file mode 100644 index 038801f219f..00000000000 --- a/tests/regression/76-memleak/20-invalid-memcleanup-multi-threaded.c +++ /dev/null @@ -1,36 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --set ana.activated[+] thread -#include -#include - -int *g; -int *m1; - -void *f1(void *arg) { - m1 = malloc(sizeof(int)); - // Thread t1 leaks m1 here - pthread_exit(NULL); //WARN -} - -void *f2(void *arg) { - int *m2; - m2 = malloc(sizeof(int)); - free(m2); // No leak for thread t2, since it calls free before exiting - pthread_exit(NULL); //NOWARN -} - -int main(int argc, char const *argv[]) { - g = malloc(sizeof(int)); - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - pthread_t t2; - pthread_create(&t2, NULL, f2, NULL); - - free(g); - - pthread_join(t1, NULL); - pthread_join(t2, NULL); - - // main thread is not leaking anything - return 0; //NOWARN -} diff --git a/tests/regression/76-memleak/21-invalid-memcleanup-multi-threaded-abort.c b/tests/regression/76-memleak/21-invalid-memcleanup-multi-threaded-abort.c deleted file mode 100644 index eaba1e91b5b..00000000000 --- a/tests/regression/76-memleak/21-invalid-memcleanup-multi-threaded-abort.c +++ /dev/null @@ -1,35 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --set ana.activated[+] thread -#include - -int *g; -int *m1; - -void *f1(void *arg) { - m1 = malloc(sizeof(int)); - // Thread t1 leaks m1 here - exit(2); //WARN -} - -void *f2(void *arg) { - int *m2; - m2 = malloc(sizeof(int)); - free(m2); // No leak for thread t2, since it calls free before exiting - pthread_exit(NULL); //NOWARN -} - -int main(int argc, char const *argv[]) { - g = malloc(sizeof(int)); - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - pthread_t t2; - pthread_create(&t2, NULL, f2, NULL); - - free(g); - - pthread_join(t1, NULL); - pthread_join(t2, NULL); - - // main thread is not leaking anything - return 0; //NOWARN -} diff --git a/tests/regression/76-memleak/22-leak-later.c b/tests/regression/76-memleak/22-leak-later.c deleted file mode 100644 index 6e6e51bbdce..00000000000 --- a/tests/regression/76-memleak/22-leak-later.c +++ /dev/null @@ -1,25 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include -#include - -int *g; -int *m1; -int *m2; - -void *f1(void *arg) { - int top; - - // Thread t1 leaks m0 here - exit(2); //WARN -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - int* m0 = malloc(sizeof(int)); - free(m0); - - // main thread is not leaking anything - return 0; -} diff --git a/tests/regression/76-memleak/23-leak-later-nested.c b/tests/regression/76-memleak/23-leak-later-nested.c deleted file mode 100644 index 952dc66334a..00000000000 --- a/tests/regression/76-memleak/23-leak-later-nested.c +++ /dev/null @@ -1,34 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak -#include -#include - -int *g; -int *m1; -int *m2; - -void *f2(void *arg) { - // Thread t2 leaks m0 and t1_ptr here - quick_exit(2); //WARN -} - -void *f1(void *arg) { - pthread_t t2; - pthread_create(&t2, NULL, f2, NULL); - - int *t1_ptr = malloc(sizeof(int)); - - pthread_join(t2, NULL); - // t1_ptr is leaked, since t2 calls quick_exit() potentially before this program point - free(t1_ptr); -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - int* m0 = malloc(sizeof(int)); - free(m0); - - // main thread is not leaking anything - return 0; -} diff --git a/tests/regression/76-memleak/24-multi-threaded-assert.c b/tests/regression/76-memleak/24-multi-threaded-assert.c deleted file mode 100644 index 309a5dde75c..00000000000 --- a/tests/regression/76-memleak/24-multi-threaded-assert.c +++ /dev/null @@ -1,34 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --disable warn.assert -#include -#include -#include - -int *g; -int *m1; -int *m2; - -void *f2(void *arg) { - // Thread t2 leaks m0 and t1_ptr here - assert(0); //WARN -} - -void *f1(void *arg) { - pthread_t t2; - pthread_create(&t2, NULL, f2, NULL); - - int *t1_ptr = malloc(sizeof(int)); - assert(1); //NOWARN - pthread_join(t2, NULL); - free(t1_ptr); -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - int* m0 = malloc(sizeof(int)); - free(m0); - - // main thread is not leaking anything - return 0; -} diff --git a/tests/regression/76-memleak/25-assert-unknown-multi-threaded.c b/tests/regression/76-memleak/25-assert-unknown-multi-threaded.c deleted file mode 100644 index 95eb2918871..00000000000 --- a/tests/regression/76-memleak/25-assert-unknown-multi-threaded.c +++ /dev/null @@ -1,20 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --disable warn.assert -#include -#include -#include - -void *f1(void *arg) { - int top; - assert(top); //WARN -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - int* m0 = malloc(sizeof(int)); - free(m0); - - // main thread is not leaking anything - return 0; -} diff --git a/tests/regression/76-memleak/26-invalid-memcleanup-multi-threaded-betterpiv.c b/tests/regression/76-memleak/26-invalid-memcleanup-multi-threaded-betterpiv.c deleted file mode 100644 index 9f636ab5879..00000000000 --- a/tests/regression/76-memleak/26-invalid-memcleanup-multi-threaded-betterpiv.c +++ /dev/null @@ -1,36 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --set ana.base.privatization mutex-meet-tid --set ana.path_sens[+] threadflag --set ana.activated[+] thread -#include -#include - -int *g; -int *m1; -int *m2; - -void *f1(void *arg) { - m1 = malloc(sizeof(int)); - // Thread t1 leaks m1 here - pthread_exit(NULL); //WARN -} - -void *f2(void *arg) { - m2 = malloc(sizeof(int)); - free(m2); // No leak for thread t2, since it calls free before exiting - pthread_exit(NULL); //NOWARN -} - -int main(int argc, char const *argv[]) { - g = malloc(sizeof(int)); - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - pthread_t t2; - pthread_create(&t2, NULL, f2, NULL); - - free(g); - - pthread_join(t1, NULL); - pthread_join(t2, NULL); - - // main thread is not leaking anything - return 0; //NOWARN -} diff --git a/tests/regression/76-memleak/27-mem-leak-not-joined-thread.c b/tests/regression/76-memleak/27-mem-leak-not-joined-thread.c deleted file mode 100644 index 15f249ffe10..00000000000 --- a/tests/regression/76-memleak/27-mem-leak-not-joined-thread.c +++ /dev/null @@ -1,19 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --set ana.activated[+] thread -#include -#include - -int *m1; - -void *f1(void *arg) { - m1 = malloc(sizeof(int)); - while (1); - return NULL; -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - // memory from thread f1 which was not joined into main, is not freed - return 0; //WARN -} \ No newline at end of file diff --git a/tests/regression/76-memleak/28-no-mem-leak-thread-exit-main.c b/tests/regression/76-memleak/28-no-mem-leak-thread-exit-main.c deleted file mode 100644 index f7340d1d4f6..00000000000 --- a/tests/regression/76-memleak/28-no-mem-leak-thread-exit-main.c +++ /dev/null @@ -1,22 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --set ana.activated[+] thread -#include -#include - -int *m1; - -void *f1(void *arg) { - m1 = malloc(sizeof(int)); - while (1); - return NULL; -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - - // A pthread_exit called in main will wait for other threads to finish - // Therefore, no memory leak here - pthread_exit(NULL); // NOWARN - - return 0; // NOWARN (unreachable) -} \ No newline at end of file diff --git a/tests/regression/76-memleak/29-mem-leak-thread-return.c b/tests/regression/76-memleak/29-mem-leak-thread-return.c deleted file mode 100644 index bec64ca22ff..00000000000 --- a/tests/regression/76-memleak/29-mem-leak-thread-return.c +++ /dev/null @@ -1,26 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --set ana.activated[+] thread -#include -#include - -int *m1; - -void *f2(void *arg) { - m1 = malloc(sizeof(int)); - while (1); - return NULL; -} - -void *f1(void *arg) { - pthread_t t2; - pthread_create(&t2, NULL, f2, NULL); - - return NULL; -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - pthread_join(t1, NULL); - - return 0; // WARN -} \ No newline at end of file diff --git a/tests/regression/76-memleak/30-mem-leak-thread-exit.c b/tests/regression/76-memleak/30-mem-leak-thread-exit.c deleted file mode 100644 index e98ae3f346f..00000000000 --- a/tests/regression/76-memleak/30-mem-leak-thread-exit.c +++ /dev/null @@ -1,27 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --set ana.activated[+] thread -#include -#include - -int *m1; - -void *f2(void *arg) { - m1 = malloc(sizeof(int)); - while (1); - return NULL; -} - -void *f1(void *arg) { - pthread_t t2; - pthread_create(&t2, NULL, f2, NULL); - - pthread_exit(NULL); - return NULL; -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - pthread_join(t1, NULL); - - return 0; // WARN -} \ No newline at end of file diff --git a/tests/regression/76-memleak/31-no-mem-leak-return.c b/tests/regression/76-memleak/31-no-mem-leak-return.c deleted file mode 100644 index 70e0c66216d..00000000000 --- a/tests/regression/76-memleak/31-no-mem-leak-return.c +++ /dev/null @@ -1,32 +0,0 @@ -//PARAM: --set ana.malloc.unique_address_count 1 --set ana.activated[+] memLeak --set ana.activated[+] thread -#include -#include - - -void *f2(void *arg) { - int* m1 = malloc(sizeof(int)); - free(m1); - return NULL; -} - -// We check here that the analysis can distinguish between thread returns and normal returns - -void startf2(pthread_t* t){ - pthread_create(t, NULL, f2, NULL); - return; //NOWARN -} - -void *f1(void *arg) { - pthread_t t2; - startf2(&t2); - pthread_join(t2, NULL); - return NULL; // NOWARN -} - -int main(int argc, char const *argv[]) { - pthread_t t1; - pthread_create(&t1, NULL, f1, NULL); - pthread_join(t1, NULL); - - return 0; // NOWARN -} \ No newline at end of file diff --git a/tests/regression/78-termination/01-simple-loop-terminating.c b/tests/regression/78-termination/01-simple-loop-terminating.c deleted file mode 100644 index 8ca46100571..00000000000 --- a/tests/regression/78-termination/01-simple-loop-terminating.c +++ /dev/null @@ -1,15 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int i = 1; - - while (i <= 10) - { - printf("%d\n", i); - i++; - } - - return 0; -} diff --git a/tests/regression/78-termination/02-simple-loop-nonterminating.c b/tests/regression/78-termination/02-simple-loop-nonterminating.c deleted file mode 100644 index d8847e2b747..00000000000 --- a/tests/regression/78-termination/02-simple-loop-nonterminating.c +++ /dev/null @@ -1,12 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - while (1) // NONTERMLOOP termination analysis shall mark beginning of while as non-terminating loop - { - continue; - } - - return 0; -} diff --git a/tests/regression/78-termination/03-nested-loop-terminating.c b/tests/regression/78-termination/03-nested-loop-terminating.c deleted file mode 100644 index 6b31204567d..00000000000 --- a/tests/regression/78-termination/03-nested-loop-terminating.c +++ /dev/null @@ -1,27 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int rows = 3; - int columns = 4; - int i = 1; - - // Outer while loop for rows - while (i <= rows) - { - int j = 1; - - // Inner while loop for columns - while (j <= columns) - { - printf("(%d, %d) ", i, j); - j++; - } - - printf("\n"); - i++; - } - - return 0; -} diff --git a/tests/regression/78-termination/04-nested-loop-nonterminating.c b/tests/regression/78-termination/04-nested-loop-nonterminating.c deleted file mode 100644 index 21b6014509a..00000000000 --- a/tests/regression/78-termination/04-nested-loop-nonterminating.c +++ /dev/null @@ -1,23 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int outerCount = 1; - - while (outerCount <= 3) - { - int innerCount = 1; - - while (1) // NONTERMLOOP termination analysis shall mark beginning of while as non-terminating loop - { - printf("(%d, %d) ", outerCount, innerCount); - innerCount++; - } - - printf("\n"); - outerCount++; - } - - return 0; -} diff --git a/tests/regression/78-termination/05-for-loop-terminating.c b/tests/regression/78-termination/05-for-loop-terminating.c deleted file mode 100644 index 7a2b7894965..00000000000 --- a/tests/regression/78-termination/05-for-loop-terminating.c +++ /dev/null @@ -1,14 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int i; - - for (i = 1; i <= 10; i++) - { - printf("%d\n", i); - } - - return 0; -} diff --git a/tests/regression/78-termination/06-for-loop-nonterminating.c b/tests/regression/78-termination/06-for-loop-nonterminating.c deleted file mode 100644 index 6c6123251cb..00000000000 --- a/tests/regression/78-termination/06-for-loop-nonterminating.c +++ /dev/null @@ -1,12 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - for (;;) // NONTERMLOOP termination analysis shall mark beginning of for as non-terminating loop - { - printf("This loop does not terminate.\n"); - } - - return 0; -} diff --git a/tests/regression/78-termination/07-nested-for-loop-terminating.c b/tests/regression/78-termination/07-nested-for-loop-terminating.c deleted file mode 100644 index 3293a1fa2cc..00000000000 --- a/tests/regression/78-termination/07-nested-for-loop-terminating.c +++ /dev/null @@ -1,20 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int rows = 3; - int columns = 4; - - // Nested loop to iterate over rows and columns - for (int i = 1; i <= rows; i++) - { - for (int j = 1; j <= columns; j++) - { - printf("(%d, %d) ", i, j); - } - printf("\n"); - } - - return 0; -} diff --git a/tests/regression/78-termination/08-nested-for-loop-nonterminating.c b/tests/regression/78-termination/08-nested-for-loop-nonterminating.c deleted file mode 100644 index cb65a0d267b..00000000000 --- a/tests/regression/78-termination/08-nested-for-loop-nonterminating.c +++ /dev/null @@ -1,19 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int outerCount, innerCount; - - for (outerCount = 1; outerCount <= 3; outerCount++) - { - for (innerCount = 1;; innerCount++) // NONTERMLOOP termination analysis shall mark beginning of for as non-terminating loop - { - printf("(%d, %d) ", outerCount, innerCount); - } - - printf("\n"); - } - - return 0; -} diff --git a/tests/regression/78-termination/09-complex-for-loop-terminating.c b/tests/regression/78-termination/09-complex-for-loop-terminating.c deleted file mode 100644 index 74ee41eae82..00000000000 --- a/tests/regression/78-termination/09-complex-for-loop-terminating.c +++ /dev/null @@ -1,98 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra --set sem.int.signed_overflow assume_none -// Apron is not precise enough for some nested loops -#include - -int loops0(){ - int i, j, k; - - // Outer loop - for (i = 1; i <= 5; i++) - { - // Inner loop 1 - for (j = 1; j <= i; j++) - { - printf("%d ", j); - } - printf("\n"); - - // Inner loop 2 - for (k = i; k >= 1; k--) - { - printf("%d ", k); - } - printf("\n"); - } - - // Additional loop - for (i = 5; i >= 1; i--) - { - for (j = i; j >= 1; j--) - { - printf("%d ", j); - } - printf("\n"); - } - return 0; -} - -int loops1(){ - int i, j, k; - - // Loop with conditions - for (i = 1; i <= 10; i++) - { - if (i % 2 == 0) - { - printf("%d is even\n", i); - } - else - { - printf("%d is odd\n", i); - } - } - - // Loop with nested conditions - for (i = 1; i <= 10; i++) - { - printf("Number: %d - ", i); - if (i < 5) - { - printf("Less than 5\n"); - } - else if (i > 5) - { - printf("Greater than 5\n"); - } - else - { - printf("Equal to 5\n"); - } - } - - // Loop with a break statement - for (i = 1; i <= 10; i++) - { - printf("%d ", i); - if (i == 5) - { - break; - } - } - printf("\n"); - - // Loop with multiple variables - int a, b, c; - for (a = 1, b = 2, c = 3; a <= 10; a++, b += 2, c += 3) - { - printf("%d %d %d\n", a, b, c); - } - return 0; -} - -int main() -{ - loops0(); - loops1(); - - return 0; -} diff --git a/tests/regression/78-termination/10-complex-loop-terminating.c b/tests/regression/78-termination/10-complex-loop-terminating.c deleted file mode 100644 index 96253c445fc..00000000000 --- a/tests/regression/78-termination/10-complex-loop-terminating.c +++ /dev/null @@ -1,218 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra --set sem.int.signed_overflow assume_none -// Apron is not precise enough for some nested loops -#include - -int loops0(){ - int i = 1; - int j = 1; - int k = 5; - - // Outer while loop - while (i <= 5) - { - // Inner while loop 1 - while (j <= i) - { - printf("%d ", j); - j++; - } - printf("\n"); - j = 1; - - // Inner while loop 2 - while (k >= 1) - { - printf("%d ", k); - k--; - } - printf("\n"); - k = 5; - - i++; - } - - // Additional while loop - i = 5; - while (i >= 1) - { - j = i; - while (j >= 1) - { - printf("%d ", j); - j--; - } - printf("\n"); - i--; - } - - // Loop with conditions - i = 1; - while (i <= 10) - { - if (i % 2 == 0) - { - printf("%d is even\n", i); - } - else - { - printf("%d is odd\n", i); - } - i++; - } - - // Loop with nested conditions - i = 1; - while (i <= 10) - { - printf("Number: %d - ", i); - if (i < 5) - { - printf("Less than 5\n"); - } - else if (i > 5) - { - printf("Greater than 5\n"); - } - else - { - printf("Equal to 5\n"); - } - i++; - } - return 0; -} - -int loops1() -{ - int i = 1; - int j = 1; - int k = 5; - - // Outer while loop - while (i <= 5) - { - // Inner while loop 1 - while (j <= i) - { - printf("%d ", j); - j++; - } - printf("\n"); - j = 1; - - // Inner while loop 2 - while (k >= 1) - { - printf("%d ", k); - k--; - } - printf("\n"); - k = 5; - - i++; - } - - // Additional while loop - i = 5; - while (i >= 1) - { - j = i; - while (j >= 1) - { - printf("%d ", j); - j--; - } - printf("\n"); - i--; - } - - // Loop with conditions - i = 1; - while (i <= 10) - { - if (i % 2 == 0) - { - printf("%d is even\n", i); - } - else - { - printf("%d is odd\n", i); - } - i++; - } - - return 0; -} - -int loops2(){ - int i = 1; - int j = 1; - int k = 5; - - // Loop with nested conditions - i = 1; - while (i <= 10) - { - printf("Number: %d - ", i); - if (i < 5) - { - printf("Less than 5\n"); - } - else if (i > 5) - { - printf("Greater than 5\n"); - } - else - { - printf("Equal to 5\n"); - } - i++; - } - - // Loop with a break statement - i = 1; - while (i <= 10) - { - printf("%d ", i); - if (i == 5) - { - break; - } - i++; - } - printf("\n"); - - // Loop with a continue statement - i = 1; - while (i <= 10) - { - if (i % 2 == 0) - { - i++; - continue; - } - printf("%d ", i); - i++; - } - printf("\n"); - - // Loop with multiple variables - int a = 1; - int b = 2; - int c = 3; - while (a <= 10) - { - printf("%d %d %d\n", a, b, c); - a++; - b += 2; - c += 3; - } - return 0; -} - -int main(){ - loops0(); - loops1(); - loops2(); - return 0; -} \ No newline at end of file diff --git a/tests/regression/78-termination/11-loopless-termination.c b/tests/regression/78-termination/11-loopless-termination.c deleted file mode 100644 index 9f1a7e0f133..00000000000 --- a/tests/regression/78-termination/11-loopless-termination.c +++ /dev/null @@ -1,8 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - printf("Terminating code without a loop\n"); - return 0; -} diff --git a/tests/regression/78-termination/12-do-while-instant-terminating.c b/tests/regression/78-termination/12-do-while-instant-terminating.c deleted file mode 100644 index 5bc18902b3c..00000000000 --- a/tests/regression/78-termination/12-do-while-instant-terminating.c +++ /dev/null @@ -1,15 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int i = 0; - - do - { - printf("Inside the do-while loop\n"); - } while (i > 0); - - printf("Exited the loop\n"); - return 0; -} diff --git a/tests/regression/78-termination/13-do-while-terminating.c b/tests/regression/78-termination/13-do-while-terminating.c deleted file mode 100644 index 6ac69464958..00000000000 --- a/tests/regression/78-termination/13-do-while-terminating.c +++ /dev/null @@ -1,16 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int i = 1; - - do - { - printf("Inside the do-while loop\n"); - i++; - } while (i <= 5); - - printf("Exited the loop\n"); - return 0; -} diff --git a/tests/regression/78-termination/14-do-while-nonterminating.c b/tests/regression/78-termination/14-do-while-nonterminating.c deleted file mode 100644 index 0a9df3421f1..00000000000 --- a/tests/regression/78-termination/14-do-while-nonterminating.c +++ /dev/null @@ -1,16 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int i = 1; - - do - { - printf("Inside the do-while loop\n"); - i++; - } while (i >= 2); // NONTERMLOOP termination analysis shall mark while as non-terminating loop - - printf("Exited the loop\n"); - return 0; -} diff --git a/tests/regression/78-termination/15-complex-loop-combination-terminating.c b/tests/regression/78-termination/15-complex-loop-combination-terminating.c deleted file mode 100644 index 4912bbb1f21..00000000000 --- a/tests/regression/78-termination/15-complex-loop-combination-terminating.c +++ /dev/null @@ -1,126 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra --set sem.int.signed_overflow assume_none -// Apron is not precise enough for some nested loops -#include - -int non_nested_loops(){ - // Non-nested loops - int i; - - // for loop - for (i = 1; i <= 10; i++) - { - printf("For loop iteration: %d\n", i); - } - - // while loop - int j = 1; - while (j <= 10) - { - printf("While loop iteration: %d\n", j); - j++; - } - - // do-while loop - int k = 1; - do - { - printf("Do-While loop iteration: %d\n", k); - k++; - } while (k <= 10); - return 0; -} - -int nested_loops(){ - // Nested loops - int a, b; - - // Nested for and while loop - for (a = 1; a <= 5; a++) - { - int c = 1; - while (c <= a) - { - printf("Nested For-While loop: %d\n", c); - c++; - } - } - - // Nested while and do-while loop - int x = 1; - while (x <= 5) - { - int y = 1; - do - { - printf("Nested While-Do-While loop: %d\n", y); - y++; - } while (y <= x); - x++; - } - - // Nested do-while and for loop - int p = 1; - do - { - for (int q = 1; q <= p; q++) - { - printf("Nested Do-While-For loop: %d\n", q); - } - p++; - } while (p <= 5); - return 0; -} - -int nested_while_loop_with_break(){ - int m; - - // Nested while loop with a break statement - int n = 1; - while (n <= 5) - { - printf("Outer While loop iteration: %d\n", n); - m = 1; - while (1) - { - printf("Inner While loop iteration: %d\n", m); - m++; - if (m == 4) - { - break; - } - } - n++; - } - return 0; -} - -int nested_loop_with_conditions(){ - // Loop with nested conditions - for (int v = 1; v <= 10; v++) - { - printf("Loop with Nested Conditions: %d - ", v); - if (v < 5) - { - printf("Less than 5\n"); - } - else if (v > 5) - { - printf("Greater than 5\n"); - } - else - { - printf("Equal to 5\n"); - } - } -} - -int main() -{ - non_nested_loops(); - nested_loops(); - // Additional nested loops - nested_while_loop_with_break(); - nested_loop_with_conditions(); - - return 0; -} diff --git a/tests/regression/78-termination/16-nested-loop-nontrivial-nonterminating.c b/tests/regression/78-termination/16-nested-loop-nontrivial-nonterminating.c deleted file mode 100644 index 267a2d2fd8f..00000000000 --- a/tests/regression/78-termination/16-nested-loop-nontrivial-nonterminating.c +++ /dev/null @@ -1,23 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int outerCount = 1; - - while (outerCount <= 3) - { - int innerCount = 1; - - while (outerCount < 3 || innerCount > 0) // NONTERMLOOP termination analysis shall mark beginning of while as non-terminating loop - { - printf("(%d, %d) ", outerCount, innerCount); - innerCount++; - } - - printf("\n"); - outerCount++; - } - - return 0; -} diff --git a/tests/regression/78-termination/17-goto-terminating.c b/tests/regression/78-termination/17-goto-terminating.c deleted file mode 100644 index 2f678d294b9..00000000000 --- a/tests/regression/78-termination/17-goto-terminating.c +++ /dev/null @@ -1,21 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -// The program terminates but the analysis is currently only meant to detect up-jumping gotos as potentially NonTerminating, therefore we expect an NonTerm -#include - -int main() -{ - int num = 1; - -loop: - printf("Current number: %d\n", num); - num++; - - if (num <= 10) - { - goto loop; // NONTERMGOTO termination analysis shall mark goto statement up-jumping goto - // We are not able to detect up-jumping gotos as terminating, we - // just warn about them might being nonterminating. - } - - return 0; -} diff --git a/tests/regression/78-termination/18-goto-nonterminating.c b/tests/regression/78-termination/18-goto-nonterminating.c deleted file mode 100644 index 6de80effd76..00000000000 --- a/tests/regression/78-termination/18-goto-nonterminating.c +++ /dev/null @@ -1,15 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int num = 1; - -loop: - printf("Current number: %d\n", num); - num++; - - goto loop; // NONTERMGOTO termination analysis shall mark goto statement up-jumping goto - - return 0; -} diff --git a/tests/regression/78-termination/19-rand-terminating.c b/tests/regression/78-termination/19-rand-terminating.c deleted file mode 100644 index a5b6c229417..00000000000 --- a/tests/regression/78-termination/19-rand-terminating.c +++ /dev/null @@ -1,31 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include -#include -#include - -int main() -{ - // Seed the random number generator - srand(time(NULL)); - - if (rand()) - { - // Loop inside the if part - for (int i = 1; i <= 5; i++) - { - printf("Loop inside if part: %d\n", i); - } - } - else - { - // Loop inside the else part - int j = 1; - while (j <= 5) - { - printf("Loop inside else part: %d\n", j); - j++; - } - } - - return 0; -} diff --git a/tests/regression/78-termination/20-rand-nonterminating.c b/tests/regression/78-termination/20-rand-nonterminating.c deleted file mode 100644 index 21b25ed9dd8..00000000000 --- a/tests/regression/78-termination/20-rand-nonterminating.c +++ /dev/null @@ -1,30 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include -#include -#include - -int main() -{ - // Seed the random number generator - srand(time(NULL)); - - if (rand()) - { - // Loop inside the if part - for (int i = 1; i >= 0; i++) // NONTERMLOOP termination analysis shall mark beginning of while as non-terminating loop - { - printf("Loop inside if part: %d\n", i); - } - } - else - { - // Loop inside the else part - int j = 1; - while (j > 0) // NONTERMLOOP termination analysis shall mark beginning of while as non-terminating loop - { - printf("Loop inside else part: %d\n", j); - } - } - - return 0; -} diff --git a/tests/regression/78-termination/21-no-exit-on-rand-unproofable.c b/tests/regression/78-termination/21-no-exit-on-rand-unproofable.c deleted file mode 100644 index 5f82d910790..00000000000 --- a/tests/regression/78-termination/21-no-exit-on-rand-unproofable.c +++ /dev/null @@ -1,20 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int forever, i = 0; - - // This loop is not provable, therefore it should throw a warning - while (i < 4 || forever == 1) // NONTERMLOOP termination analysis shall mark beginning of while as non-terminating loop - { - i++; - if (i == 4) - { - if (rand()) - { - forever = 1; - } - } - } -} \ No newline at end of file diff --git a/tests/regression/78-termination/22-exit-on-rand-unproofable.c b/tests/regression/78-termination/22-exit-on-rand-unproofable.c deleted file mode 100644 index 33838ca83dd..00000000000 --- a/tests/regression/78-termination/22-exit-on-rand-unproofable.c +++ /dev/null @@ -1,16 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int forever = 1; - - // This loop is not provable, therefore it should throw a warning - while (forever == 1) // NONTERMLOOP termination analysis shall mark beginning of while as non-terminating loop - { - if (rand()) // May exit, may not - { - forever = 0; - } - } -} \ No newline at end of file diff --git a/tests/regression/78-termination/23-exit-on-rand-terminating.c b/tests/regression/78-termination/23-exit-on-rand-terminating.c deleted file mode 100644 index e65c064c401..00000000000 --- a/tests/regression/78-termination/23-exit-on-rand-terminating.c +++ /dev/null @@ -1,17 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include -#include - -int main() -{ - int short_run, i = 0; - // Currently not able to detect this as terminating due to multiple conditions - while (i < 90 && short_run != 1) - { - i++; - if (rand()) - { - short_run = 1; - } - } -} \ No newline at end of file diff --git a/tests/regression/78-termination/24-upjumping-goto-loopless-terminating.c b/tests/regression/78-termination/24-upjumping-goto-loopless-terminating.c deleted file mode 100644 index ce257d11ef2..00000000000 --- a/tests/regression/78-termination/24-upjumping-goto-loopless-terminating.c +++ /dev/null @@ -1,21 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -// The program terminates but the analysis is currently only meant to detect up-jumping gotos as potentially NonTerminating, therefore we expect an NonTerm -#include - -int main() -{ // Currently not able to detect up-jumping loop free gotos - goto mark2; - -mark1: - printf("This is mark1\n"); - goto mark3; - -mark2: - printf("This is mark2\n"); - goto mark1; // NONTERMGOTO termination analysis shall mark goto statement up-jumping goto - -mark3: - printf("This is mark3\n"); - - return 0; -} diff --git a/tests/regression/78-termination/25-leave-loop-goto-terminating.c b/tests/regression/78-termination/25-leave-loop-goto-terminating.c deleted file mode 100644 index b882759bffc..00000000000 --- a/tests/regression/78-termination/25-leave-loop-goto-terminating.c +++ /dev/null @@ -1,28 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int counter = 0; - - while (1) - { - counter++; - - // Dummy code - printf("Iteration %d\n", counter); - int result = counter * 2; - printf("Result: %d\n", result); - - // Condition to terminate the loop - if (result >= 10) - { // Apron is not able to detect this - goto end; - } - } - -end: - printf("Loop exited. Result is greater than or equal to 10.\n"); - - return 0; -} diff --git a/tests/regression/78-termination/26-enter-loop-goto-terminating.c b/tests/regression/78-termination/26-enter-loop-goto-terminating.c deleted file mode 100644 index aa85f22b3e3..00000000000 --- a/tests/regression/78-termination/26-enter-loop-goto-terminating.c +++ /dev/null @@ -1,31 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int counter = 0; - - goto jump_point; - - while (1) - { - counter++; - - // Dummy code - printf("Iteration %d\n", counter); - int result = counter * 2; - jump_point: - printf("Result: %d\n", result); - - // Condition to terminate the loop - if (result >= 10) - { // Apron is not able to detect this - goto end; - } - } - -end: - printf("Loop exited. Result is greater than or equal to 10.\n"); - - return 0; -} diff --git a/tests/regression/78-termination/27-upjumping-goto-nonterminating.c b/tests/regression/78-termination/27-upjumping-goto-nonterminating.c deleted file mode 100644 index e0eb633b114..00000000000 --- a/tests/regression/78-termination/27-upjumping-goto-nonterminating.c +++ /dev/null @@ -1,21 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - goto mark2; - -mark1: - printf("This is mark1\n"); - goto mark3; - -mark2: - printf("This is mark2\n"); - goto mark1; // NONTERMGOTO termination analysis shall mark goto statement up-jumping goto - -mark3: - printf("This is mark3\n"); - goto mark1; // NONTERMGOTO termination analysis shall mark goto statement up-jumping goto - - return 0; -} diff --git a/tests/regression/78-termination/28-do-while-continue-terminating.c b/tests/regression/78-termination/28-do-while-continue-terminating.c deleted file mode 100644 index a61174d2953..00000000000 --- a/tests/regression/78-termination/28-do-while-continue-terminating.c +++ /dev/null @@ -1,99 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int i = 1; - - do - { - i++; - printf("Inside the do-while loop\n"); - if (i % 2 == 0) - { - - printf("Skipping %i is even\n", i); - continue; // This is handled as an goto to line 8 and therefore an up-jumping goto - } - } while (i <= 5); - - printf("Exited the loop\n"); - return 0; -} - -/* -NOTE: -Test 28: does not terminate but should terminate (test case -"28-do-while-continue-terminating.c") Reason: upjumping goto - -If one has a look at the generated CIL output (attached at the bottom of this -file), one can see that the "continue" is translated in a "goto" with a -corresponding label "__Cont". This label points to the loop-exit condition. -Since the condition is part of the loop, its location is evaluated to 8-17. The -location of the goto "goto __Cont" is located in line 15. To provide soundness -for the analysis, the preprocessing detects upjumping gotos with the help of its -location. In case such a goto is detected, the program is classified as -non-terminating. Due to this inserted goto (which is a result of the -"continue"), an upjumping goto is located, which makes this program -non-terminating. - -It should be noted that this issue happens when "do while"-loops and "continues" -are combined. If one combines "while"-loops and "continues", the analysis can -still classify the loop as terminating. The reason for that can be seen in the -second CIL output, where the "do while"-loop is replaced by a "while"-loop. -Instead of creating a new label, the "while-continue" label of the loop is -reused. Also, this goto statement is not specified as a goto, but as a Continue -statement. Hence, it is not analyzed for the upjumping gotos, which does not -lead to the problem as with the "do while". - - -------- SHORTENED CIL output for Test 28 (DO WHILE): ------- -int main(void) -{{{{ - #line 8 - while (1) { - while_continue: ; - #line 12 - if (i % 2 == 0) { - #line 15 - goto __Cont; - } - __Cont: - #line 8 - if (! (i <= 5)) { - #line 8 - goto while_break; - } - } - - while_break: - }} - #line 20 - return (0); -}} - - -------- SHORTENED CIL output for Test 28 (WHILE): ------- -Test 28: replacing DO WHILE with WHILE: int main(void) -{{{{ - #line 8 - while (1) { - while_continue: ; - #line 8 - if (! (i <= 5)) { - #line 8 - goto while_break; - } - #line 12 - if (i % 2 == 0) { - #line 15 - goto while_continue; - } - } - while_break: ; - }} - #line 20 - return (0); -}} - -*/ diff --git a/tests/regression/78-termination/29-do-while-continue-nonterminating.c b/tests/regression/78-termination/29-do-while-continue-nonterminating.c deleted file mode 100644 index dd931c012f3..00000000000 --- a/tests/regression/78-termination/29-do-while-continue-nonterminating.c +++ /dev/null @@ -1,22 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int i = 1; - - do - { - printf("Inside the do-while loop\n"); - i++; - - if (i % 2) - { - printf("Continue as %i is odd\n", i); - continue; - } - } while (i >= 2); // NONTERMLOOP termination analysis shall mark beginning of while as non-terminating loop - - printf("Exited the loop\n"); - return 0; -} diff --git a/tests/regression/78-termination/30-goto-out-of-inner-loop-terminating.c b/tests/regression/78-termination/30-goto-out-of-inner-loop-terminating.c deleted file mode 100644 index c07b558d07b..00000000000 --- a/tests/regression/78-termination/30-goto-out-of-inner-loop-terminating.c +++ /dev/null @@ -1,36 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int rows = 5; - int columns = 5; - - // Outer loop for rows - for (int i = 1; i <= rows; i++) - { - // Inner loop for columns - for (int j = 1; j <= columns; j++) - { - if (j == 3) - { - goto outer_loop; // Jump to the label "outer_loop" - } - printf("(%d, %d) ", i, j); - } - printf("Not Skipped?\n"); - outer_loop:; // Label for the outer loop - printf("Skipped!\n"); - } - - return 0; -} - -/* -NOTE: In case we do NOT assume no-overflow: -Test 30: terminates (test case "30-goto-out-of-inner-loop-terminating.c") -Test 35: does not terminate (test case -"35-goto-out-of-inner-loop-with-print-terminating.c") - -The reason is explained in "35-goto-out-of-inner-loop-with-print-terminating.c" -*/ diff --git a/tests/regression/78-termination/31-goto-out-of-inner-loop-nonterminating.c b/tests/regression/78-termination/31-goto-out-of-inner-loop-nonterminating.c deleted file mode 100644 index f9b92756208..00000000000 --- a/tests/regression/78-termination/31-goto-out-of-inner-loop-nonterminating.c +++ /dev/null @@ -1,27 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int rows = 5; - int columns = 5; - - // Outer loop for rows - for (int i = 1; 1; i++) // NONTERMLOOP termination analysis shall mark beginning of for as non-terminating loop - { - // Inner loop for columns - for (int j = 1; j <= columns; j++) - { - if (j == 3) - { - printf("Goto as continue for outer loop\n"); - goto outer_loop; - } - printf("(%d, %d) ", i, j); - } - printf("\n"); - outer_loop:; // Label for the outer loop - } - - return 0; -} diff --git a/tests/regression/78-termination/32-multithread-terminating.c b/tests/regression/78-termination/32-multithread-terminating.c deleted file mode 100644 index eb8b796a476..00000000000 --- a/tests/regression/78-termination/32-multithread-terminating.c +++ /dev/null @@ -1,30 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -// The program terminates but as the termination analysis is meant to not handle multithreaded programs we expect NonTerm here -#include -#include -#include - -// Thread function -void *printPID(void *arg) -{ - pid_t pid = getpid(); - pthread_t tid = pthread_self(); - printf("Thread ID: %lu, Process ID: %d\n", (unsigned long)tid, pid); - return NULL; -} - -int main() -{ - // Create three threads - pthread_t thread1, thread2, thread3; - pthread_create(&thread1, NULL, printPID, NULL); - pthread_create(&thread2, NULL, printPID, NULL); - pthread_create(&thread3, NULL, printPID, NULL); - - // Wait for all threads to finish - pthread_join(thread1, NULL); - pthread_join(thread2, NULL); - pthread_join(thread3, NULL); - - return 0; -} diff --git a/tests/regression/78-termination/33-multithread-nonterminating.c b/tests/regression/78-termination/33-multithread-nonterminating.c deleted file mode 100644 index 8a6274c7ab9..00000000000 --- a/tests/regression/78-termination/33-multithread-nonterminating.c +++ /dev/null @@ -1,40 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include -#include -#include -#include -#include - -// Thread function -void *printPID(void *arg) -{ - pid_t pid = getpid(); - pthread_t tid = pthread_self(); - while (1) - { - printf("Thread ID: %lu, Process ID: %d\n", (unsigned long)tid, pid); - struct timespec sleepTime; - sleepTime.tv_sec = 1; // Seconds - sleepTime.tv_nsec = - 100000000 + (rand() % 200000000); // Nanoseconds (0.1 seconds + rand) - printf("Sleep for %ld nsec\n", sleepTime.tv_nsec); - nanosleep(&sleepTime, NULL); - } - return NULL; -} - -int main() -{ - // Create three threads - pthread_t thread1, thread2, thread3; - pthread_create(&thread1, NULL, printPID, NULL); - pthread_create(&thread2, NULL, printPID, NULL); - pthread_create(&thread3, NULL, printPID, NULL); - - // Wait for all threads to finish - pthread_join(thread1, NULL); - pthread_join(thread2, NULL); - pthread_join(thread3, NULL); - - return 0; -} diff --git a/tests/regression/78-termination/34-nested-for-loop-nonterminating.c b/tests/regression/78-termination/34-nested-for-loop-nonterminating.c deleted file mode 100644 index 2f21f9e9964..00000000000 --- a/tests/regression/78-termination/34-nested-for-loop-nonterminating.c +++ /dev/null @@ -1,19 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int outerCount, innerCount; - - for (outerCount = 1; outerCount <= 3; outerCount++) - { - for (innerCount = 1; innerCount > 0; innerCount++) // NONTERMLOOP termination analysis shall mark beginning of for as non-terminating loop - { - printf("(%d, %d) ", outerCount, innerCount); - } - - printf("\n"); - } - - return 0; -} diff --git a/tests/regression/78-termination/35-goto-out-of-inner-loop-with-print-terminating.c b/tests/regression/78-termination/35-goto-out-of-inner-loop-with-print-terminating.c deleted file mode 100644 index 4c738e11735..00000000000 --- a/tests/regression/78-termination/35-goto-out-of-inner-loop-with-print-terminating.c +++ /dev/null @@ -1,42 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set "ana.activated[+]" apron --enable ana.int.interval --set ana.apron.domain polyhedra --set sem.int.signed_overflow assume_none -#include - -int main() -{ - int rows = 5; - int columns = 5; - - // Outer loop for rows - for (int i = 1; i <= rows; i++) - { - // Inner loop for columns - for (int j = 1; j <= columns; j++) - { - if (j == 3) - { - goto outer_loop; // Jump to the label "outer_loop" - } - printf("(%d, %d) ", i, j); - } - outer_loop: // Label for the outer loop - printf("\n"); - } - - return 0; -} - -/* -NOTE: In case we do NOT assume no-overflow: -Test 30: terminates (test case "30-goto-out-of-inner-loop-terminating.c") -Test 35: does not terminate (test case -"35-goto-out-of-inner-loop-with-print-terminating.c") - -The only difference between Test 30 and Test 35 is line 17. Test 30 has an -additional statement, and Test 35 continues already with the label. This -difference in Test 35 leads to an overflow in line 11, and hence to the -non-termination. This overflow is created by a WPoint Issue. By enabling the -no-overflow option this issue can be fixed and, both test cases are correctly -detected as terminating. - -(The overflow also happens without the termination analysis enabled.) -*/ diff --git a/tests/regression/78-termination/36-recursion-terminating.c b/tests/regression/78-termination/36-recursion-terminating.c deleted file mode 100644 index 179efabeea2..00000000000 --- a/tests/regression/78-termination/36-recursion-terminating.c +++ /dev/null @@ -1,25 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -void recursiveFunction(int n) -{ - // Base case: When n reaches 0, stop recursion - if (n == 0) - { - printf("Terminating recursion\n"); - return; - } - - printf("Recursive call with n = %d\n", n); - - // Recursive call: Decrement n and call the function again - recursiveFunction(n - 1); -} - -int main() -{ - // Call the recursive function with an initial value - recursiveFunction(5); - - return 0; -} diff --git a/tests/regression/78-termination/37-recursion-nonterminating.c b/tests/regression/78-termination/37-recursion-nonterminating.c deleted file mode 100644 index c47fbcdd49e..00000000000 --- a/tests/regression/78-termination/37-recursion-nonterminating.c +++ /dev/null @@ -1,25 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra --enable ana.context.widen -#include - -void recursiveFunction(int n) // NONTERMFUNDEC termination analysis shall mark fundec of non-terminating function -{ - // Base case: When n reaches 0, stop recursion - if (n == 30) - { - printf("Terminating recursion\n"); - return; - } - - printf("Recursive call with n = %d\n", n); - - // Recursive call: Decrement n and call the function again - recursiveFunction(n - 1); -} - -int main() -{ - // Call the recursive function with an initial value - recursiveFunction(5); - - return 0; -} diff --git a/tests/regression/78-termination/38-recursion-nested-terminating.c b/tests/regression/78-termination/38-recursion-nested-terminating.c deleted file mode 100644 index a471cfc386c..00000000000 --- a/tests/regression/78-termination/38-recursion-nested-terminating.c +++ /dev/null @@ -1,41 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -void innerRecursiveFunction(int n) -{ - if (n == 0) - { - printf("Terminating inner recursion\n"); - return; - } - - printf("Inner recursive call with n = %d\n", n); - - // Recursive call to the innerRecursiveFunction - innerRecursiveFunction(n - 1); -} - -void outerRecursiveFunction(int n) -{ - if (n == 0) - { - printf("Terminating outer recursion\n"); - return; - } - - printf("Outer recursive call with n = %d\n", n); - - // Recursive call to the outerRecursiveFunction - outerRecursiveFunction(n - 1); - - // Call to the innerRecursiveFunction - innerRecursiveFunction(n); -} - -int main() -{ - // Call the outerRecursiveFunction with an initial value - outerRecursiveFunction(3); - - return 0; -} diff --git a/tests/regression/78-termination/39-recursion-nested-nonterminating.c b/tests/regression/78-termination/39-recursion-nested-nonterminating.c deleted file mode 100644 index a8d71074429..00000000000 --- a/tests/regression/78-termination/39-recursion-nested-nonterminating.c +++ /dev/null @@ -1,29 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -void innerRecursiveFunction() // TODO NONTERMFUNDEC termination analysis shall mark fundec of non-terminating function but can not as dead code is not analysed -{ - printf("Nested recursive call\n"); - - // Recursive call to the innerRecursiveFunction - innerRecursiveFunction(); -} - -void outerRecursiveFunction() // NONTERMFUNDEC termination analysis shall mark fundec of non-terminating function -{ - printf("Outer recursive call\n"); - - // Recursive call to the outerRecursiveFunction - outerRecursiveFunction(); - - // Call to the innerRecursiveFunction - innerRecursiveFunction(); -} - -int main() -{ - // Call the outerRecursiveFunction - outerRecursiveFunction(); - - return 0; -} diff --git a/tests/regression/78-termination/40-multi-expression-conditions-terminating.c b/tests/regression/78-termination/40-multi-expression-conditions-terminating.c deleted file mode 100644 index 80f8c5a1e8c..00000000000 --- a/tests/regression/78-termination/40-multi-expression-conditions-terminating.c +++ /dev/null @@ -1,44 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - int i; - - // Loop with complex conditions - for (i = 1; i <= 10; i++) - { - if (i > 5 && i % 2 == 0) // CIL defines new jump labels to default location (-1) - { - printf("%d ", i); - } - } - printf("\n"); - - // Loop with complex conditions - i = 1; - while (i <= 10) - { - if (i > 5 && i % 2 == 0) // CIL defines new jump labels to default location (-1) - { - printf("%d ", i); - } - i++; - } - printf("\n"); - - // Loop with multiple conditions - int s = 1; - while (s <= 10 && s % 2 == 0) // CIL defines new jump labels to default location (-1) - { - printf("Loop with Multiple Conditions: %d\n", s); - s++; - } - - // Loop with multiple variables - int t, u; - for (t = 1, u = 10; t <= 5 && u >= 5; t++, u--) // CIL defines new jump labels to default location (-1) - { - printf("Loop with Multiple Variables: %d %d\n", t, u); - } -} \ No newline at end of file diff --git a/tests/regression/78-termination/41-for-continue-terminating.c b/tests/regression/78-termination/41-for-continue-terminating.c deleted file mode 100644 index d87a7058686..00000000000 --- a/tests/regression/78-termination/41-for-continue-terminating.c +++ /dev/null @@ -1,27 +0,0 @@ -// SKIP TODO TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() -{ - // Loop with a continue statement - for (int i = 1; i <= 10; i++) - { - if (i % 2 == 0) - { - continue; // Converted to an goto to "for" in line 7 - } - printf("%d ", i); - } - printf("\n"); - - - // Loop with a continue statement - for (int r = 1; r <= 10; r++) - { - if (r % 3 == 0) - { - continue; // Converted to an goto to "for" in line 19 - } - printf("Loop with Continue: %d\n", r); - } -} \ No newline at end of file diff --git a/tests/regression/78-termination/42-downjumping-goto-loopless-terminating.c b/tests/regression/78-termination/42-downjumping-goto-loopless-terminating.c deleted file mode 100644 index 48864883f73..00000000000 --- a/tests/regression/78-termination/42-downjumping-goto-loopless-terminating.c +++ /dev/null @@ -1,19 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() { // Currently not able to detect up-jumping loop free gotos - goto mark2; - -mark1: - printf("This is mark1\n"); - goto mark3; - -mark2: - printf("This is mark2\n"); - goto mark3; - -mark3: - printf("This is mark3\n"); - - return 0; -} diff --git a/tests/regression/78-termination/43-return-from-endless-loop-terminating.c b/tests/regression/78-termination/43-return-from-endless-loop-terminating.c deleted file mode 100644 index fb48e1cdbe2..00000000000 --- a/tests/regression/78-termination/43-return-from-endless-loop-terminating.c +++ /dev/null @@ -1,14 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -int main() { - int i = 1; - - while (i != 0) { - printf("%d\n", i); - i++; - if (i>10) { - return 0; - } - } -} diff --git a/tests/regression/78-termination/44-recursion-multiple-functions-terminating.c b/tests/regression/78-termination/44-recursion-multiple-functions-terminating.c deleted file mode 100644 index 7f9b63527e3..00000000000 --- a/tests/regression/78-termination/44-recursion-multiple-functions-terminating.c +++ /dev/null @@ -1,40 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -void functionB(int n); -void functionC(int n); -void functionD(int n); - -void functionA(int n) { - if (n > 0) { - printf("Function A: %d\n", n); - functionB(n - 1); - } -} - -void functionB(int n) { - if (n > 0) { - printf("Function B: %d\n", n); - functionC(n - 1); - } -} - -void functionC(int n) { - if (n > 0) { - printf("Function C: %d\n", n); - functionD(n - 1); - } -} - -void functionD(int n) { - if (n > 0) { - printf("Function D: %d\n", n); - functionA(n - 1); - } -} - -int main() { - int n = 15; - functionA(n); - return 0; -} diff --git a/tests/regression/78-termination/45-recursion-multiple-functions-nonterminating.c b/tests/regression/78-termination/45-recursion-multiple-functions-nonterminating.c deleted file mode 100644 index be47fde7047..00000000000 --- a/tests/regression/78-termination/45-recursion-multiple-functions-nonterminating.c +++ /dev/null @@ -1,40 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -void functionB(int n); -void functionC(int n); -void functionD(int n); - -void functionA(int n) { - if (n > 0) { - printf("Function A: %d\n", n); - functionB(n - 1); - } -} - -void functionB(int n) { - if (n > 0) { - printf("Function B: %d\n", n); - functionC(n - 1); - } -} - -void functionC(int n) { - if (n > 0) { - printf("Function C: %d\n", n); - functionD(n + 1); - } -} - -void functionD(int n) { - if (n > 0) { - printf("Function D: %d\n", n); - functionA(n + 1); - } -} - -int main() { - int n = 15; - functionA(n); - return 0; -} diff --git a/tests/regression/78-termination/46-recursion-different-context-terminating.c b/tests/regression/78-termination/46-recursion-different-context-terminating.c deleted file mode 100644 index 2fa42f58fc2..00000000000 --- a/tests/regression/78-termination/46-recursion-different-context-terminating.c +++ /dev/null @@ -1,32 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -void functionC(int n); - -void functionA(int n) { - if (n > 0) { - printf("Function A: %d\n", n); - functionC(n - 1); - } -} - -void functionB(int n) { - if (n > 0) { - printf("Function B: %d\n", n); - functionC(n - 1); - } -} - -void functionC(int n) { - if (n > 0) { - printf("Function C: %d\n", n); - functionC(n - 1); - } -} - -int main() { - int n = 5; - functionA(n + 1); - functionB(n + 7); - return 0; -} diff --git a/tests/regression/78-termination/47-recursion-different-context-nonterminating.c b/tests/regression/78-termination/47-recursion-different-context-nonterminating.c deleted file mode 100644 index b0e44bce926..00000000000 --- a/tests/regression/78-termination/47-recursion-different-context-nonterminating.c +++ /dev/null @@ -1,32 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include - -void functionC(int n); - -void functionA(int n) { - if (n > 0) { - printf("Function A: %d\n", n); - functionC(n - 1); - } -} - -void functionB(int n) { - if (n > 0) { - printf("Function B: %d\n", n); - functionC(n - 1); - } -} - -void functionC(int n) { - if (n > 0) { - printf("Function C: %d\n", n); - functionC(n); - } -} - -int main() { - int n = 5; - functionA(n + 1); - functionB(n + 7); - return 0; -} diff --git a/tests/regression/78-termination/48-dynamic-recursion-nonterminating.c b/tests/regression/78-termination/48-dynamic-recursion-nonterminating.c deleted file mode 100644 index d54c49fb432..00000000000 --- a/tests/regression/78-termination/48-dynamic-recursion-nonterminating.c +++ /dev/null @@ -1,10 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -void troll(void (*f) ()) -{ - f(f); -} - -int main() -{ - troll(troll); -} diff --git a/tests/regression/78-termination/49-longjmp.c b/tests/regression/78-termination/49-longjmp.c deleted file mode 100644 index be13cb286c2..00000000000 --- a/tests/regression/78-termination/49-longjmp.c +++ /dev/null @@ -1,11 +0,0 @@ -// SKIP NONTERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain polyhedra -#include -jmp_buf buf; -int main() -{ - if(setjmp(buf)) { - - } - - longjmp(buf, 1); -} diff --git a/tests/regression/78-termination/50-decreasing-signed-int.c b/tests/regression/78-termination/50-decreasing-signed-int.c deleted file mode 100644 index 01daa5ee21b..00000000000 --- a/tests/regression/78-termination/50-decreasing-signed-int.c +++ /dev/null @@ -1,13 +0,0 @@ -// SKIP TERM PARAM: --set "ana.activated[+]" termination --set ana.activated[+] apron --enable ana.int.interval --set ana.apron.domain octagon -int main() -{ - int x; - - if(x <= 0){ - return 0; - } - while (x > 0) { - x = x - 1; - } - return 0; -} diff --git a/tests/regression/78-termination/51-modulo.c b/tests/regression/78-termination/51-modulo.c deleted file mode 100644 index 5f5b8f1924c..00000000000 --- a/tests/regression/78-termination/51-modulo.c +++ /dev/null @@ -1,14 +0,0 @@ -// SKIP TERM PARAM: --enable ana.autotune.enabled --enable ana.sv-comp.functions --enable ana.sv-comp.enabled --set ana.autotune.activated "['congruence']" --set ana.specification "CHECK( init(main()), LTL(F end) )" - -// This task previously crashed due to the autotuner -int main() { - int a; - int odd, count = 0; - while(a > 1) { - odd = a % 2; - if(!odd) a = a / 2; - else a = a - 1; - count++; - } - return count; -} diff --git a/tests/sv-comp/observer/path_nofun_true-unreach-call.c b/tests/sv-comp/observer/path_nofun_true-unreach-call.c index cf1191e9fd2..0cb70d23e93 100644 --- a/tests/sv-comp/observer/path_nofun_true-unreach-call.c +++ b/tests/sv-comp/observer/path_nofun_true-unreach-call.c @@ -21,4 +21,4 @@ int main() return 0; } -// ./goblint --enable ana.sv-comp --enable ana.wp --enable witness.graphml.uncil --disable ana.int.def_exc --enable ana.int.interval --set ana.activated '["base"]' --html tests/sv-comp/observer/path_nofun_true-unreach-call.c +// ./goblint --enable ana.sv-comp --enable ana.wp --enable witness.uncil --disable ana.int.def_exc --enable ana.int.interval --set ana.activated '["base"]' --html tests/sv-comp/observer/path_nofun_true-unreach-call.c diff --git a/unittest/analyses/libraryDslTest.ml b/unittest/analyses/libraryDslTest.ml index 077b81b8faf..e1fa23281c1 100644 --- a/unittest/analyses/libraryDslTest.ml +++ b/unittest/analyses/libraryDslTest.ml @@ -11,7 +11,7 @@ let pthread_mutex_lock_desc: LibraryDesc.t = LibraryDsl.( ) let pthread_create_desc: LibraryDesc.t = LibraryDsl.( - special [__ "thread" [w]; drop "attr" [r]; __ "start_routine" [r]; __ "arg" [r]] @@ fun thread start_routine arg -> ThreadCreate { thread; start_routine; arg; multiple = false } + special [__ "thread" [w]; drop "attr" [r]; __ "start_routine" [r]; __ "arg" [r]] @@ fun thread start_routine arg -> ThreadCreate { thread; start_routine; arg } ) let realloc_desc: LibraryDesc.t = LibraryDsl.( diff --git a/unittest/dune b/unittest/dune index 036c8d80133..7313aa964b1 100644 --- a/unittest/dune +++ b/unittest/dune @@ -2,7 +2,7 @@ (test (name mainTest) - (libraries ounit2 qcheck-ounit goblint.std goblint.lib goblint.constraint goblint.solver goblint.cdomain.value goblint.sites.dune goblint.build-info.dune) + (libraries ounit2 qcheck-ounit goblint.lib goblint.sites.dune goblint.build-info.dune) (preprocess (pps ppx_deriving.std ppx_deriving_hash ppx_deriving_yojson)) (flags :standard -linkall)) diff --git a/unittest/solver/solverTest.ml b/unittest/solver/solverTest.ml index 4e96266262d..47ec5443cac 100644 --- a/unittest/solver/solverTest.ml +++ b/unittest/solver/solverTest.ml @@ -2,8 +2,6 @@ open Goblint_lib open OUnit2 open GoblintCil open Pretty -open ConstrSys -open Goblint_solver (* variables are strings *) module StringVar = @@ -45,7 +43,7 @@ module ConstrSys = struct | _ -> None let iter_vars _ _ _ _ _ = () - let sys_change _ _ = {obsolete = []; delete = []; reluctant = []; restart = []} + let sys_change _ _ = {Analyses.obsolete = []; delete = []; reluctant = []; restart = []} end module LH = BatHashtbl.Make (ConstrSys.LVar) @@ -57,7 +55,7 @@ struct let should_warn = false let should_save_run = false end -module Solver = GlobSolverFromEqSolver (PostSolver.EqIncrSolverFromEqSolver (EffectWConEq.Make) (PostSolverArg)) (ConstrSys) (LH) (GH) +module Solver = Constraints.GlobSolverFromEqSolver (Constraints.EqIncrSolverFromEqSolver (EffectWConEq.Make) (PostSolverArg)) (ConstrSys) (LH) (GH) let test1 _ = let id x = x in diff --git a/unittest/util/intOpsTest.ml b/unittest/util/intOpsTest.ml index b0cb4dc9849..611f2f546f3 100644 --- a/unittest/util/intOpsTest.ml +++ b/unittest/util/intOpsTest.ml @@ -1,5 +1,5 @@ open OUnit2 -open Goblint_std +open Goblint_lib (* If the first operand of a div is negative, Zarith rounds the result away from zero. We thus always transform this into a division with a non-negative first operand. *) @@ -10,13 +10,13 @@ let old_div a b = if Z.lt a Z.zero then Z.neg (Z.ediv (Z.neg a) b) else Z.ediv a let old_rem a b = Z.sub a (Z.mul b (old_div a b)) let test_bigint_div = - QCheck.(Test.make ~name:"div" (pair GobQCheck.Arbitrary.big_int GobQCheck.Arbitrary.big_int) (fun (x, y) -> + QCheck.(Test.make ~name:"div" (pair MyCheck.Arbitrary.big_int MyCheck.Arbitrary.big_int) (fun (x, y) -> assume (Z.compare y Z.zero <> 0); Z.equal (Z.div x y) (old_div x y) )) let test_bigint_rem = - QCheck.(Test.make ~name:"rem" (pair GobQCheck.Arbitrary.big_int GobQCheck.Arbitrary.big_int) (fun (x, y) -> + QCheck.(Test.make ~name:"rem" (pair MyCheck.Arbitrary.big_int MyCheck.Arbitrary.big_int) (fun (x, y) -> assume (Z.compare y Z.zero <> 0); Z.equal (Z.rem x y) (old_rem x y) ))