adding missing functionality to analyzerTester

Reviewed By: jberdine

Differential Revision: D3723164

fbshipit-source-id: e9c272b
master
Sam Blackshear 8 years ago committed by Facebook Github Bot 7
parent e853b01051
commit 90c8f55c32

@ -94,11 +94,23 @@ module StructuredSil = struct
let call_exp = Exp.Const (Const.Cfun procname) in let call_exp = Exp.Const (Const.Cfun procname) in
Cmd (Sil.Call (ret_ids, call_exp, args, dummy_loc, CallFlags.default)) Cmd (Sil.Call (ret_ids, call_exp, args, dummy_loc, CallFlags.default))
let id_assign_id ?(rhs_typ=dummy_typ) lhs rhs = let make_store ~rhs_typ root_exp fld_str ~rhs_exp =
let fld = AccessPathTestUtils.make_fieldname fld_str in
let lhs_exp = Exp.Lfield (root_exp, fld, rhs_typ) in
make_set ~rhs_typ ~lhs_exp ~rhs_exp
let make_load ~rhs_typ lhs_str fld_str root_exp =
let fld = AccessPathTestUtils.make_fieldname fld_str in
let rhs_exp = Exp.Lfield (root_exp, fld, rhs_typ) in
make_letderef ~rhs_typ (ident_of_str lhs_str) rhs_exp
let id_assign_exp ?(rhs_typ=dummy_typ) lhs rhs_exp =
let lhs_id = ident_of_str lhs in let lhs_id = ident_of_str lhs in
let rhs_exp = Exp.Var (ident_of_str rhs) in
make_letderef ~rhs_typ lhs_id rhs_exp make_letderef ~rhs_typ lhs_id rhs_exp
let id_assign_id ?(rhs_typ=dummy_typ) lhs rhs =
id_assign_exp ~rhs_typ lhs (Exp.Var (ident_of_str rhs))
let id_assign_var ?(rhs_typ=dummy_typ) lhs rhs = let id_assign_var ?(rhs_typ=dummy_typ) lhs rhs =
let lhs_id = ident_of_str lhs in let lhs_id = ident_of_str lhs in
let rhs_exp = var_of_str rhs in let rhs_exp = var_of_str rhs in
@ -227,7 +239,8 @@ module Make
Cfg.Procdesc.set_exit_node pdesc exit_node; Cfg.Procdesc.set_exit_node pdesc exit_node;
pdesc, assert_map pdesc, assert_map
let create_test test_program extras test_pname _ = let create_test test_program extras pp_opt test_pname _ =
let pp_state = Option.default I.A.pp pp_opt in
let pdesc, assert_map = structured_program_to_cfg test_program test_pname in let pdesc, assert_map = structured_program_to_cfg test_program test_pname in
let inv_map = I.exec_pdesc (ProcData.make pdesc (Tenv.create ()) extras) in let inv_map = I.exec_pdesc (ProcData.make pdesc (Tenv.create ()) extras) in
@ -235,7 +248,7 @@ module Make
let post_str = let post_str =
try try
let state = M.find node_id inv_map in let state = M.find node_id inv_map in
pp_to_string I.A.pp state.post pp_to_string pp_state state.post
with Not_found -> "_|_" in with Not_found -> "_|_" in
if inv_str <> post_str then if inv_str <> post_str then
let error_msg = let error_msg =
@ -260,8 +273,9 @@ module Make
|> F.flush_str_formatter in |> F.flush_str_formatter in
OUnit2.assert_failure assert_fail_message OUnit2.assert_failure assert_fail_message
let create_tests ?(test_pname=Procname.empty_block) extras tests = let create_tests ?(test_pname=Procname.empty_block) ?pp_opt extras tests =
let open OUnit2 in let open OUnit2 in
IList.map (fun (name, test_program) -> name>::create_test test_program extras test_pname) tests IList.map (fun (name, test_program) ->
name>::create_test test_program extras pp_opt test_pname) tests
end end

Loading…
Cancel
Save