1%% -*- erlang-indent-level: 2 -*-
2%%
3%% Licensed under the Apache License, Version 2.0 (the "License");
4%% you may not use this file except in compliance with the License.
5%% You may obtain a copy of the License at
6%%
7%%     http://www.apache.org/licenses/LICENSE-2.0
8%%
9%% Unless required by applicable law or agreed to in writing, software
10%% distributed under the License is distributed on an "AS IS" BASIS,
11%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12%% See the License for the specific language governing permissions and
13%% limitations under the License.
14
15%%%-------------------------------------------------------------------
16%%% File    : dialyzer_analysis_callgraph.erl
17%%% Author  : Tobias Lindahl <tobiasl@it.uu.se>
18%%% Description :
19%%%
20%%% Created :  5 Apr 2005 by Tobias Lindahl <tobiasl@it.uu.se>
21%%%-------------------------------------------------------------------
22
23-module(dialyzer_analysis_callgraph).
24
25-export([start/3]).
26
27%%% Export for dialyzer_coordinator...
28-export([compile_init_result/0,
29	 add_to_result/4]).
30%%% ... and export for dialyzer_worker.
31-export([start_compilation/2,
32	 continue_compilation/2]).
33
34-export_type([compile_init_data/0,
35              one_file_mid_error/0,
36              one_file_result_ok/0,
37              compile_result/0]).
38
39-include("dialyzer.hrl").
40
41-record(analysis_state,
42	{
43	  codeserver                    :: dialyzer_codeserver:codeserver(),
44	  analysis_type  = succ_typings :: anal_type(),
45	  defines        = []           :: [dial_define()],
46	  doc_plt                       :: dialyzer_plt:plt(),
47	  include_dirs   = []           :: [file:filename()],
48	  parent                        :: pid(),
49          legal_warnings                :: % command line options
50                                           [dial_warn_tag()],
51	  plt                           :: dialyzer_plt:plt(),
52	  start_from     = byte_code    :: start_from(),
53	  use_contracts  = true         :: boolean(),
54	  timing_server                 :: dialyzer_timing:timing_server(),
55          solvers                       :: [solver()]
56	 }).
57
58-record(server_state,
59        {
60          parent :: pid()
61         }).
62
63%%--------------------------------------------------------------------
64%% Main
65%%--------------------------------------------------------------------
66
67-spec start(pid(), [dial_warn_tag()], #analysis{}) -> 'ok'.
68
69start(Parent, LegalWarnings, Analysis) ->
70  TimingServer = dialyzer_timing:init(Analysis#analysis.timing),
71  RacesOn = ordsets:is_element(?WARN_RACE_CONDITION, LegalWarnings),
72  Analysis0 =
73    Analysis#analysis{race_detection = RacesOn, timing_server = TimingServer},
74  Analysis1 = expand_files(Analysis0),
75  Analysis2 = run_analysis(Analysis1, LegalWarnings),
76  State = #server_state{parent = Parent},
77  loop(State, Analysis2, none),
78  dialyzer_timing:stop(TimingServer).
79
80run_analysis(Analysis, LegalWarnings) ->
81  Self = self(),
82  Fun = fun() -> analysis_start(Self, Analysis, LegalWarnings) end,
83  Analysis#analysis{analysis_pid = spawn_link(Fun)}.
84
85loop(#server_state{parent = Parent} = State,
86     #analysis{analysis_pid = AnalPid} = Analysis, ExtCalls) ->
87  receive
88    {AnalPid, log, LogMsg} ->
89      send_log(Parent, LogMsg),
90      loop(State, Analysis, ExtCalls);
91    {AnalPid, warnings, Warnings} ->
92      send_warnings(Parent, Warnings),
93      loop(State, Analysis, ExtCalls);
94    {AnalPid, cserver, CServer, Plt} ->
95      skip_ets_transfer(AnalPid),
96      send_codeserver_plt(Parent, CServer, Plt),
97      loop(State, Analysis, ExtCalls);
98    {AnalPid, done, Plt, DocPlt} ->
99      send_ext_calls(Parent, ExtCalls),
100      send_analysis_done(Parent, Plt, DocPlt);
101    {AnalPid, ext_calls, NewExtCalls} ->
102      loop(State, Analysis, NewExtCalls);
103    {AnalPid, ext_types, ExtTypes} ->
104      send_ext_types(Parent, ExtTypes),
105      loop(State, Analysis, ExtCalls);
106    {AnalPid, mod_deps, ModDeps} ->
107      send_mod_deps(Parent, ModDeps),
108      loop(State, Analysis, ExtCalls);
109    {Parent, stop} ->
110      exit(AnalPid, kill),
111      ok
112  end.
113
114%%--------------------------------------------------------------------
115%% The Analysis
116%%--------------------------------------------------------------------
117
118analysis_start(Parent, Analysis, LegalWarnings) ->
119  CServer = dialyzer_codeserver:new(),
120  Plt = Analysis#analysis.plt,
121  State = #analysis_state{codeserver = CServer,
122			  analysis_type = Analysis#analysis.type,
123			  defines = Analysis#analysis.defines,
124			  doc_plt = Analysis#analysis.doc_plt,
125			  include_dirs = Analysis#analysis.include_dirs,
126			  plt = Plt,
127			  parent = Parent,
128                          legal_warnings = LegalWarnings,
129			  start_from = Analysis#analysis.start_from,
130			  use_contracts = Analysis#analysis.use_contracts,
131			  timing_server = Analysis#analysis.timing_server,
132                          solvers = Analysis#analysis.solvers
133			 },
134  Files = ordsets:from_list(Analysis#analysis.files),
135  {Callgraph, TmpCServer0} = compile_and_store(Files, State),
136  %% Remote type postprocessing
137  Args = {Plt, Analysis, Parent},
138  NewCServer = remote_type_postprocessing(TmpCServer0, Args),
139  dump_callgraph(Callgraph, State, Analysis),
140  %% Remove all old versions of the files being analyzed
141  AllNodes = dialyzer_callgraph:all_nodes(Callgraph),
142  Plt1_a = dialyzer_plt:delete_list(Plt, AllNodes),
143  Plt1 = dialyzer_plt:insert_callbacks(Plt1_a, NewCServer),
144  State1 = State#analysis_state{codeserver = NewCServer, plt = Plt1},
145  Exports = dialyzer_codeserver:get_exports(NewCServer),
146  NonExports = sets:subtract(sets:from_list(AllNodes), Exports),
147  NonExportsList = sets:to_list(NonExports),
148  NewCallgraph =
149    case Analysis#analysis.race_detection of
150      true -> dialyzer_callgraph:put_race_detection(true, Callgraph);
151      false -> Callgraph
152    end,
153  State2 = analyze_callgraph(NewCallgraph, State1),
154  #analysis_state{plt = Plt2,
155                  doc_plt = DocPlt,
156                  codeserver = Codeserver0} = State2,
157  {Codeserver, Plt3} = move_data(Codeserver0, Plt2),
158  dialyzer_callgraph:dispose_race_server(NewCallgraph),
159  %% Since the PLT is never used, a dummy is sent:
160  DummyPlt = dialyzer_plt:new(),
161  send_codeserver_plt(Parent, Codeserver, DummyPlt),
162  dialyzer_plt:delete(DummyPlt),
163  Plt4 = dialyzer_plt:delete_list(Plt3, NonExportsList),
164  send_analysis_done(Parent, Plt4, DocPlt).
165
166remote_type_postprocessing(TmpCServer, Args) ->
167  Fun = fun() ->
168            exit(try remote_type_postproc(TmpCServer, Args) of
169                     R -> R
170                 catch
171                   throw:{error,_}=Error -> Error
172                 end)
173        end,
174  {Pid, Ref} = erlang:spawn_monitor(Fun),
175  dialyzer_codeserver:give_away(TmpCServer, Pid),
176  Pid ! {self(), go},
177  receive {'DOWN', Ref, process, Pid, Return} ->
178      skip_ets_transfer(Pid),
179      case Return of
180        {error, _ErrorMsg} = Error -> exit(Error);
181        _ -> Return
182      end
183  end.
184
185remote_type_postproc(TmpCServer0, Args) ->
186  {Plt, Analysis, Parent} = Args,
187  fun() ->
188      Caller = receive {Pid, go} -> Pid end,
189      TmpCServer1 = dialyzer_utils:merge_types(TmpCServer0, Plt),
190      NewExpTypes = dialyzer_codeserver:get_temp_exported_types(TmpCServer0),
191      OldExpTypes0 = dialyzer_plt:get_exported_types(Plt),
192      #analysis{start_from = StartFrom,
193                timing_server = TimingServer} = Analysis,
194      Files = ordsets:from_list(Analysis#analysis.files),
195      RemMods =
196        [case StartFrom of
197           byte_code -> list_to_atom(filename:basename(F, ".beam"));
198           src_code -> list_to_atom(filename:basename(F, ".erl"))
199         end || F <- Files],
200      OldExpTypes1 = dialyzer_utils:sets_filter(RemMods, OldExpTypes0),
201      MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1),
202      TmpCServer2 =
203        dialyzer_codeserver:finalize_exported_types(MergedExpTypes,
204                                                    TmpCServer1),
205      TmpServer4 =
206        ?timing
207           (TimingServer, "remote",
208            begin
209              TmpCServer3 =
210                dialyzer_utils:process_record_remote_types(TmpCServer2),
211              dialyzer_contracts:process_contract_remote_types(TmpCServer3)
212          end),
213      rcv_and_send_ext_types(Caller, Parent),
214      dialyzer_codeserver:give_away(TmpServer4, Caller),
215      TmpServer4
216  end().
217
218skip_ets_transfer(Pid) ->
219  receive
220    {'ETS-TRANSFER', _Tid, Pid, _HeriData} ->
221      skip_ets_transfer(Pid)
222  after 0 ->
223      ok
224  end.
225
226move_data(CServer, Plt) ->
227  {CServer1, Records} = dialyzer_codeserver:extract_records(CServer),
228  Plt1 = dialyzer_plt:insert_types(Plt, Records),
229  {NewCServer, ExpTypes} = dialyzer_codeserver:extract_exported_types(CServer1),
230  NewPlt = dialyzer_plt:insert_exported_types(Plt1, ExpTypes),
231  {NewCServer, NewPlt}.
232
233analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver,
234					     doc_plt = DocPlt,
235                                             plt = Plt,
236					     timing_server = TimingServer,
237					     parent = Parent,
238                                             solvers = Solvers} = State) ->
239  case State#analysis_state.analysis_type of
240    plt_build ->
241      NewPlt =
242        dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver,
243                                                TimingServer, Solvers, Parent),
244      dialyzer_callgraph:delete(Callgraph),
245      State#analysis_state{plt = NewPlt, doc_plt = DocPlt};
246    succ_typings ->
247      {Warnings, NewPlt, NewDocPlt} =
248        dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver,
249                                           TimingServer, Solvers, Parent),
250      dialyzer_callgraph:delete(Callgraph),
251      Warnings1 = filter_warnings(Warnings, Codeserver),
252      send_warnings(State#analysis_state.parent, Warnings1),
253      State#analysis_state{plt = NewPlt, doc_plt = NewDocPlt}
254    end.
255
256%%--------------------------------------------------------------------
257%% Build the callgraph and fill the codeserver.
258%%--------------------------------------------------------------------
259
260-record(compile_init,{
261	  callgraph                 :: dialyzer_callgraph:callgraph(),
262	  codeserver                :: dialyzer_codeserver:codeserver(),
263	  defines       = []        :: [dial_define()],
264	  include_dirs  = []        :: [file:filename()],
265	  start_from    = byte_code :: start_from(),
266	  use_contracts = true      :: boolean(),
267          legal_warnings            :: [dial_warn_tag()]
268	 }).
269
270make_compile_init(#analysis_state{codeserver = Codeserver,
271				  defines = Defs,
272				  include_dirs = Dirs,
273				  use_contracts = UseContracts,
274                                  legal_warnings = LegalWarnings,
275				  start_from = StartFrom}, Callgraph) ->
276  #compile_init{callgraph = Callgraph,
277		codeserver = Codeserver,
278		defines = [{d, Macro, Val} || {Macro, Val} <- Defs],
279		include_dirs = [{i, D} || D <- Dirs],
280		use_contracts = UseContracts,
281                legal_warnings = LegalWarnings,
282		start_from = StartFrom}.
283
284compile_and_store(Files, #analysis_state{codeserver = CServer,
285					 timing_server = Timing,
286					 parent = Parent} = State) ->
287  send_log(Parent, "Reading files and computing callgraph... "),
288  {T1, _} = statistics(wall_clock),
289  Callgraph = dialyzer_callgraph:new(),
290  CompileInit = make_compile_init(State, Callgraph),
291  %% Spawn a worker per file - where each worker calls
292  %% start_compilation on its file, asks next label to coordinator and
293  %% calls continue_compilation - and let coordinator aggregate
294  %% results using (compile_init_result and) add_to_result.
295  {{Failed, Modules}, NextLabel} =
296    ?timing(Timing, "compile", _C1,
297	    dialyzer_coordinator:parallel_job(compile, Files,
298					      CompileInit, Timing)),
299  CServer2 = dialyzer_codeserver:set_next_core_label(NextLabel, CServer),
300  case Failed =:= [] of
301    true ->
302      ModDict =
303        lists:foldl(fun(F, Dict) ->
304                        ModFile = lists:last(filename:split(F)),
305                        Mod = filename:basename(ModFile, ".beam"),
306                        dict:append(Mod, F, Dict)
307                    end,
308                    dict:new(), Files),
309      check_for_duplicate_modules(ModDict);
310    false ->
311      Msg = io_lib:format("Could not scan the following file(s):~n~ts",
312      			  [[Reason || {_Filename, Reason} <- Failed]]),
313      exit({error, Msg})
314  end,
315  {T2, _} = statistics(wall_clock),
316  Msg1 = io_lib:format("done in ~.2f secs\nRemoving edges... ", [(T2-T1)/1000]),
317  send_log(Parent, Msg1),
318  Callgraph =
319    ?timing(Timing, "clean", _C2,
320	    cleanup_callgraph(State, CServer2, Callgraph, Modules)),
321  {T3, _} = statistics(wall_clock),
322  Msg2 = io_lib:format("done in ~.2f secs\n", [(T3-T2)/1000]),
323  send_log(Parent, Msg2),
324  {Callgraph, CServer2}.
325
326-opaque compile_init_data()  :: #compile_init{}.
327-type error_reason()         :: string().
328-opaque compile_result()     :: {[{file:filename(), error_reason()}],
329                                 [module()]}.
330-type one_file_mid_error()   :: {error, error_reason()}.
331-opaque one_file_result_ok() :: {ok, [dialyzer_callgraph:callgraph_edge()],
332                                 [mfa_or_funlbl()], module()}.
333-type one_file_result()      :: one_file_mid_error() |
334                                one_file_result_ok().
335-type compile_mid_data()     :: {module(), cerl:cerl(),
336                                 dialyzer_callgraph:callgraph(),
337                                 dialyzer_codeserver:codeserver()}.
338
339-spec compile_init_result() -> compile_result().
340
341compile_init_result() -> {[], []}.
342
343-spec add_to_result(file:filename(), one_file_result(), compile_result(),
344		    compile_init_data()) -> compile_result().
345
346add_to_result(File, NewData, {Failed, Mods}, InitData) ->
347  case NewData of
348    {error, Reason} ->
349      {[{File, Reason}|Failed], Mods};
350    {ok, V, E, Mod} ->
351      Callgraph = InitData#compile_init.callgraph,
352      dialyzer_callgraph:add_edges(E, V, Callgraph),
353      {Failed, [Mod|Mods]}
354  end.
355
356-spec start_compilation(file:filename(), compile_init_data()) ->
357	{error, error_reason()} |{ok, integer(), compile_mid_data()}.
358
359start_compilation(File,
360		  #compile_init{callgraph = Callgraph, codeserver = Codeserver,
361				defines = Defines, include_dirs = IncludeD,
362				use_contracts = UseContracts,
363                                legal_warnings = LegalWarnings,
364				start_from = StartFrom}) ->
365  case StartFrom of
366    src_code ->
367      compile_src(File, IncludeD, Defines, Callgraph, Codeserver,
368                  UseContracts, LegalWarnings);
369    byte_code ->
370      compile_byte(File, Callgraph, Codeserver, UseContracts, LegalWarnings)
371  end.
372
373cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent,
374				  codeserver = CodeServer
375				 },
376		  CServer, Callgraph, Modules) ->
377  ModuleDeps = dialyzer_callgraph:module_deps(Callgraph),
378  send_mod_deps(Parent, ModuleDeps),
379  {Callgraph1, ExtCalls} = dialyzer_callgraph:remove_external(Callgraph),
380  ExtCalls1 = [Call || Call = {_From, To} <- ExtCalls,
381		       not dialyzer_plt:contains_mfa(InitPlt, To)],
382  {BadCalls1, RealExtCalls} =
383    if ExtCalls1 =:= [] -> {[], []};
384       true ->
385	ModuleSet = sets:from_list(Modules),
386	PltModuleSet = dialyzer_plt:all_modules(InitPlt),
387	AllModules = sets:union(ModuleSet, PltModuleSet),
388	Pred = fun({_From, {M, _F, _A}}) -> sets:is_element(M, AllModules) end,
389	lists:partition(Pred, ExtCalls1)
390    end,
391  NonLocalCalls = dialyzer_callgraph:non_local_calls(Callgraph1),
392  BadCalls2 = [Call || Call = {_From, To} <- NonLocalCalls,
393		       not dialyzer_codeserver:is_exported(To, CServer)],
394  case BadCalls1 ++ BadCalls2 of
395    [] -> ok;
396    BadCalls -> send_bad_calls(Parent, BadCalls, CodeServer)
397  end,
398  if RealExtCalls =:= [] -> ok;
399     true ->
400      ExtCallsWithFileAndLocation =
401        [{To, find_call_file_and_location(From, To, CodeServer)} ||
402          {From, To} <- RealExtCalls],
403      send_ext_calls(Parent, ExtCallsWithFileAndLocation)
404  end,
405  Callgraph1.
406
407compile_src(File, Includes, Defines, Callgraph, CServer, UseContracts,
408            LegalWarnings) ->
409  DefaultIncludes = default_includes(filename:dirname(File)),
410  SrcCompOpts = dialyzer_utils:src_compiler_opts(),
411  CompOpts = SrcCompOpts ++ Includes ++ Defines ++ DefaultIncludes,
412  case dialyzer_utils:get_core_from_src(File, CompOpts) of
413    {error, _Msg} = Error -> Error;
414    {ok, Core} ->
415      compile_common(Core, Callgraph, CServer, UseContracts, LegalWarnings)
416  end.
417
418compile_byte(File, Callgraph, CServer, UseContracts, LegalWarnings) ->
419  case dialyzer_utils:get_core_from_beam(File) of
420    {error, _} = Error -> Error;
421    {ok, Core} ->
422      compile_common(Core, Callgraph, CServer, UseContracts, LegalWarnings)
423  end.
424
425compile_common(Core, Callgraph, CServer, UseContracts, LegalWarnings) ->
426  Mod = cerl:concrete(cerl:module_name(Core)),
427  case dialyzer_utils:get_record_and_type_info(Core) of
428    {error, _} = Error -> Error;
429    {ok, RecInfo} ->
430      CServer1 =
431	dialyzer_codeserver:store_temp_records(Mod, RecInfo, CServer),
432      case dialyzer_utils:get_fun_meta_info(Mod, Core, LegalWarnings) of
433	{error, _} = Error -> Error;
434	MetaFunInfo ->
435	  CServer2 =
436	    dialyzer_codeserver:insert_fun_meta_info(MetaFunInfo, CServer1),
437	  case UseContracts of
438	    true ->
439	      case dialyzer_utils:get_spec_info(Mod, Core, RecInfo) of
440	        {error, _} = Error -> Error;
441	        {ok, SpecInfo, CallbackInfo} ->
442	          CServer3 =
443	            dialyzer_codeserver:store_temp_contracts(Mod, SpecInfo,
444	                                                     CallbackInfo,
445	                                                     CServer2),
446	          store_core(Mod, Core, Callgraph, CServer3)
447	      end;
448	    false ->
449	      store_core(Mod, Core, Callgraph, CServer2)
450      end
451    end
452  end.
453
454store_core(Mod, Core, Callgraph, CServer) ->
455  Exp = get_exports_from_core(Core),
456  ExpTypes = get_exported_types_from_core(Core),
457  CServer = dialyzer_codeserver:insert_exports(Exp, CServer),
458  CServer = dialyzer_codeserver:insert_temp_exported_types(ExpTypes, CServer),
459  CoreTree = cerl:from_records(Core),
460  CoreSize = cerl_trees:size(CoreTree),
461  {ok, CoreSize, {Mod, CoreTree, Callgraph, CServer}}.
462
463-spec continue_compilation(integer(), compile_mid_data()) ->
464                              one_file_result_ok().
465
466continue_compilation(NextLabel, {Mod, CoreTree, Callgraph, CServer}) ->
467  {LabeledTree, _NewNextLabel} = cerl_trees:label(CoreTree, NextLabel),
468  LabeledCore = cerl:to_records(LabeledTree),
469  store_code_and_build_callgraph(Mod, LabeledCore, Callgraph, CServer).
470
471get_exported_types_from_core(Core) ->
472  Attrs = cerl:module_attrs(Core),
473  ExpTypes1 = [cerl:concrete(L2) || {L1, L2} <- Attrs, cerl:is_literal(L1),
474                                    cerl:is_literal(L2),
475                                    cerl:concrete(L1) =:= 'export_type'],
476  ExpTypes2 = lists:flatten(ExpTypes1),
477  M = cerl:atom_val(cerl:module_name(Core)),
478  sets:from_list([{M, F, A} || {F, A} <- ExpTypes2]).
479
480get_exports_from_core(Core) ->
481  Tree = cerl:from_records(Core),
482  Exports1 = cerl:module_exports(Tree),
483  Exports2 = [cerl:var_name(V) || V <- Exports1],
484  M = cerl:atom_val(cerl:module_name(Tree)),
485  [{M, F, A} || {F, A} <- Exports2].
486
487store_code_and_build_callgraph(Mod, Core, Callgraph, CServer) ->
488  CoreTree = cerl:from_records(Core),
489  {Vertices, Edges} = dialyzer_callgraph:scan_core_tree(CoreTree, Callgraph),
490  CServer = dialyzer_codeserver:insert(Mod, CoreTree, CServer),
491  {ok, Vertices, Edges, Mod}.
492
493%%--------------------------------------------------------------------
494%% Utilities
495%%--------------------------------------------------------------------
496
497expand_files(Analysis = #analysis{files = Files, start_from = StartFrom}) ->
498  Ext = case StartFrom of
499	  byte_code -> ".beam";
500	  src_code -> ".erl"
501	end,
502  case expand_files(Files, Ext, []) of
503    [] ->
504      Msg = "No " ++ Ext ++ " files to analyze" ++
505	case StartFrom of
506	  byte_code -> " (no --src specified?)";
507	  src_code -> ""
508	end,
509      exit({error, Msg});
510    NewFiles ->
511      Analysis#analysis{files = NewFiles}
512  end.
513
514expand_files([File|Left], Ext, FileAcc) ->
515  case filelib:is_dir(File) of
516    true ->
517      {ok, List} = file:list_dir(File),
518      NewFiles = lists:foldl(fun (X, Acc) ->
519				 case filename:extension(X) =:= Ext of
520				   true -> [filename:join(File, X)|Acc];
521				   false -> Acc
522				 end
523			     end, FileAcc, List),
524      expand_files(Left, Ext, NewFiles);
525    false ->
526      expand_files(Left, Ext, [File|FileAcc])
527  end;
528expand_files([], _Ext, FileAcc) ->
529  FileAcc.
530
531check_for_duplicate_modules(ModDict) ->
532  Duplicates = dict:filter(fun(_, [_]) -> false;
533			      (_, _Files) -> true
534			   end, ModDict),
535  case dict:size(Duplicates) =:= 0 of
536    true ->
537      ok;
538    false ->
539      Mods = [X || {_, X} <- dict:to_list(Duplicates)],
540      Msg = io_lib:format("Duplicate modules: ~p", [Mods]),
541      exit({error, Msg})
542  end.
543
544default_includes(Dir) ->
545  L1 = ["..", "../incl", "../inc", "../include"],
546  [{i, filename:join(Dir, X)} || X <- L1].
547
548%%-------------------------------------------------------------------
549%% Handle Messages
550%%-------------------------------------------------------------------
551
552rcv_and_send_ext_types(SendTo, Parent) ->
553  Self = self(),
554  Self ! {Self, done},
555  case rcv_ext_types(Self, []) of
556    [] -> ok;
557    ExtTypes ->
558      Parent ! {SendTo, ext_types, ExtTypes},
559      ok
560  end.
561
562rcv_ext_types(Self, ExtTypes) ->
563  receive
564    {Self, ext_types, ExtType} ->
565      rcv_ext_types(Self, [ExtType|ExtTypes]);
566    {Self, done} -> lists:usort(ExtTypes)
567  end.
568
569send_log(Parent, Msg) ->
570  Parent ! {self(), log, Msg},
571  ok.
572
573send_warnings(_Parent, []) ->
574  ok;
575send_warnings(Parent, Warnings) ->
576  Parent ! {self(), warnings, Warnings},
577  ok.
578
579filter_warnings(Warnings, Codeserver) ->
580  [TWW || {Tag, WarningInfo, _Warning} = TWW <- Warnings,
581          is_ok_fun(WarningInfo, Codeserver),
582          is_ok_tag(Tag, WarningInfo, Codeserver)].
583
584is_ok_fun({_F, _L, Module}, _Codeserver) when is_atom(Module) ->
585  true;
586is_ok_fun({_Filename, _Loc, {_M, _F, _A} = MFA}, Codeserver) ->
587  not dialyzer_utils:is_suppressed_fun(MFA, Codeserver).
588
589is_ok_tag(Tag, {_F, _L, MorMFA}, Codeserver) ->
590  not dialyzer_utils:is_suppressed_tag(MorMFA, Tag, Codeserver).
591
592send_analysis_done(Parent, Plt, DocPlt) ->
593  Parent ! {self(), done, Plt, DocPlt},
594  ok.
595
596send_ext_calls(_Parent, none) ->
597  ok;
598send_ext_calls(Parent, ExtCalls) ->
599  Parent ! {self(), ext_calls, ExtCalls},
600  ok.
601
602send_ext_types(Parent, ExtTypes) ->
603  Parent ! {self(), ext_types, ExtTypes},
604  ok.
605
606send_codeserver_plt(Parent, CServer, Plt) ->
607  ok = dialyzer_codeserver:give_away(CServer, Parent),
608  Parent ! {self(), cserver, CServer, Plt},
609  ok.
610
611send_bad_calls(Parent, BadCalls, CodeServer) ->
612  FormatedBadCalls = format_bad_calls(BadCalls, CodeServer, []),
613  Warnings = filter_warnings(FormatedBadCalls, CodeServer),
614  send_warnings(Parent, Warnings).
615
616send_mod_deps(Parent, ModuleDeps) ->
617  Parent ! {self(), mod_deps, ModuleDeps},
618  ok.
619
620format_bad_calls([{{_, _, _}, {_, module_info, A}}|Left], CodeServer, Acc)
621  when A =:= 0; A =:= 1 ->
622  format_bad_calls(Left, CodeServer, Acc);
623format_bad_calls([{FromMFA, {M, F, A} = To}|Left], CodeServer, Acc) ->
624  Msg = {call_to_missing, [M, F, A]},
625  {File, Loc} = find_call_file_and_location(FromMFA, To, CodeServer),
626  WarningInfo = {File, Loc, FromMFA},
627  NewAcc = [{?WARN_CALLGRAPH, WarningInfo, Msg}|Acc],
628  format_bad_calls(Left, CodeServer, NewAcc);
629format_bad_calls([], _CodeServer, Acc) ->
630  Acc.
631
632find_call_file_and_location({Module, _, _} = FromMFA, ToMFA, CodeServer) ->
633  {_Var, FunCode} = dialyzer_codeserver:lookup_mfa_code(FromMFA, CodeServer),
634  Fun =
635    fun(SubTree, Acc) ->
636	case cerl:is_c_call(SubTree) of
637	  true ->
638	    M = cerl:call_module(SubTree),
639	    F = cerl:call_name(SubTree),
640	    A = cerl:call_arity(SubTree),
641	    case cerl:is_c_atom(M) andalso cerl:is_c_atom(F) of
642	      true ->
643		case {cerl:concrete(M), cerl:concrete(F), A} of
644		  ToMFA ->
645		    Ann = cerl:get_ann(SubTree),
646                    File = get_file(CodeServer, Module, Ann),
647                    Location = get_location(SubTree),
648		    [{File, Location}|Acc];
649		  {erlang, make_fun, 3} ->
650		    [CA1, CA2, CA3] = cerl:call_args(SubTree),
651		    case
652		      cerl:is_c_atom(CA1) andalso
653		      cerl:is_c_atom(CA2) andalso
654		      cerl:is_c_int(CA3)
655		    of
656		      true ->
657			case
658			  {cerl:concrete(CA1),
659			   cerl:concrete(CA2),
660			   cerl:concrete(CA3)}
661			of
662			  ToMFA ->
663			    Ann = cerl:get_ann(SubTree),
664			    [{get_file(CodeServer, Module, Ann),
665                              get_location(SubTree)}|Acc];
666			  _ ->
667			    Acc
668			end;
669		      false ->
670			Acc
671		    end;
672		  _ -> Acc
673		end;
674	      false -> Acc
675	    end;
676	  false -> Acc
677	end
678    end,
679  hd(cerl_trees:fold(Fun, [], FunCode)).
680
681get_location(Tree) ->
682  dialyzer_utils:get_location(Tree, 0).
683
684get_file(Codeserver, Module, [{file, FakeFile}|_]) ->
685  dialyzer_codeserver:translate_fake_file(Codeserver, Module, FakeFile);
686get_file(Codeserver, Module, [_|Tail]) ->
687  get_file(Codeserver, Module, Tail).
688
689-spec dump_callgraph(dialyzer_callgraph:callgraph(), #analysis_state{}, #analysis{}) ->
690  'ok'.
691
692dump_callgraph(_CallGraph, _State, #analysis{callgraph_file = ""}) -> ok;
693dump_callgraph(CallGraph, State, #analysis{callgraph_file = File} = Analysis) ->
694  Extension = filename:extension(File),
695  Start_Msg = io_lib:format("Dumping the callgraph... ", []),
696  send_log(State#analysis_state.parent, Start_Msg),
697  {T1, _} = statistics(wall_clock),
698  dump_callgraph(CallGraph, State, Analysis, Extension),
699  {T2, _} = statistics(wall_clock),
700  Finish_Msg = io_lib:format("done in ~2f secs\n", [(T2-T1)/1000]),
701  send_log(State#analysis_state.parent, Finish_Msg),
702  ok.
703
704dump_callgraph(CallGraph, _State, #analysis{callgraph_file = File}, ".dot") ->
705  dialyzer_callgraph:to_dot(CallGraph, File);
706dump_callgraph(CallGraph, _State, #analysis{callgraph_file = File}, ".ps") ->
707  Args = "-Gratio=compress -Gsize=\"100,100\"",
708  dialyzer_callgraph:to_ps(CallGraph, File, Args);
709dump_callgraph(CallGraph, State, #analysis{callgraph_file = File}, _Ext) ->
710  %% TODO: write the graph, not the ETS table identifiers.
711  case file:open(File, [write]) of
712    {ok, Fd} ->
713      io:format(Fd, "~p", [CallGraph]),
714      ok = file:close(Fd);
715    {error, Reason} ->
716      Msg = io_lib:format("Could not open output file ~tp, Reason: ~p\n",
717			  [File, Reason]),
718      send_log(State#analysis_state.parent, Msg)
719  end.
720