dialyzer_analysis_callgraph.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 666 行 · 第 1/2 页

			       not dialyzer_plt:contains_mfa(InitPlt, To)
			   end, ExtCalls),
  {BadCalls1, RealExtCalls} =
    if ExtCalls1 =:= [] -> {[], []};
       true -> 
	Modules = 
	  case StartFrom of
	    byte_code -> 
	      [list_to_atom(filename:basename(F, ".beam")) || F <- Files];
	    src_code -> 
	      [list_to_atom(filename:basename(F, ".erl")) || F <- Files]
	  end,
	ModuleSet = sets:from_list(Modules),
	lists:partition(fun({_From, {M, _F, _A}}) -> 
			    sets:is_element(M, ModuleSet)
			end, ExtCalls1)
    end,
  NonLocalCalls = dialyzer_callgraph:non_local_calls(Callgraph1),
  BadCalls2 = lists:filter(fun({_From, To}) ->
			       not dialyzer_codeserver:is_exported(To, CServer)
			   end, NonLocalCalls),
  case BadCalls1 ++ BadCalls2 of
    [] -> ok;
    BadCalls -> send_bad_calls(Parent, BadCalls, AnalType, CodeServer)
  end,
  if RealExtCalls =:= [] -> ok;
     true ->
      send_ext_calls(Parent, lists:usort([To || {_From, To} <- RealExtCalls]))
  end,
  Callgraph1.

compile_src(File, Includes, Defines, Callgraph, CServer, AnalType, Plt) ->
  DefaultIncludes = default_includes(filename:dirname(File)),
  DefCompOpts = ?SRC_COMPILE_OPTS ++ Includes++Defines++DefaultIncludes,
  CompOpts = if AnalType =:= old_style -> DefCompOpts;
		true -> [no_copt|DefCompOpts]
	     end,
  Mod = list_to_atom(filename:basename(File, ".erl")),
  case dialyzer_utils:get_abstract_code_from_src(File, CompOpts) of
    {error, Msg} -> {error, Msg};
    AbstrCode ->
      case dialyzer_utils:get_core_from_abstract_code(AbstrCode, CompOpts) of
	error -> {error, "  Could not find abstract code for: "++File};
	Core ->
	  NoWarn = abs_get_nowarn(AbstrCode, Mod),
	  case dialyzer_utils:get_record_info(AbstrCode) of
	    {error, _} = Error -> Error;
	    {ok, RecInfo} ->
	      CServer2 = 
		dialyzer_codeserver:store_records(Mod, RecInfo, CServer),
	      compile_core(Mod, Core, NoWarn, Callgraph, 
			   CServer2, AnalType, Plt)
	  end
      end
  end.

compile_byte(File, Callgraph, CServer, AnalType, Plt) ->
  %% We must always set the code path, because the HiPE compiler
  %% does a M:module_info() call!
  OldPath = code:get_path(),
  Mod = list_to_atom(filename:basename(File, ".beam")),
  Dir = filename:dirname(File),
  case code:add_patha(Dir) of
    true ->            
      Opts = if AnalType =:= old_style -> [];
		true -> [no_copt]
	     end,
      Res = 
	case dialyzer_utils:get_abstract_code_from_beam(File) of
	  error ->	  
	    case AnalType of
	      dataflow -> 
		{error, "  Could not get abstract code for "++File++
		 "\n  Use option --old_style or recompile with"
		 " +debug_info (preferred)."};
	      plt_build ->
		{error, "  Could not get abstract code for "++File};
	      old_style ->
		case (catch hipe:c(Mod, ?HIPE_COMPILE_OPTS)) of
		  {'EXIT', Why} -> {error, io_lib:format("~p", [Why])};
		  {error, Why} -> {error, io_lib:format("~p", [Why])};
		  {ok, Icode} ->
		    CS1 = dialyzer_codeserver:insert(Icode, icode, CServer),
		    Exp = beam_get_exports(File),
		    CS2 = dialyzer_codeserver:insert_exports(Exp, CS1),
		    NewCG = dialyzer_callgraph:scan_icode(Icode, Callgraph),
		    NoWarn = beam_get_nowarn(File),
		    {ok, NewCG, NoWarn, CS2}
		end
	    end;
	  AbstrCode ->
	    NoWarn = abs_get_nowarn(AbstrCode, Mod),
	    case dialyzer_utils:get_core_from_abstract_code(AbstrCode, Opts) of
	      error -> {error, "  Could not get core for "++File};
	      Core ->
		case dialyzer_utils:get_record_info(AbstrCode) of
		  {error, _} = Error -> Error;
		  {ok, RecInfo} ->
		    CServer1 = 
		      dialyzer_codeserver:store_records(Mod, RecInfo, CServer),
		    compile_core(Mod, Core, NoWarn, Callgraph, 
				 CServer1, AnalType, Plt)
		end
	    end
	end,
      true = code:set_path(OldPath),
      Res;
    false ->
      {error, "  Could not add path: "++Dir}
  end.

compile_core(Mod, Core, NoWarn, Callgraph, CServer, AnalType, Plt) ->
  Exp = core_get_exports(Core),
  CServer1 = dialyzer_codeserver:insert_exports(Exp, CServer),
  {LabeledCore, CServer2} = label_core(Core, CServer1),
  if AnalType =:= old_style -> 
      compile_core_old(Mod, LabeledCore, NoWarn, Callgraph, CServer2, 
		       AnalType, Plt);
     true -> 
      store_code_and_build_callgraph(Mod, LabeledCore, none, Callgraph, 
				     CServer2, AnalType, NoWarn)
  end.

compile_core_old(Mod, LabeledCore, NoWarn, Callgraph, CServer, AnalType, Plt) ->
  try 
    AnnCore = dialyzer_dataflow:annotate_module(LabeledCore, Plt),
    TransCore = cerl:to_records(AnnCore),
    case hipe:compile_core(Mod, TransCore, [], ?HIPE_COMPILE_OPTS) of
      {error, Why} -> {error, io_lib:format("~p", [Why])};
      {ok, Icode} ->
	store_code_and_build_callgraph(Mod, TransCore, Icode, Callgraph, 
				       CServer, AnalType, NoWarn)
    end
  catch
    _:What -> 
      {error, io_lib:format("~p", [{What, erlang:get_stacktrace()}])}
  end.

  
abs_get_nowarn(Abs, M) ->
  [{M, F, A} 
   || {attribute, _, compile, {nowarn_unused_function, {F, A}}} <- Abs].

beam_get_exports(File) ->
  case beam_lib:chunks(File, [exports]) of
    {ok,{_,[{exports, List}]}} ->
      M = list_to_atom(filename:basename(File, ".beam")),
      [{M, F, A} || {F, A} <- List];
    error ->
      []
  end.

beam_get_nowarn(File) ->
  case beam_lib:chunks(File, [compile_info]) of
    {ok,{_,[{compile_info, List}]}} ->
      M = list_to_atom(filename:basename(File, ".beam")),
      [{M, F, A} || {nowarn_unused_function, {F, A}} <- List];
    error ->
      []
  end.

core_get_exports(Core) ->
  Tree = cerl:from_records(Core),
  Exports1 = cerl:module_exports(Tree),  
  Exports2 = [cerl:var_name(V) || V <- Exports1],
  M = cerl:atom_val(cerl:module_name(Tree)),
  [{M, F, A} || {F, A} <- Exports2].

label_core(Core, CServer) ->
  NextLabel = dialyzer_codeserver:next_core_label(CServer),
  CoreTree = cerl:from_records(Core),
  {LabeledTree, NewNextLabel} = cerl_trees:label(CoreTree, NextLabel),
  {cerl:to_records(LabeledTree), 
   dialyzer_codeserver:update_next_core_label(NewNextLabel, CServer)}.

store_code_and_build_callgraph(Mod, Core, Icode, Callgraph, CServer, 
			       AnalType, NoWarn) ->
  if AnalType =:= old_style ->
      %% When building the callgraph from core that is not lambda
      %% lifted, we lose the lifted functions. We solve this for now
      %% by scanning the icode instead of the core code. I can't wait
      %% to get rid of the icode.
      CServer1 = dialyzer_codeserver:insert(Icode, icode, CServer),
      NewCallgraph = dialyzer_callgraph:scan_icode(Icode, Callgraph),
      {ok, NewCallgraph, NoWarn, CServer1};
     true ->
      CoreTree = cerl:from_records(Core),
      NewCallgraph = dialyzer_callgraph:scan_core_tree(CoreTree, Callgraph),
      CServer2 = dialyzer_codeserver:insert([{Mod, CoreTree}], core, CServer),
      {ok, NewCallgraph, NoWarn, CServer2}
  end.

%%____________________________________________________________
%%
%% Utilities
%%

expand_files(Analysis) ->
  Files = Analysis#analysis.files,
  Ext = 
    case Analysis#analysis.start_from of
      byte_code -> ".beam";
      src_code -> ".erl"
    end,
  case expand_files(Files, Ext, []) of
    [] ->
      exit({error, "No files to analyze. Check analysis type."});
    NewFiles ->
      Analysis#analysis{files=NewFiles}
  end.

expand_files([File|Left], Ext, Acc) ->
  case filelib:is_dir(File) of
    true ->
      {ok, List} = file:list_dir(File),
      NewFiles = [filename:join(File, X)
		  || X <- List, filename:extension(X) =:= Ext],
      expand_files(Left, Ext, NewFiles++Acc);
    false ->
      expand_files(Left, Ext, [File|Acc])
  end;
expand_files([], _Ext, Acc) ->
  ordsets:from_list(Acc).

default_includes(Dir) ->
  L1 = ["..", "../incl", "../inc", "../include"],
  [{i, filename:join(Dir, X)}||X<-L1].
  
%%____________________________________________________________
%%
%% Handle Messages
%%

send_log(Parent, Msg) ->
  Parent ! {self(), log, Msg}.

send_warnings(_Parent, []) ->
  ok;
send_warnings(Parent, Warnings) ->
  Parent ! {self(), warnings, Warnings}.

filter_warnings(LegalWarnings, Warnings) ->
  [Warning || {Tag, Warning} <- Warnings, lists:member(Tag, LegalWarnings)].

send_analysis_done(Parent) ->
  Parent ! {self(), done}.

send_error(Parent, Msg) ->
  Parent ! {self(), error, Msg}.

send_scan_fail(_Parent, []) ->
  ok;
send_scan_fail(Parent, [{FailFile, Reason}|Left]) ->
  Msg = io_lib:format("Error scanning file: ~p\n~s\n", 
		      [FailFile, Reason]),
  send_error(Parent, Msg),
  send_scan_fail(Parent, Left).
  
send_ext_calls(Parent, ExtCalls) ->
  Parent ! {self(), ext_calls, ExtCalls}.

send_bad_calls(Parent, BadCalls, old_style, _CodeServer) ->
  Warnings = 
    [{?WARN_CALLGRAPH, 
      {From, io_lib:format("Call to missing or unexported function ~w\n", 
			   [To])}}
     || {From, {_,F,A} = To} <- BadCalls,
	not(F =:= module_info andalso (A =:= 0 orelse A =:= 1))],
  send_warnings(Parent, Warnings);
send_bad_calls(Parent, BadCalls, _AnalType, CodeServer) ->
  send_warnings(Parent, format_bad_calls(BadCalls, CodeServer, [])).



format_bad_calls([{{_, _, _}, {_, module_info, A}}|Left], CodeServer, Acc) 
  when A =:= 0; A =:= 1 ->
  format_bad_calls(Left, CodeServer, Acc);
format_bad_calls([{From, To}|Left], 
		 CodeServer, Acc) ->
  {ok, Tree} = dialyzer_codeserver:lookup(From, core, CodeServer),
  Msg = io_lib:format("Call to missing or unexported function ~w\n", 
		      [To]),
  FileLine = find_call_file_and_line(Tree, To),
  NewAcc = [{?WARN_CALLGRAPH, {FileLine, Msg}}|Acc],
  format_bad_calls(Left, CodeServer, NewAcc);
format_bad_calls([], _CodeServer, Acc) ->
  Acc.

find_call_file_and_line({_Var, Tree}, MFA) ->
  Fun = 
    fun(SubTree, Acc) ->
	case cerl:is_c_call(SubTree) of
	  true ->
	    M = cerl:call_module(SubTree),
	    F = cerl:call_name(SubTree),
	    A = cerl:call_arity(SubTree),
	    case cerl:is_c_atom(M) andalso cerl:is_c_atom(F) of
	      true ->
		case {cerl:concrete(M), cerl:concrete(F), A} of
		  MFA ->
		    Ann = cerl:get_ann(SubTree),
		    [{get_file(Ann), get_line(Ann)}|Acc];
		  _ -> Acc
		end;
	      false -> Acc
	    end;
	  false -> Acc
	end
    end,
  hd(cerl_trees:fold(Fun, [], Tree)).

get_line([Line|_]) when is_integer(Line) -> Line;
get_line([_|Tail]) -> get_line(Tail);
get_line([]) -> -1.

get_file([{file, File}|_]) -> File;
get_file([_|Tail]) -> get_file(Tail).

%%____________________________________________________________
%%
%% Handle the PLT
%%

init_plt(#analysis{init_plt=InitPlt, user_plt=Plt, plt_info=Info}) ->
  dialyzer_plt:copy(InitPlt, Plt),
  case Info of
    none -> ok;
    {MD5, Libs} -> 
      dialyzer_plt:insert(Plt, {md5, MD5}),
      dialyzer_plt:insert(Plt, {libs, Libs}),
      ok
  end.