From 89698bc46dd00b27a89cb726c82097419c504f57 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 1 Dec 2023 20:45:22 +0100 Subject: [PATCH 1/4] RFC: Remove spec & file analysis --- docs/developer-guide/messaging.md | 13 - scripts/goblint-lib-modules.py | 2 - scripts/spec/check.sh | 27 - scripts/spec/regression.py | 61 --- scripts/spec/regression.sh | 18 - scripts/spec/spec.sh | 10 - src/analyses/fileUse.ml | 296 ----------- src/analyses/spec.ml | 496 ------------------ src/common/util/options.schema.json | 26 - src/goblint_lib.ml | 2 - src/main.camldoc | 2 - src/mainspec.ml | 13 - src/spec/dune | 2 - src/spec/file.dot | 37 -- src/spec/render.sh | 31 -- src/spec/specCore.ml | 152 ------ src/spec/specLexer.mll | 67 --- src/spec/specParser.mly | 116 ---- src/spec/specUtil.ml | 52 -- tests/regression/18-file/01-ok.c | 12 - tests/regression/18-file/02-function.c | 17 - tests/regression/18-file/03-if-close.c | 15 - tests/regression/18-file/04-no-open.c | 10 - tests/regression/18-file/05-open-mode.c | 11 - tests/regression/18-file/06-2open.c | 12 - tests/regression/18-file/07-2close.c | 11 - tests/regression/18-file/08-var-reuse.c | 15 - .../regression/18-file/09-inf-loop-no-close.c | 17 - tests/regression/18-file/10-inf-loop-ok.c | 19 - tests/regression/18-file/11-2if.c | 18 - tests/regression/18-file/12-2close-if.c | 15 - tests/regression/18-file/13-ptr-arith-ok.c | 16 - tests/regression/18-file/14-ptr-arith-close.c | 13 - tests/regression/18-file/15-var-switch.c | 18 - tests/regression/18-file/16-var-reuse-close.c | 14 - tests/regression/18-file/17-myfopen.c | 21 - tests/regression/18-file/18-myfopen-arg.c | 20 - tests/regression/18-file/19-if-close-else.c | 17 - tests/regression/18-file/20-loop-close.c | 18 - tests/regression/18-file/21-for-i.c | 26 - tests/regression/18-file/22-f_int.c | 13 - tests/regression/18-file/23-f_str.c | 13 - tests/regression/18-file/24-f_wstr.c | 14 - tests/regression/18-file/25-mem-ok.c | 29 - tests/regression/18-file/26-open-error-ok.c | 15 - tests/regression/18-file/27-open-error.c | 13 - tests/regression/18-file/28-multiple-exits.c | 14 - tests/regression/18-file/29-alias-global.c | 22 - tests/regression/18-file/30-ptr-of-ptr.c | 14 - tests/regression/18-file/31-var-reuse-fun.c | 16 - tests/regression/18-file/32-multi-ptr-close.c | 25 - tests/regression/18-file/33-multi-ptr-open.c | 23 - .../regression/18-file/34-multi-alias-close.c | 25 - .../regression/18-file/35-multi-alias-open.c | 23 - tests/regression/18-file/36-fun-ptr.c | 14 - .../regression/18-file/37-var-switch-alias.c | 18 - tests/regression/18-file/README.md | 2 + tests/regression/18-file/file.c | 44 -- tests/regression/18-file/file.optimistic.spec | 34 -- tests/regression/18-file/file.spec | 57 -- tests/regression/19-spec/01-malloc-free.c | 19 - tests/regression/19-spec/02-mutex_rc.c | 23 - tests/regression/19-spec/README.md | 2 + .../regression/19-spec/malloc.optimistic.spec | 23 - tests/regression/19-spec/malloc.spec | 26 - tests/regression/19-spec/mutex-lock.spec | 31 -- 66 files changed, 4 insertions(+), 2306 deletions(-) delete mode 100755 scripts/spec/check.sh delete mode 100755 scripts/spec/regression.py delete mode 100755 scripts/spec/regression.sh delete mode 100755 scripts/spec/spec.sh delete mode 100644 src/analyses/fileUse.ml delete mode 100644 src/analyses/spec.ml delete mode 100644 src/mainspec.ml delete mode 100644 src/spec/dune delete mode 100644 src/spec/file.dot delete mode 100755 src/spec/render.sh delete mode 100644 src/spec/specCore.ml delete mode 100644 src/spec/specLexer.mll delete mode 100644 src/spec/specParser.mly delete mode 100644 src/spec/specUtil.ml delete mode 100644 tests/regression/18-file/01-ok.c delete mode 100644 tests/regression/18-file/02-function.c delete mode 100644 tests/regression/18-file/03-if-close.c delete mode 100644 tests/regression/18-file/04-no-open.c delete mode 100644 tests/regression/18-file/05-open-mode.c delete mode 100644 tests/regression/18-file/06-2open.c delete mode 100644 tests/regression/18-file/07-2close.c delete mode 100644 tests/regression/18-file/08-var-reuse.c delete mode 100644 tests/regression/18-file/09-inf-loop-no-close.c delete mode 100644 tests/regression/18-file/10-inf-loop-ok.c delete mode 100644 tests/regression/18-file/11-2if.c delete mode 100644 tests/regression/18-file/12-2close-if.c delete mode 100644 tests/regression/18-file/13-ptr-arith-ok.c delete mode 100644 tests/regression/18-file/14-ptr-arith-close.c delete mode 100644 tests/regression/18-file/15-var-switch.c delete mode 100644 tests/regression/18-file/16-var-reuse-close.c delete mode 100644 tests/regression/18-file/17-myfopen.c delete mode 100644 tests/regression/18-file/18-myfopen-arg.c delete mode 100644 tests/regression/18-file/19-if-close-else.c delete mode 100644 tests/regression/18-file/20-loop-close.c delete mode 100644 tests/regression/18-file/21-for-i.c delete mode 100644 tests/regression/18-file/22-f_int.c delete mode 100644 tests/regression/18-file/23-f_str.c delete mode 100644 tests/regression/18-file/24-f_wstr.c delete mode 100644 tests/regression/18-file/25-mem-ok.c delete mode 100644 tests/regression/18-file/26-open-error-ok.c delete mode 100644 tests/regression/18-file/27-open-error.c delete mode 100644 tests/regression/18-file/28-multiple-exits.c delete mode 100644 tests/regression/18-file/29-alias-global.c delete mode 100644 tests/regression/18-file/30-ptr-of-ptr.c delete mode 100644 tests/regression/18-file/31-var-reuse-fun.c delete mode 100644 tests/regression/18-file/32-multi-ptr-close.c delete mode 100644 tests/regression/18-file/33-multi-ptr-open.c delete mode 100644 tests/regression/18-file/34-multi-alias-close.c delete mode 100644 tests/regression/18-file/35-multi-alias-open.c delete mode 100644 tests/regression/18-file/36-fun-ptr.c delete mode 100644 tests/regression/18-file/37-var-switch-alias.c create mode 100644 tests/regression/18-file/README.md delete mode 100644 tests/regression/18-file/file.c delete mode 100644 tests/regression/18-file/file.optimistic.spec delete mode 100644 tests/regression/18-file/file.spec delete mode 100644 tests/regression/19-spec/01-malloc-free.c delete mode 100644 tests/regression/19-spec/02-mutex_rc.c create mode 100644 tests/regression/19-spec/README.md delete mode 100644 tests/regression/19-spec/malloc.optimistic.spec delete mode 100644 tests/regression/19-spec/malloc.spec delete mode 100644 tests/regression/19-spec/mutex-lock.spec diff --git a/docs/developer-guide/messaging.md b/docs/developer-guide/messaging.md index 28f24bc49c..0028d51f87 100644 --- a/docs/developer-guide/messaging.md +++ b/docs/developer-guide/messaging.md @@ -47,16 +47,3 @@ 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/scripts/goblint-lib-modules.py b/scripts/goblint-lib-modules.py index 5f02271616..6369af53a1 100755 --- a/scripts/goblint-lib-modules.py +++ b/scripts/goblint-lib-modules.py @@ -42,8 +42,6 @@ "MessageCategory", # included in Messages "PreValueDomain", # included in ValueDomain - "SpecCore", # spec stuff - "SpecUtil", # spec stuff "ConfigVersion", "ConfigProfile", diff --git a/scripts/spec/check.sh b/scripts/spec/check.sh deleted file mode 100755 index 57b63edfd2..0000000000 --- a/scripts/spec/check.sh +++ /dev/null @@ -1,27 +0,0 @@ -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 deleted file mode 100755 index dc9f9fa276..0000000000 --- a/scripts/spec/regression.py +++ /dev/null @@ -1,61 +0,0 @@ -# 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 deleted file mode 100755 index 6dc740ca75..0000000000 --- a/scripts/spec/regression.sh +++ /dev/null @@ -1,18 +0,0 @@ -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 deleted file mode 100755 index 03abe9a0c7..0000000000 --- a/scripts/spec/spec.sh +++ /dev/null @@ -1,10 +0,0 @@ -# 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/src/analyses/fileUse.ml b/src/analyses/fileUse.ml deleted file mode 100644 index 58257b7843..0000000000 --- a/src/analyses/fileUse.ml +++ /dev/null @@ -1,296 +0,0 @@ -(** 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 ~multiple lval f args = [D.bot ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local - let exitstate v = D.bot () -end - -let _ = - MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/analyses/spec.ml b/src/analyses/spec.ml deleted file mode 100644 index 2f754f6160..0000000000 --- a/src/analyses/spec.ml +++ /dev/null @@ -1,496 +0,0 @@ -(** 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 ~multiple lval f args = [D.bot ()] - let threadspawn ctx ~multiple lval f args fctx = ctx.local - let exitstate v = D.bot () -end - -let _ = - MCP.register_analysis (module Spec : MCPSpec) diff --git a/src/common/util/options.schema.json b/src/common/util/options.schema.json index 7c921c4f53..4d9546a9ca 100644 --- a/src/common/util/options.schema.json +++ b/src/common/util/options.schema.json @@ -467,32 +467,6 @@ }, "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", diff --git a/src/goblint_lib.ml b/src/goblint_lib.ml index 70f331b5ac..d4f2982902 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -147,12 +147,10 @@ module UnitAnalysis = UnitAnalysis (** {2 Other} *) module Assert = Assert -module FileUse = FileUse module LoopTermination = LoopTermination module Uninit = Uninit module Expsplit = Expsplit module StackTrace = StackTrace -module Spec = Spec (** {2 Helper} diff --git a/src/main.camldoc b/src/main.camldoc index ec08a14a7b..0a0e52035f 100644 --- a/src/main.camldoc +++ b/src/main.camldoc @@ -85,7 +85,6 @@ FlagModeDomain LockDomain StackDomain FileDomain -SpecDomain LvalMapDomain } @@ -106,7 +105,6 @@ Glob {!modules: MCP Base -Spec CondVars Contain diff --git a/src/mainspec.ml b/src/mainspec.ml deleted file mode 100644 index 4509645f98..0000000000 --- a/src/mainspec.ml +++ /dev/null @@ -1,13 +0,0 @@ -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/spec/dune b/src/spec/dune deleted file mode 100644 index 47c22a0d46..0000000000 --- a/src/spec/dune +++ /dev/null @@ -1,2 +0,0 @@ -(ocamllex specLexer) -(ocamlyacc specParser) diff --git a/src/spec/file.dot b/src/spec/file.dot deleted file mode 100644 index a78c64d3fc..0000000000 --- a/src/spec/file.dot +++ /dev/null @@ -1,37 +0,0 @@ -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 deleted file mode 100755 index 91e486c247..0000000000 --- a/src/spec/render.sh +++ /dev/null @@ -1,31 +0,0 @@ -# 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 deleted file mode 100644 index 9d0ce35624..0000000000 --- a/src/spec/specCore.ml +++ /dev/null @@ -1,152 +0,0 @@ -(* 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 deleted file mode 100644 index 64ac69359e..0000000000 --- a/src/spec/specLexer.mll +++ /dev/null @@ -1,67 +0,0 @@ -{ - 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 deleted file mode 100644 index fe8fe90ec8..0000000000 --- a/src/spec/specParser.mly +++ /dev/null @@ -1,116 +0,0 @@ -%{ - (* 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 deleted file mode 100644 index 55e0b51135..0000000000 --- a/src/spec/specUtil.ml +++ /dev/null @@ -1,52 +0,0 @@ -(* 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/tests/regression/18-file/01-ok.c b/tests/regression/18-file/01-ok.c deleted file mode 100644 index 5c1f21ff1c..0000000000 --- a/tests/regression/18-file/01-ok.c +++ /dev/null @@ -1,12 +0,0 @@ -// 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 deleted file mode 100644 index fc3157c264..0000000000 --- a/tests/regression/18-file/02-function.c +++ /dev/null @@ -1,17 +0,0 @@ -// 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 deleted file mode 100644 index b2bf1ebe97..0000000000 --- a/tests/regression/18-file/03-if-close.c +++ /dev/null @@ -1,15 +0,0 @@ -// 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 deleted file mode 100644 index 70683f3852..0000000000 --- a/tests/regression/18-file/04-no-open.c +++ /dev/null @@ -1,10 +0,0 @@ -// 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 deleted file mode 100644 index 77326d7a70..0000000000 --- a/tests/regression/18-file/05-open-mode.c +++ /dev/null @@ -1,11 +0,0 @@ -// 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 deleted file mode 100644 index 2826c2f1dc..0000000000 --- a/tests/regression/18-file/06-2open.c +++ /dev/null @@ -1,12 +0,0 @@ -// 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 deleted file mode 100644 index 0545bf9814..0000000000 --- a/tests/regression/18-file/07-2close.c +++ /dev/null @@ -1,11 +0,0 @@ -// 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 deleted file mode 100644 index 1caa238517..0000000000 --- a/tests/regression/18-file/08-var-reuse.c +++ /dev/null @@ -1,15 +0,0 @@ -// 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 deleted file mode 100644 index e9563ef195..0000000000 --- a/tests/regression/18-file/09-inf-loop-no-close.c +++ /dev/null @@ -1,17 +0,0 @@ -// 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 deleted file mode 100644 index d88fde272e..0000000000 --- a/tests/regression/18-file/10-inf-loop-ok.c +++ /dev/null @@ -1,19 +0,0 @@ -// 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 deleted file mode 100644 index e24fec6e46..0000000000 --- a/tests/regression/18-file/11-2if.c +++ /dev/null @@ -1,18 +0,0 @@ -// 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 deleted file mode 100644 index 4934b33114..0000000000 --- a/tests/regression/18-file/12-2close-if.c +++ /dev/null @@ -1,15 +0,0 @@ -// 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 deleted file mode 100644 index f707110957..0000000000 --- a/tests/regression/18-file/13-ptr-arith-ok.c +++ /dev/null @@ -1,16 +0,0 @@ -// 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 deleted file mode 100644 index 3f9cd21ee2..0000000000 --- a/tests/regression/18-file/14-ptr-arith-close.c +++ /dev/null @@ -1,13 +0,0 @@ -// 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 deleted file mode 100644 index d7f74b85db..0000000000 --- a/tests/regression/18-file/15-var-switch.c +++ /dev/null @@ -1,18 +0,0 @@ -// 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 deleted file mode 100644 index cb1fb5fd22..0000000000 --- a/tests/regression/18-file/16-var-reuse-close.c +++ /dev/null @@ -1,14 +0,0 @@ -// 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 deleted file mode 100644 index 3e005c6e70..0000000000 --- a/tests/regression/18-file/17-myfopen.c +++ /dev/null @@ -1,21 +0,0 @@ -// 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 deleted file mode 100644 index 5d98db4c53..0000000000 --- a/tests/regression/18-file/18-myfopen-arg.c +++ /dev/null @@ -1,20 +0,0 @@ -// 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 deleted file mode 100644 index 049e8454b4..0000000000 --- a/tests/regression/18-file/19-if-close-else.c +++ /dev/null @@ -1,17 +0,0 @@ -// 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 deleted file mode 100644 index 981248c152..0000000000 --- a/tests/regression/18-file/20-loop-close.c +++ /dev/null @@ -1,18 +0,0 @@ -// 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 deleted file mode 100644 index e41bb9b005..0000000000 --- a/tests/regression/18-file/21-for-i.c +++ /dev/null @@ -1,26 +0,0 @@ -// 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 deleted file mode 100644 index f0376fc5a9..0000000000 --- a/tests/regression/18-file/22-f_int.c +++ /dev/null @@ -1,13 +0,0 @@ -// 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 deleted file mode 100644 index 81224d2e72..0000000000 --- a/tests/regression/18-file/23-f_str.c +++ /dev/null @@ -1,13 +0,0 @@ -// 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 deleted file mode 100644 index 2379c1f718..0000000000 --- a/tests/regression/18-file/24-f_wstr.c +++ /dev/null @@ -1,14 +0,0 @@ -// 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 deleted file mode 100644 index 00ba189b8d..0000000000 --- a/tests/regression/18-file/25-mem-ok.c +++ /dev/null @@ -1,29 +0,0 @@ -// 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 deleted file mode 100644 index 5cf3aaf7bb..0000000000 --- a/tests/regression/18-file/26-open-error-ok.c +++ /dev/null @@ -1,15 +0,0 @@ -// 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 deleted file mode 100644 index bd3048208f..0000000000 --- a/tests/regression/18-file/27-open-error.c +++ /dev/null @@ -1,13 +0,0 @@ -// 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 deleted file mode 100644 index 04fa5abab0..0000000000 --- a/tests/regression/18-file/28-multiple-exits.c +++ /dev/null @@ -1,14 +0,0 @@ -// 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 deleted file mode 100644 index 17b94748c0..0000000000 --- a/tests/regression/18-file/29-alias-global.c +++ /dev/null @@ -1,22 +0,0 @@ -// 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 deleted file mode 100644 index 5a8d1f97a9..0000000000 --- a/tests/regression/18-file/30-ptr-of-ptr.c +++ /dev/null @@ -1,14 +0,0 @@ -// 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 deleted file mode 100644 index 9c0ccb16a2..0000000000 --- a/tests/regression/18-file/31-var-reuse-fun.c +++ /dev/null @@ -1,16 +0,0 @@ -// 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 deleted file mode 100644 index e252d563a5..0000000000 --- a/tests/regression/18-file/32-multi-ptr-close.c +++ /dev/null @@ -1,25 +0,0 @@ -// 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 deleted file mode 100644 index b3cfa0ade4..0000000000 --- a/tests/regression/18-file/33-multi-ptr-open.c +++ /dev/null @@ -1,23 +0,0 @@ -// 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 deleted file mode 100644 index 0ebb9ddd30..0000000000 --- a/tests/regression/18-file/34-multi-alias-close.c +++ /dev/null @@ -1,25 +0,0 @@ -// 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 deleted file mode 100644 index 21a4a9cca6..0000000000 --- a/tests/regression/18-file/35-multi-alias-open.c +++ /dev/null @@ -1,23 +0,0 @@ -// 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 deleted file mode 100644 index 4f70bf7382..0000000000 --- a/tests/regression/18-file/36-fun-ptr.c +++ /dev/null @@ -1,14 +0,0 @@ -// 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 deleted file mode 100644 index 5dfde5a2d9..0000000000 --- a/tests/regression/18-file/37-var-switch-alias.c +++ /dev/null @@ -1,18 +0,0 @@ -// 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 new file mode 100644 index 0000000000..0e93e175c6 --- /dev/null +++ b/tests/regression/18-file/README.md @@ -0,0 +1,2 @@ +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 deleted file mode 100644 index fc2ebe1699..0000000000 --- a/tests/regression/18-file/file.c +++ /dev/null @@ -1,44 +0,0 @@ -#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 deleted file mode 100644 index d42e2217b7..0000000000 --- a/tests/regression/18-file/file.optimistic.spec +++ /dev/null @@ -1,34 +0,0 @@ -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 deleted file mode 100644 index aeb747abfd..0000000000 --- a/tests/regression/18-file/file.spec +++ /dev/null @@ -1,57 +0,0 @@ -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 deleted file mode 100644 index 43ee527dba..0000000000 --- a/tests/regression/19-spec/01-malloc-free.c +++ /dev/null @@ -1,19 +0,0 @@ -#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 deleted file mode 100644 index 82c1642a93..0000000000 --- a/tests/regression/19-spec/02-mutex_rc.c +++ /dev/null @@ -1,23 +0,0 @@ -#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 new file mode 100644 index 0000000000..d7e3ae3c8e --- /dev/null +++ b/tests/regression/19-spec/README.md @@ -0,0 +1,2 @@ +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 deleted file mode 100644 index 860c573814..0000000000 --- a/tests/regression/19-spec/malloc.optimistic.spec +++ /dev/null @@ -1,23 +0,0 @@ -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 deleted file mode 100644 index 9f09430051..0000000000 --- a/tests/regression/19-spec/malloc.spec +++ /dev/null @@ -1,26 +0,0 @@ -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 deleted file mode 100644 index 1ec8264078..0000000000 --- a/tests/regression/19-spec/mutex-lock.spec +++ /dev/null @@ -1,31 +0,0 @@ -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 From 9e0ef1cc2f5c0c553e92355907ea55b813f61d31 Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Fri, 1 Dec 2023 21:06:25 +0100 Subject: [PATCH 2/4] Rm: Mainspec --- scripts/goblint-lib-modules.py | 1 - src/dune | 8 ++++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/scripts/goblint-lib-modules.py b/scripts/goblint-lib-modules.py index 6369af53a1..6c264a117b 100755 --- a/scripts/goblint-lib-modules.py +++ b/scripts/goblint-lib-modules.py @@ -30,7 +30,6 @@ "MessagesCompare", "PrivPrecCompare", "ApronPrecCompare", - "Mainspec", # libraries "Goblint_std", diff --git a/src/dune b/src/dune index acd5348acb..d3fe6bdd0d 100644 --- a/src/dune +++ b/src/dune @@ -6,7 +6,7 @@ (library (name goblint_lib) (public_name goblint.lib) - (modules :standard \ goblint mainspec privPrecCompare apronPrecCompare messagesCompare) + (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_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. @@ -73,10 +73,10 @@ (copy_files# witness/z3/*.ml) (executables - (names goblint mainspec) - (public_names goblint -) + (names goblint) + (public_names goblint) (modes byte native) ; https://dune.readthedocs.io/en/stable/dune-files.html#linking-modes - (modules goblint mainspec) + (modules goblint) (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) From 9891391807d9bf9a4ac6e5efe1f49b843ace9dbf Mon Sep 17 00:00:00 2001 From: Michael Schwarz Date: Mon, 4 Dec 2023 11:17:42 +0100 Subject: [PATCH 3/4] Rm further spurious domains --- src/cdomains/fileDomain.ml | 81 --------- src/cdomains/mvalMapDomain.ml | 299 ---------------------------------- src/cdomains/specDomain.ml | 34 ---- src/goblint_lib.ml | 4 - 4 files changed, 418 deletions(-) delete mode 100644 src/cdomains/fileDomain.ml delete mode 100644 src/cdomains/mvalMapDomain.ml delete mode 100644 src/cdomains/specDomain.ml diff --git a/src/cdomains/fileDomain.ml b/src/cdomains/fileDomain.ml deleted file mode 100644 index ca585b8bce..0000000000 --- a/src/cdomains/fileDomain.ml +++ /dev/null @@ -1,81 +0,0 @@ -(** 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/cdomains/mvalMapDomain.ml b/src/cdomains/mvalMapDomain.ml deleted file mode 100644 index d0d2f8da85..0000000000 --- a/src/cdomains/mvalMapDomain.ml +++ /dev/null @@ -1,299 +0,0 @@ -(** 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/cdomains/specDomain.ml b/src/cdomains/specDomain.ml deleted file mode 100644 index 75a9d8edc5..0000000000 --- a/src/cdomains/specDomain.ml +++ /dev/null @@ -1,34 +0,0 @@ -(** 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/goblint_lib.ml b/src/goblint_lib.ml index d4f2982902..8d319dd4a1 100644 --- a/src/goblint_lib.ml +++ b/src/goblint_lib.ml @@ -261,12 +261,8 @@ 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. *) From dff61c929f444a46dd40d327562115e433272554 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 5 Dec 2023 16:19:50 +0200 Subject: [PATCH 4/4] Remove two ignores of spec analysis --- .gitignore | 1 - scripts/regression2sv-benchmarks.py | 1 - 2 files changed, 2 deletions(-) diff --git a/.gitignore b/.gitignore index 75bd23d36b..faf1513653 100644 --- a/.gitignore +++ b/.gitignore @@ -29,7 +29,6 @@ linux-headers .goblint*/ goblint_temp_*/ -src/spec/graph .vagrant g2html.jar diff --git a/scripts/regression2sv-benchmarks.py b/scripts/regression2sv-benchmarks.py index 8f74a70f52..7bcc1c7ea3 100755 --- a/scripts/regression2sv-benchmarks.py +++ b/scripts/regression2sv-benchmarks.py @@ -31,7 +31,6 @@ "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