diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 2505cdc3eac0..91879198b1c8 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -1013,6 +1013,8 @@ handle_primop(Tree, Map, State) -> {State, Map, t_any()}; nif_start -> {State, Map, t_any()}; + executable_line -> + {State, Map, t_any()}; Other -> error({'Unsupported primop', Other}) end. diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 60d701ee056e..1a4853cb239b 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -438,6 +438,8 @@ traverse(Tree, DefinedVars, State) -> {State, t_any()}; nif_start -> {State, t_any()}; + executable_line -> + {State, t_any()}; Other -> erlang:error({'Unsupported primop', Other}) end; seq -> diff --git a/lib/dialyzer/test/dialyzer_SUITE.erl b/lib/dialyzer/test/dialyzer_SUITE.erl index fe6987192af5..a19e6930bc59 100644 --- a/lib/dialyzer/test/dialyzer_SUITE.erl +++ b/lib/dialyzer/test/dialyzer_SUITE.erl @@ -37,7 +37,8 @@ incremental_plt_given_to_classic_mode/1, classic_plt_given_to_incremental_mode/1, if_output_plt_is_missing_incremental_mode_makes_it/1, - file_list/1]). + file_list/1, + line_coverage/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -46,7 +47,8 @@ all() -> incremental_plt_given_to_classic_mode, classic_plt_given_to_incremental_mode, if_output_plt_is_missing_incremental_mode_makes_it, - file_list]. + file_list, + line_coverage]. groups() -> []. @@ -77,7 +79,7 @@ compile(Config, Prog, Module, CompileOpts) -> PrivDir = proplists:get_value(priv_dir,Config), Filename = filename:join([PrivDir, Source]), ok = file:write_file(Filename, Prog), - Opts = [{outdir, PrivDir}, debug_info | CompileOpts], + Opts = [report, {outdir, PrivDir}, debug_info | CompileOpts], {ok, Module} = compile:file(Filename, Opts), {ok, filename:join([PrivDir, lists:concat([Module, ".beam"])])}. @@ -242,3 +244,20 @@ expected(Files0) -> " atom()\n" || F <- Files], iolist_to_binary(S). +line_coverage(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Prog = <<"-module(foo). + bar() -> ok." + >>, + {ok, Beam1} = compile(Config, Prog, foo, [line_coverage]), + + Plt1 = filename:join(PrivDir, "line_coverage.plt"), + _ = dialyzer:run([{analysis_type, plt_build}, + {files, [Beam1]}, + {init_plt, Plt1}, + {from, byte_code}]), + + {ok, [{files, [Beam1]}]} = dialyzer:plt_info(Plt1), + + ok. + diff --git a/lib/observer/src/cdv_mem_cb.erl b/lib/observer/src/cdv_mem_cb.erl index d09e5df65989..0f2d51f3a6d8 100644 --- a/lib/observer/src/cdv_mem_cb.erl +++ b/lib/observer/src/cdv_mem_cb.erl @@ -84,5 +84,5 @@ fix_alloc([]) -> []. alloc_columns(Columns) -> - [{"", ?wxLIST_FORMAT_LEFT, 180} | + [{"", ?wxLIST_FORMAT_LEFT, 240} | [{Column, ?wxLIST_FORMAT_RIGHT, 140} || Column <- Columns]]. diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index fb734429bbbd..a498aaeb0282 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -2537,7 +2537,8 @@ sort_allocator_types([],Acc,DoTotal) -> sort_type_data(Type,[?opt_e_false|Data],Acc,_) when Type=/=?sbmbc_alloc-> sort_type_data(Type,Data,Acc,false); -sort_type_data(Type,[{Key,Val0}|Data],Acc,DoTotal) -> +sort_type_data(Type,[{Key0,Val0}|Data],Acc,DoTotal) -> + Key = re:replace(Key0, "([^[]*)(\\[[^]]*\\])(.*)", "\\1\\3", [{return, list}]), case lists:member(Key,?interesting_allocator_info) of true -> Val = list_to_integer(hd(Val0)), diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 2777e5f99557..701afb38e861 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -364,7 +364,7 @@ browse_file(File) -> {ok,Mods,_ModsTW} = crashdump_viewer:loaded_modules(), {ok,_Mem,_MemTW} = crashdump_viewer:memory(), {ok,_AllocAreas,_AreaTW} = crashdump_viewer:allocated_areas(), - {ok,_AllocINfo,_AllocInfoTW} = crashdump_viewer:allocator_info(), + {ok,AllocInfo,_AllocInfoTW} = crashdump_viewer:allocator_info(), {ok,_HashTabs,_HashTabsTW} = crashdump_viewer:hash_tables(), {ok,_IndexTabs,_IndexTabsTW} = crashdump_viewer:index_tables(), {ok,_PTs,_PTsTW} = crashdump_viewer:persistent_terms(), @@ -380,6 +380,9 @@ browse_file(File) -> lookat_all_nodes(Nodes), io:format(" nodes ok",[]), + lookat_alloc_info(AllocInfo,is_truncated(File)), + io:format(" alloc info ok",[]), + Procs. % used as second arg to special/2 is_truncated(File) -> @@ -733,6 +736,32 @@ lookat_all_nodes([#nod{channel=Channel0}|Nodes]) -> {ok,_Node=#nod{},_NodeTW} = crashdump_viewer:node_info(Channel), lookat_all_nodes(Nodes). +lookat_alloc_info(_,true) -> + ok; +lookat_alloc_info([AllocSummary|_],false) -> + {"Allocator Summary", + ["blocks size", "carriers size", "mseg carriers size"], + Data + } = AllocSummary, + + %% All values must be integer. + Filter = filter_alloc_info_fun(), + _ = [list_to_integer(IntStr) || {_,L} <- Data, + IntStr <- Filter(L)], + + ok. + +filter_alloc_info_fun() -> + case os:type() of + {win32,_} -> + fun([A,B,_]) -> + %% The third column is never valid on Windows. + [A,B] + end; + _ -> + fun([_,_,_]=L) -> L end + end. + %%%----------------------------------------------------------------- %%% create_dumps(DataDir,Rels) ->