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

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