1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
|
(*
* This file is part of Coccinelle, licensed under the terms of the GPL v2.
* See copyright.txt in the Coccinelle source code for more information.
* The Coccinelle source code can be obtained at http://coccinelle.lip6.fr
*)
let include_headers_for_types = ref false
let is_header filename =
Filename.check_suffix filename ".h" ||
Filename.check_suffix filename ".h.res" (* for okfailed testing *)
type parsing_style =
| Parse_no_includes
| Parse_local_includes
| Parse_all_includes
| Parse_really_all_includes
let string_of_parsing_style = function
| Parse_no_includes -> "Parse_no_includes"
| Parse_local_includes -> "Parse_local_includes"
| Parse_all_includes -> "Parse_all_includes"
| Parse_really_all_includes -> "Parse_really_all_includes"
let _parsing_style_set = ref false
let _parsing_style = ref Parse_local_includes
let get_parsing_style () = !_parsing_style
let set_parsing_style ps =
_parsing_style := ps;
_parsing_style_set := true
let is_parsing_style_set () = !_parsing_style_set
let parse_all_includes parsing_style =
(parsing_style = Parse_all_includes) ||
(parsing_style = Parse_really_all_includes)
let include_path = ref ([] : string list)
let relax_include_path = ref false
let for_tests = ref false
(* if true then when have a #include "../../xx.h", we look also for xx.h in
* current directory. This is because of how works extract_c_and_res
*)
let extra_includes = ref ([] : string list)
(* finding among the #include the one that we need to parse
* because they may contain useful type definition or because
* we may have to modify them
*
* For the moment we base in part our heuristic on the name of the file, e.g.
* serio.c is related we think to #include <linux/serio.h>
*)
let unique_file_table = ref []
let include_table = Common.create_bounded_cache 500 (([],[]),None)
let interpret_include_path relpath =
let unique_file_exists dir f =
try
let info = List.assoc dir !unique_file_table in
try Some (Hashtbl.find info f)
with Not_found -> None
with Not_found -> None in
let rec native_file_exists dir f =
let f = Filename.concat dir f in
if Sys.file_exists f
then Some f
else None in
let rec search_include_path exists searchlist relpath =
match searchlist with
[] -> None
| hd::tail ->
(match exists hd relpath with
Some x -> Some x
| None -> search_include_path exists tail relpath) in
let rec search_path exists searchlist = function
[] -> None
| (hd::tail) as relpath1 ->
let relpath1 = String.concat "/" relpath1 in
(match search_include_path exists searchlist relpath1 with
None -> search_path exists searchlist tail
| (Some _) as res -> res) in
let searchlist =
match !include_path with
[] ->
(try if Sys.is_directory "include" then ["include"] else []
with Sys_error _ -> [])
| x -> List.rev x in
try Common.find_bounded_cache include_table (searchlist,relpath)
with Not_found ->
(match search_path native_file_exists searchlist relpath with
None ->
let res = search_path unique_file_exists searchlist relpath in
Common.extend_bounded_cache include_table (searchlist,relpath) res;
(if res = None && !Flag_parsing_c.verbose_includes
then
Common.pr2
(Printf.sprintf "failed on %s" (String.concat "/" relpath)));
res
| (Some _) as res ->
Common.extend_bounded_cache include_table (searchlist,relpath) res;
res)
let should_parse parsing_style filename incl = match parsing_style with
| Parse_no_includes -> false
| Parse_local_includes when is_header filename -> false
| Parse_local_includes ->
(match incl with
| Ast_c.Local _ -> true
| Ast_c.Weird _ -> false
| Ast_c.NonLocal _ -> false
)
| Parse_all_includes -> not (is_header filename)
| Parse_really_all_includes -> true
let resolve filename parsingstyle x =
let all_includes = parse_all_includes parsingstyle in
let dir = Filename.dirname filename in
match x with
| Ast_c.Local include_path ->
let relpath = String.concat "/" include_path in
let f = Filename.concat dir relpath in
if (Sys.file_exists f)
then Some f
else if !relax_include_path
(* for our tests, all the files are flat in the current dir *)
then
let attempt2 = Filename.concat dir (Common.last include_path) in
if all_includes && not (Sys.file_exists attempt2)
then interpret_include_path include_path
else Some attempt2
else if !for_tests
then interpret_include_path [Common.last include_path]
else if all_includes
then interpret_include_path include_path
else None
| Ast_c.NonLocal include_path ->
if all_includes ||
Common.fileprefix (Common.last include_path) =
Common.fileprefix filename
then interpret_include_path include_path
else None
| Ast_c.Weird _ -> None
(* ------------------------------------------------------------------------ *)
let setup_unique_search cores searchlist =
let searchlist = List.filter (function f -> Sys.file_exists f) searchlist in
let cores =
match cores with
None -> 1
| Some x -> x in
let looper f l =
if cores > 1
then Parmap.parmap ~ncores:cores f (Parmap.L l)
else List.map f l in
let process dir =
let lines =
let cmd = Printf.sprintf "find %s -name \"*h\"" dir in
Common.cmd_to_list cmd in
let lines =
List.fold_left
(fun prev cur ->
let last = Filename.basename cur in
let two_last =
Filename.concat (Filename.basename (Filename.dirname cur)) last in
(last,cur) :: (two_last,cur) :: prev)
[] lines in
let lines = List.sort compare lines in
let rec loop good bad = function
[] -> good
| [(x,xp)] ->
if List.mem x bad
then good
else ((x,xp)::good)
| (x,xp)::(((y,yp)::rest) as arest) ->
if List.mem x bad
then loop good bad arest
else if x = y
then loop good (x::bad) rest
else loop ((x,xp)::good) bad arest in
(dir,loop [] [] lines) in
let res = looper process searchlist in
unique_file_table :=
List.map
(function (dir,lst) ->
let tbl = Hashtbl.create 101 in
List.iter (function (fl,src) -> Hashtbl.add tbl fl src) lst;
(dir,tbl))
res
|