Skip to content

Commit 98d0ac8

Browse files
sipmasipma
committed
CHC: add error handling to CIL parsing
1 parent b8441cd commit 98d0ac8

File tree

10 files changed

+176
-60
lines changed

10 files changed

+176
-60
lines changed

‎CodeHawk/CHC/cchcil/Makefile‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ cchcil.cmxa: $(CMIS) $(OBJECTS) $(CHLIB)/chlib.cmxa $(CIL)/goblintCil.cmxa $(EXT
6060

6161

6262
cmi/%.cmi: %.mli make_dirs
63-
$(CAMLC) -o $@ -c $<
63+
$(CAMLC) -o $@ -c -opaque $<
6464

6565
cmx/%.cmx: %.ml make_dirs
6666
$(CAMLC) -o $@ -c $<

‎CodeHawk/CHC/cchcil/cCHXParseFile.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -255,6 +255,7 @@ let main () =
255255
try
256256
let _ = read_args () in
257257
let _ = set_log_level "DEBUG" in
258+
let _ = cildeclarations#set_filename !filename in
258259
let cilfile = Frontc.parse !filename () in
259260
let _ = log_info "Parsed %s [%s:%d]" !filename __FILE__ __LINE__ in
260261
save_xml_file cilfile

‎CodeHawk/CHC/cchcil/cHCilDeclarations.ml‎

Lines changed: 96 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -30,9 +30,14 @@
3030
(* cil *)
3131
open GoblintCil
3232

33+
(* chlib *)
34+
open CHCommon
35+
3336
(* chutil *)
3437
open CHIndexTable
3538
open CHStringIndexTable
39+
open CHTimingLog
40+
open CHTraceResult
3641
open CHXmlDocument
3742

3843
(* chcil *)
@@ -60,6 +65,7 @@ object (self)
6065
val location_table = mk_index_table "location-table"
6166
val string_table = mk_string_index_table "filename-table"
6267
val mutable tables = []
68+
val mutable cfilename = ""
6369

6470
initializer
6571
tables <- [
@@ -74,6 +80,8 @@ object (self)
7480
enuminfo_table
7581
]
7682

83+
method set_filename s = cfilename <- s
84+
7785
method index_init_opt (iinfo: init option) =
7886
match iinfo with
7987
| None -> (-1)
@@ -100,26 +108,60 @@ object (self)
100108
| Some i -> [self#index_init i]
101109
| _ -> [] in
102110
let tags = [vinfo.vname; storage_mfts#ts vinfo.vstorage] in
103-
let args =
104-
[vinfo.vid;
105-
cd#index_typ vinfo.vtype;
106-
cd#index_attributes vinfo.vattr;
107-
ibool vinfo.vglob;
108-
ibool vinfo.vinline;
109-
self#index_location vinfo.vdecl;
110-
ibool vinfo.vaddrof;
111-
0] @ vinit_ix in
112-
varinfo_table#add (tags,args)
111+
let locix_r = self#index_location vinfo.vdecl in
112+
match locix_r with
113+
| Ok locix ->
114+
let args =
115+
[vinfo.vid;
116+
cd#index_typ vinfo.vtype;
117+
cd#index_attributes vinfo.vattr;
118+
ibool vinfo.vglob;
119+
ibool vinfo.vinline;
120+
locix;
121+
ibool vinfo.vaddrof;
122+
0] @ vinit_ix in
123+
varinfo_table#add (tags,args)
124+
| Error e ->
125+
begin
126+
log_error
127+
"index_varinfo: %s; %s"
128+
vinfo.vname
129+
(String.concat ", " e);
130+
raise
131+
(CHFailure
132+
(LBLOCK [
133+
STR "index_varinfo: ";
134+
STR vinfo.vname;
135+
STR "; ";
136+
STR (String.concat ", " e)]))
137+
end
113138

114139
method index_fieldinfo (finfo: fieldinfo) =
115140
let tags = [finfo.fname] in
116-
let args =
117-
[finfo.fcomp.ckey;
118-
cd#index_typ finfo.ftype;
119-
(match finfo.fbitfield with Some b -> b | _ -> -1);
120-
cd#index_attributes finfo.fattr;
121-
self#index_location finfo.floc] in
122-
fieldinfo_table#add (tags, args)
141+
let locix_r = self#index_location finfo.floc in
142+
match locix_r with
143+
| Ok locix ->
144+
let args =
145+
[finfo.fcomp.ckey;
146+
cd#index_typ finfo.ftype;
147+
(match finfo.fbitfield with Some b -> b | _ -> -1);
148+
cd#index_attributes finfo.fattr;
149+
locix
150+
] in
151+
fieldinfo_table#add (tags, args)
152+
| Error e ->
153+
begin
154+
log_error
155+
"index fieldinfo: %s %s"
156+
finfo.fname
157+
(String.concat ", " e);
158+
raise
159+
(CHFailure
160+
(LBLOCK [
161+
STR "index fieldinfo: ";
162+
STR finfo.fname;
163+
STR (String.concat ", " e)]))
164+
end
123165

124166
method index_compinfo (cinfo: compinfo) =
125167
let tags = [cinfo.cname] in
@@ -131,10 +173,26 @@ object (self)
131173
compinfo_table#add (tags, args)
132174

133175
method index_enumitem (eitem: enumitem) =
134-
let (name,exp,loc) = eitem in
176+
let (name, exp, loc) = eitem in
135177
let tags = [name] in
136-
let args = [cd#index_exp exp; self#index_location loc] in
137-
enumitem_table#add (tags, args)
178+
let locix_r = self#index_location loc in
179+
match locix_r with
180+
| Ok locix ->
181+
let args = [cd#index_exp exp; locix] in
182+
enumitem_table#add (tags, args)
183+
| Error e ->
184+
begin
185+
log_error
186+
"index enumitem: %s %s"
187+
name
188+
(String.concat ", " e);
189+
raise
190+
(CHFailure
191+
(LBLOCK [
192+
STR "index enumitem: ";
193+
STR name;
194+
STR (String.concat ", " e)]))
195+
end
138196

139197
method index_enuminfo (einfo: enuminfo) =
140198
let tags = [einfo.ename; ikind_mfts#ts einfo.ekind] in
@@ -148,16 +206,20 @@ object (self)
148206
let args = [cd#index_typ tinfo.ttype] in
149207
typeinfo_table#add (tags,args)
150208

151-
method index_location (loc: location) =
209+
method index_location (loc: location): int traceresult =
152210
if loc.byte = -1 && loc.line = -1 then
153-
(-1)
211+
Ok (-1)
154212
else
155-
let filename =
156-
get_location_filename !CHCilFileUtil.project_path_prefix "" loc.file in
157-
let args = [self#index_filename filename; loc.byte; loc.line] in
158-
location_table#add ([],args)
213+
let filename_r =
214+
get_location_filename
215+
!CHCilFileUtil.project_path_prefix cfilename loc.file in
216+
tmap
217+
(fun filename ->
218+
let args = [self#index_filename filename; loc.byte; loc.line] in
219+
location_table#add ([], args))
220+
filename_r
159221

160-
method index_filename (f:string) = string_table#add f
222+
method index_filename (f: string) = string_table#add f
161223

162224
method write_xml_varinfo
163225
?(tag="ivinfo") (node: xml_element_int) (vinfo: varinfo) =
@@ -188,7 +250,13 @@ object (self)
188250

189251
method write_xml_location
190252
?(tag="iloc") (node: xml_element_int) (loc: location) =
191-
node#setIntAttribute tag (self#index_location loc)
253+
let locix_r = self#index_location loc in
254+
match locix_r with
255+
| Ok locix -> node#setIntAttribute tag locix
256+
| Error e ->
257+
raise
258+
(CHFailure
259+
(LBLOCK [STR "write_xml_location: "; STR (String.concat ", " e)]))
192260

193261
method write_xml (node: xml_element_int) =
194262
let snode = xmlElement string_table#get_name in

‎CodeHawk/CHC/cchcil/cHCilFileUtil.ml‎

Lines changed: 33 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -29,39 +29,57 @@
2929

3030
(* chutil *)
3131
open CHFileIO
32+
open CHTraceResult
3233

3334

3435
let project_path_prefix = ref ""
3536

3637

3738
(* the location filename is either a filename with an absolute path or a
3839
a filename with a path relative to the project path (project_path_prefix) *)
39-
let get_location_filename project_path_prefix locpath locfile =
40-
let has_project_path_prefix name =
40+
let get_location_filename
41+
(project_path_prefix: string)
42+
(locpath: string)
43+
(locfile: string): string traceresult =
44+
45+
let msg_names () =
46+
"(get_location_filename: "
47+
^ project_path_prefix ^ ", " ^ locpath ^ ", " ^ locfile ^ ")" in
48+
49+
let has_project_path_prefix (name: string): bool =
4150
let pre_len = String.length project_path_prefix in
4251
if String.length name > pre_len then
4352
let fsub = String.sub name 0 pre_len in
4453
fsub = project_path_prefix
4554
else
4655
false in
47-
let add_preprocessor_path path name =
48-
let path_len = String.length path in
49-
if path_len > 2 then
50-
(String.sub path 0 (path_len - 1)) ^ name
56+
57+
let substitute_prefix (name: string): string =
58+
let pre_len = (String.length project_path_prefix) + 1 in
59+
if (String.length name) > pre_len then
60+
String.sub name pre_len ((String.length name) - pre_len)
5161
else
5262
name in
53-
let substitute_prefix name =
54-
let pre_len = (String.length project_path_prefix) + 1 in
55-
String.sub name pre_len ((String.length name) - pre_len) in
56-
let get_filename path file =
57-
if path = "" then file else
63+
64+
let get_filename (path: string) (file: string): string traceresult =
65+
if path = "" then
66+
Ok file
67+
else if (String.length file > 2) && (String.sub file 0 2) = "./" then
68+
let len = String.length file in
69+
Ok (Filename.concat path (String.sub file 2 (len - 2)))
70+
else
5871
let absoluteName =
5972
if Filename.is_relative file then
60-
add_preprocessor_path path file
73+
Filename.concat path file
6174
else
6275
file in
6376
if has_project_path_prefix absoluteName then
64-
normalize_path (substitute_prefix absoluteName)
77+
tprop
78+
(normalize_path (substitute_prefix absoluteName))
79+
(msg_names ())
6580
else
66-
normalize_path absoluteName in
67-
get_filename (normalize_path locpath) (normalize_path locfile)
81+
tprop
82+
(normalize_path absoluteName)
83+
(msg_names ()) in
84+
85+
get_filename (Filename.dirname locpath) locfile

‎CodeHawk/CHC/cchcil/cHCilFileUtil.mli‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -27,10 +27,12 @@
2727
SOFTWARE.
2828
============================================================================= *)
2929

30+
(* chutil *)
31+
open CHTraceResult
3032

3133
val project_path_prefix: string ref
3234

3335

3436
(** the location filename is either a filename with an absolute path or a
3537
a filename with a path relative to the project path (project_path_prefix) *)
36-
val get_location_filename: string -> string -> string -> string
38+
val get_location_filename: string -> string -> string -> string traceresult

‎CodeHawk/CHC/cchcil/cHCilFunDeclarations.ml‎

Lines changed: 31 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -30,8 +30,13 @@
3030
(* cil *)
3131
open GoblintCil
3232

33+
(* chlib *)
34+
open CHCommon
35+
open CHPretty
36+
3337
(* chutil *)
3438
open CHIndexTable
39+
open CHTimingLog
3540
open CHXmlDocument
3641

3742
(* chcil *)
@@ -55,16 +60,32 @@ object (self)
5560

5661
method private getrep (vinfo: varinfo) (formalseqnr: int) =
5762
let tags = [vinfo.vname; storage_mfts#ts vinfo.vstorage] in
58-
let args =
59-
[vinfo.vid;
60-
cd#index_typ vinfo.vtype;
61-
cd#index_attributes vinfo.vattr;
62-
ibool vinfo.vglob;
63-
ibool vinfo.vinline;
64-
cdecls#index_location vinfo.vdecl;
65-
ibool vinfo.vaddrof;
66-
formalseqnr] in
67-
(tags, args)
63+
let locix_r = cdecls#index_location vinfo.vdecl in
64+
match locix_r with
65+
| Ok locix ->
66+
let args =
67+
[vinfo.vid;
68+
cd#index_typ vinfo.vtype;
69+
cd#index_attributes vinfo.vattr;
70+
ibool vinfo.vglob;
71+
ibool vinfo.vinline;
72+
locix;
73+
ibool vinfo.vaddrof;
74+
formalseqnr] in
75+
(tags, args)
76+
| Error e ->
77+
begin
78+
log_error
79+
"cilfundeclarations.getrep: %s; %s"
80+
vinfo.vname
81+
(String.concat ", " e);
82+
raise
83+
(CHFailure
84+
(LBLOCK [
85+
STR "cilfundeclarations: getrep: ";
86+
STR vinfo.vname;
87+
STR (String.concat ", " e)]))
88+
end
6889

6990
method index_formal (vinfo: varinfo) (seqnr: int) =
7091
local_varinfo_table#add (self#getrep vinfo seqnr)

‎CodeHawk/CHC/cchcil/cHCilTypes.ml‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@
3131
open GoblintCil
3232

3333
(* chutil *)
34+
open CHTraceResult
3435
open CHXmlDocument
3536

3637
type funarg = string * typ * attributes
@@ -69,6 +70,8 @@ class type cildictionary_int =
6970
class type cildeclarations_int =
7071
object
7172

73+
method set_filename: string -> unit
74+
7275
method index_typeinfo: typeinfo -> int
7376
method index_varinfo: varinfo -> int
7477
method index_init_opt: init option -> int
@@ -78,7 +81,7 @@ class type cildeclarations_int =
7881
method index_compinfo: compinfo -> int
7982
method index_enumitem: enumitem -> int
8083
method index_enuminfo: enuminfo -> int
81-
method index_location: location -> int
84+
method index_location: location -> int traceresult
8285
method index_filename: string -> int
8386

8487
method write_xml_typeinfo: ?tag:string -> xml_element_int -> typeinfo -> unit

‎CodeHawk/CHC/cchcil/cHCilTypes.mli‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@
3131
open GoblintCil
3232

3333
(* chutil *)
34+
open CHTraceResult
3435
open CHXmlDocument
3536

3637

@@ -79,6 +80,8 @@ class type cildictionary_int =
7980
class type cildeclarations_int =
8081
object
8182

83+
method set_filename: string -> unit
84+
8285
method index_typeinfo: typeinfo -> int
8386
method index_varinfo: varinfo -> int
8487
method index_init_opt: init option -> int
@@ -88,7 +91,7 @@ class type cildeclarations_int =
8891
method index_compinfo: compinfo -> int
8992
method index_enumitem: enumitem -> int
9093
method index_enuminfo: enuminfo -> int
91-
method index_location: location -> int
94+
method index_location: location -> int traceresult
9295
method index_filename: string -> int
9396

9497
method write_xml_typeinfo:

0 commit comments

Comments
 (0)