File: includes.ml

package info (click to toggle)
coccinelle 1.0.8.deb-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 26,148 kB
  • sloc: ml: 136,392; ansic: 23,594; sh: 2,189; makefile: 2,157; perl: 1,576; lisp: 840; python: 823; awk: 70; csh: 12
file content (194 lines) | stat: -rw-r--r-- 6,274 bytes parent folder | download
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