You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
82 lines
2.6 KiB
82 lines
2.6 KiB
3 years ago
|
(*
|
||
|
* Copyright (c) Facebook, Inc. and its affiliates.
|
||
|
*
|
||
|
* This source code is licensed under the MIT license found in the
|
||
|
* LICENSE file in the root directory of this source tree.
|
||
|
*)
|
||
|
|
||
|
exception PointerMismatch
|
||
|
|
||
|
let validate_ptr key_ptr node =
|
||
|
let node_ptr = Clang_ast_main.get_ptr_from_node node in
|
||
|
if node_ptr != key_ptr then raise PointerMismatch
|
||
|
|
||
|
|
||
|
let validate_decl_ptr key_ptr decl = validate_ptr key_ptr (`DeclNode decl)
|
||
|
|
||
|
let validate_stmt_ptr key_ptr stmt = validate_ptr key_ptr (`StmtNode stmt)
|
||
|
|
||
|
let validate_type_ptr key_ptr c_type = validate_ptr key_ptr (`TypeNode c_type)
|
||
|
|
||
|
let print_node path kind_str =
|
||
|
let indent = String.make (List.length path) ' ' in
|
||
|
prerr_string indent ;
|
||
|
prerr_string kind_str ;
|
||
|
prerr_newline ()
|
||
|
|
||
|
|
||
|
let sloc_to_str sloc =
|
||
|
let opt_to_str to_str_f v = match v with Some x -> to_str_f x | None -> "None" in
|
||
|
let file_str = opt_to_str (fun f -> f) sloc.Clang_ast_t.sl_file in
|
||
|
let line_str = opt_to_str string_of_int sloc.Clang_ast_t.sl_line in
|
||
|
let column_str = opt_to_str string_of_int sloc.Clang_ast_t.sl_column in
|
||
|
file_str ^ ":" ^ line_str ^ ":" ^ column_str
|
||
|
|
||
|
|
||
|
let src_range_to_str range =
|
||
|
let first, last = range in
|
||
|
sloc_to_str first ^ " " ^ sloc_to_str last
|
||
|
|
||
|
|
||
|
let print_decl path decl =
|
||
|
let kind_str = Clang_ast_proj.get_decl_kind_string decl in
|
||
|
let decl_info = Clang_ast_proj.get_decl_tuple decl in
|
||
|
let src_str = src_range_to_str decl_info.Clang_ast_t.di_source_range in
|
||
|
print_node path (kind_str ^ " " ^ src_str)
|
||
|
|
||
|
|
||
|
let print_stmt path stmt = print_node path (Clang_ast_proj.get_stmt_kind_string stmt)
|
||
|
|
||
|
let print_map_size map =
|
||
|
let s = Clang_ast_main.PointerMap.cardinal map in
|
||
|
prerr_string (string_of_int s ^ " ")
|
||
|
|
||
|
|
||
|
let check_decl_cache_from_file fname =
|
||
|
let ast = Atdgen_runtime.Util.Json.from_file Clang_ast_j.read_decl fname in
|
||
|
let decl_cache, stmt_cache, type_cache, _ = Clang_ast_main.index_node_pointers ast in
|
||
|
print_map_size decl_cache ;
|
||
|
print_map_size stmt_cache ;
|
||
|
print_map_size type_cache ;
|
||
|
prerr_newline () ;
|
||
|
Clang_ast_main.PointerMap.iter validate_decl_ptr decl_cache ;
|
||
|
Clang_ast_main.PointerMap.iter validate_stmt_ptr stmt_cache ;
|
||
|
Clang_ast_main.PointerMap.iter validate_type_ptr type_cache ;
|
||
|
Clang_ast_main.visit_ast ~visit_decl:print_decl ~visit_stmt:print_stmt ast
|
||
|
|
||
|
|
||
|
let main =
|
||
|
let v = Sys.argv in
|
||
|
try
|
||
|
for i = 1 to Array.length v - 1 do
|
||
|
check_decl_cache_from_file v.(i)
|
||
|
done
|
||
|
with
|
||
|
| PointerMismatch ->
|
||
|
prerr_string "Pointer in cache doesn't match" ;
|
||
|
exit 1
|
||
|
| Yojson.Json_error s | Atdgen_runtime.Oj_run.Error s ->
|
||
|
prerr_string s ;
|
||
|
prerr_newline () ;
|
||
|
exit 1
|