X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/feec80c30d140c69f5d894bd09b6071247d0fbaa..1b9ae60616d2f065ce16fe26385b684e13b40284:/main.ml diff --git a/main.ml b/main.ml index 129c390..e64fe96 100644 --- a/main.ml +++ b/main.ml @@ -51,7 +51,6 @@ let ignore_unknown_opt = ref false (* somehow obsolete now *) let dir = ref false -let include_headers = ref false let kbuild_info = ref "" let macro_file = ref "" @@ -282,6 +281,8 @@ let short_options = [ " suffix to use when making a backup for inplace"; "--out-place", Arg.Set outplace_modif, " store modifications in a .cocci_res file"; + "--reverse", Arg.Set Flag_parsing_cocci.interpret_inverted, + " invert the semantic patch before applying it"; "-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)), " set number of diff context lines"; @@ -309,12 +310,12 @@ let short_options = [ " causes local include files to be used"; "--ignore-unknown-options", Arg.Set ignore_unknown_opt, " For integration in a toolchain (must be set before the first unknown option)"; - "--include-headers", Arg.Set include_headers, + "--include-headers", Arg.Set Flag.include_headers, " process header files independently"; - "-I", Arg.String (fun x -> - FC.include_path:= x::!FC.include_path - ), - " containing the header files (optional)"; + "-I", Arg.String (fun x -> FC.include_path:= x::!FC.include_path), + " containing the header files"; + "--include", Arg.String (fun x -> FC.extra_includes:=x::!FC.extra_includes), + " file to consider as being included"; "--preprocess", Arg.Set preprocess, " run the C preprocessor before applying the semantic match"; @@ -565,8 +566,10 @@ let other_options = [ "--disable-multi-pass", Arg.Set Flag_parsing_c.disable_multi_pass, " "; - "--noif0-passing", Arg.Clear Flag_parsing_c.if0_passing, - " "; + "--noif0-passing", Arg.Clear Flag_parsing_c.if0_passing, " "; + "--defined", Arg.String (Flag_parsing_c.add Flag_parsing_c.defined), " "; + "--undefined", Arg.String + (Flag_parsing_c.add Flag_parsing_c.undefined), " "; "--noadd-typedef-root", Arg.Clear Flag_parsing_c.add_typedef_root, " "; (* could use Flag_parsing_c.options_algo instead *) @@ -611,6 +614,9 @@ let other_options = [ "--show-trace-profile", Arg.Set Common.show_trace_profile, " show trace"; "--save-tmp-files", Arg.Set Common.save_tmp_files, " "; + "--external-analysis-file", Arg.String + (Externalanalysis.load_external_results), + " import results from an external analysis"; ]; "concurrency", @@ -712,7 +718,7 @@ let rec arg_parse_no_fail l f msg = | Arg.Bad emsg -> arg_parse_no_fail l f msg | Arg.Help msg -> (* printf "%s" msg; exit 0; *) - raise Impossible (* -help is specified in speclist *) + raise (Impossible 165) (* -help is specified in speclist *) (* copy paste of Arg.parse. Don't want the default -help msg *) let arg_parse2 l f msg argv = @@ -731,7 +737,7 @@ let arg_parse2 l f msg argv = else arg_parse_no_fail l f msg; | Arg.Help msg -> (* printf "%s" msg; exit 0; *) - raise Impossible (* -help is specified in speclist *) + raise (Impossible 166) (* -help is specified in speclist *) ) @@ -777,7 +783,7 @@ let glimpse_filter (coccifile, isofile) dir = match query with None -> pr2 "no inferred glimpse keywords"; None | Some queries -> - let suffixes = if !include_headers then ["c";"h"] else ["c"] in + let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in let rec loop = function [] -> None (* error, eg due to pattern too big *) | query::queries -> @@ -801,7 +807,7 @@ let idutils_filter (coccifile, isofile) dir = match query with None -> pr2 "no inferred idutils keywords"; None | Some query -> - let suffixes = if !include_headers then ["c";"h"] else ["c"] in + let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in let files = Id_utils.interpret dir query in Printf.fprintf stderr "got files\n"; flush stderr; Some @@ -812,24 +818,6 @@ let idutils_filter (coccifile, isofile) dir = (* Main action *) (*****************************************************************************) -let get_files path = - let ch = - Common.cmd_to_list (* same as "true, "", _" case *) - (if !include_headers - (* FIXME : Could we remove xs ? - -use_glimpse requires a singleton. - This is checked some lines before. - then ("find "^(join " " (x::xs))^" -name \"*.[ch]\"") - else ("find "^(join " " (x::xs))^" -name \"*.c\"") - *) - then ("find "^ path ^" -name \"*.[ch]\"") - else ("find "^ path ^" -name \"*.c\"")) in - let cpp = - if !Flag.c_plus_plus - then Common.cmd_to_list ("find "^ path ^" -name \"*.cpp\"") - else [] in - cpp @ ch - let rec main_action xs = let (cocci_files,xs) = List.partition (function nm -> Filename.check_suffix nm ".cocci") xs in @@ -864,37 +852,37 @@ let rec main_action xs = let infiles = Common.profile_code "Main.infiles computation" (fun () -> - match !dir, !kbuild_info, !Flag.scanner with + match !dir, !kbuild_info, !Flag.scanner, xs with (* glimpse *) - | false, _, (Flag.Glimpse|Flag.IdUtils) -> [x::xs] - | true, s, (Flag.Glimpse|Flag.IdUtils) when s <> "" -> + | false, _, (Flag.Glimpse|Flag.IdUtils), _ -> [x::xs] + | true, s, (Flag.Glimpse|Flag.IdUtils), _ when s <> "" -> failwith - "-use_glimpse or -id_utils does not work with -kbuild" - | true, "", Flag.Glimpse -> - (if not (null xs) - then failwith "-use_glimpse can accept only one dir"); + "--use-glimpse or --id-utils does not work with --kbuild" + | true, "", Flag.Glimpse, [] -> + (*if not (null xs) + then failwith "--use-glimpse can accept only one dir"*) let files = match glimpse_filter (!cocci_file, !Config.std_iso) x with - None -> get_files x + None -> Test_parsing_c.get_files x | Some files -> files in files +> List.map (fun x -> [x]) - | true, "", Flag.IdUtils -> - (if not (null xs) - then failwith "-id_utils can accept only one dir"); + | true, "", Flag.IdUtils, [] -> + (*if not (null xs) + then failwith "--id-utils can accept only one dir"*) let files = match idutils_filter (!cocci_file, !Config.std_iso) x with - None -> get_files x + None -> Test_parsing_c.get_files x | Some files -> files in files +> List.map (fun x -> [x]) (* normal *) - | false, _, _ -> [x::xs] - | true, "", _ -> - get_files (join " " (x::xs)) +> List.map (fun x -> [x]) + | false, _, _, _ -> [x::xs] + | true, "", _, _ -> + Test_parsing_c.get_files (join " " (x::xs)) +> List.map (fun x -> [x]) (* kbuild *) - | true, kbuild_info_file,_ -> + | true, kbuild_info_file,_,_ -> let dirs = Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d") in @@ -1101,6 +1089,11 @@ let main () = end else true) !args; + (match (!Flag_parsing_c.cache_prefix,!distrib_index) with + (Some cp,Some n) -> + Flag_parsing_c.cache_prefix := + Some (Printf.sprintf "%s_%d" cp n) + | _ -> ()); (* julia hack so that one can override directories specified on * the command line. *) @@ -1166,7 +1159,8 @@ let main () = Testing.testone "" x !compare_with_expected end else - pr2 (spf "ERROR: File %s does not exist" testfile) + Printf.fprintf stderr + "ERROR: File %s does not exist\n" testfile end | [] when !test_all -> @@ -1232,12 +1226,11 @@ let main_with_better_error_report () = main () with | Unix.Unix_error (e, "stat", filename) -> - pr2 - (spf "ERROR: File %s does not exist: %s" - filename (Unix.error_message e)); + Printf.fprintf stderr "ERROR: File %s does not exist: %s\n" + filename (Unix.error_message e); raise (UnixExit (-1)) | Parse_cocci.Bad_virt s -> - Common.pr2 (Printf.sprintf "virtual rule %s not supported" s); + Printf.fprintf stderr "virtual rule %s not supported\n" s; raise (UnixExit (-1)) (*****************************************************************************)