aboutsummaryrefslogtreecommitdiffstats
path: root/lib/tools/test
diff options
context:
space:
mode:
Diffstat (limited to 'lib/tools/test')
-rw-r--r--lib/tools/test/emacs_SUITE.erl177
-rw-r--r--lib/tools/test/eprof_SUITE_data/eed.erl6
-rw-r--r--lib/tools/test/fprof_SUITE.erl4
-rw-r--r--lib/tools/test/instrument_SUITE.erl391
-rw-r--r--lib/tools/test/lcnt_SUITE.erl2
-rw-r--r--lib/tools/test/xref_SUITE.erl30
6 files changed, 465 insertions, 145 deletions
diff --git a/lib/tools/test/emacs_SUITE.erl b/lib/tools/test/emacs_SUITE.erl
index f4e78da667..a6d43d1816 100644
--- a/lib/tools/test/emacs_SUITE.erl
+++ b/lib/tools/test/emacs_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,18 +23,28 @@
-export([all/0, init_per_testcase/2, end_per_testcase/2]).
--export([bif_highlight/1, indent/1]).
+-export([bif_highlight/1,
+ load_interpreted/1, compile_and_load/1,
+ indent/1,
+ tests_interpreted/1, tests_compiled/1
+ ]).
all() ->
- [bif_highlight, indent].
+ [bif_highlight, load_interpreted, compile_and_load,
+ indent,
+ tests_interpreted, tests_compiled
+ ].
-init_per_testcase(_Case, Config) ->
+init_per_testcase(Case, Config) ->
ErlangEl = filename:join([code:lib_dir(tools),"emacs","erlang.el"]),
case file:read_file_info(ErlangEl) of
- {ok, _} ->
- [{el, ErlangEl}|Config];
- _ ->
- {skip, "Could not find erlang.el"}
+ {ok, _} ->
+ case Case =:= bif_highlight orelse emacs_version_ok(24.1) of
+ false -> {skip, "Old or no emacs found"};
+ _ -> [{el, ErlangEl}|Config]
+ end;
+ _ ->
+ {skip, "Could not find erlang.el"}
end.
end_per_testcase(_Case, _Config) ->
@@ -46,26 +56,26 @@ bif_highlight(Config) ->
%% All auto-imported bifs
IntBifs = lists:usort(
- [F || {F,A} <- erlang:module_info(exports),
- erl_internal:bif(F,A)]),
+ [F || {F,A} <- erlang:module_info(exports),
+ erl_internal:bif(F,A)]),
%% all bif which need erlang: prefix and are not operands
ExtBifs = lists:usort(
- [F || {F,A} <- erlang:module_info(exports),
- not erl_internal:bif(F,A) andalso
- not is_atom(catch erl_internal:op_type(F,A))]),
+ [F || {F,A} <- erlang:module_info(exports),
+ not erl_internal:bif(F,A) andalso
+ not is_atom(catch erl_internal:op_type(F,A))]),
check_bif_highlight(Bin, <<"erlang-int-bifs">>, IntBifs),
check_bif_highlight(Bin, <<"erlang-ext-bifs">>, ExtBifs).
-
+
check_bif_highlight(Bin, Tag, Compare) ->
- [_H,IntMatch,_T] =
- re:split(Bin,<<"defvar ",Tag/binary,
- "[^(]*\\(([^)]*)">>,[]),
- EmacsIntBifs = [list_to_atom(S) ||
- S <- string:tokens(binary_to_list(IntMatch)," '\"\n")],
-
+ [_H,IntMatch,_T] =
+ re:split(Bin,<<"defvar ",Tag/binary,
+ "[^(]*\\(([^)]*)">>,[]),
+ EmacsIntBifs = [list_to_atom(S) ||
+ S <- string:tokens(binary_to_list(IntMatch)," '\"\n")],
+
ct:log("Emacs ~p",[EmacsIntBifs]),
ct:log("Int ~p",[Compare]),
@@ -73,27 +83,92 @@ check_bif_highlight(Bin, Tag, Compare) ->
ct:log("Diff2 ~p",[EmacsIntBifs -- Compare]),
[] = Compare -- EmacsIntBifs,
[] = EmacsIntBifs -- Compare.
-
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-indent(Config) ->
- case emacs_version_ok() of
+load_interpreted(_Config) ->
+ _ = emacs(["-l erlang.el -f erlang-mode"]),
+ ok.
+
+compile_and_load(_Config) ->
+ Dir = emacs_dir(),
+ Files0 = filelib:wildcard("*.el", Dir),
+ Files = case emacs_version_ok(24.3) of
+ %% erldoc.el depends on cl-lib which was introduced in 24.3.
+ false -> Files0 -- ["erldoc.el"];
+ _ -> Files0
+ end,
+ Unforgiving =
+ case emacs_version_ok(24) of
+ Ver when Ver < 25 ->
+ "";
+ Ver when Ver < 26 ->
+ %% Workaround byte-compile-error-on-warn which seem broken in
+ %% Emacs 25.
+ "\"(advice-add #'display-warning :after "
+ "(lambda (_ f _ _) (error \"%s\" f)))\"";
+ _ ->
+ "\"(setq byte-compile-error-on-warn t)\""
+ end,
+ %% Add files here whenever they are cleaned of warnings.
+ NoWarn = ["erlang.el", "erlang-test.el", "erlang-edoc.el", "erlang-start.el", "erldoc.el"],
+ Compile = fun(File) ->
+ Pedantic = case lists:member(File, NoWarn) andalso Unforgiving /= "" of
+ true -> ["--eval ", Unforgiving, " "];
+ false -> " "
+ end,
+ emacs([Pedantic,
+ " -f batch-byte-compile ",filename:join(Dir, File)]),
+ true
+ end,
+ lists:foreach(Compile, Files),
+ emacs(["-l erlang.elc -f erlang-mode"]),
+ ok.
+
+tests_interpreted(_Config) ->
+ case emacs_version_ok(25) of
false -> {skip, "Old or no emacs found"};
- true ->
- Def = filename:dirname(code:which(?MODULE)) ++ "/" ++ ?MODULE_STRING ++ "_data",
- Dir = proplists:get_value(data_dir, Config, Def),
- OrigFs = filelib:wildcard(Dir ++ "/*"),
- io:format("Dir: ~s~nFs: ~p~n", [Dir, OrigFs]),
- Fs = [{File, unindent(File)} || File <- OrigFs,
- filename:extension(File) =:= ""],
- Indent = fun emacs/1,
- [Indent(File) || {_, File} <- Fs],
- Res = [diff(Orig, File) || {Orig, File} <- Fs],
- [file:delete(File) || {ok, File} <- Res], %% Cleanup
- [] = [Fail || {fail, Fail} <- Res],
+ _ ->
+ emacs(["-l erlang.el ",
+ "-l erlang-test.el -f ert-run-tests-batch-and-exit"]),
ok
end.
+tests_compiled(_Config) ->
+ case emacs_version_ok(25) of
+ false -> {skip, "Old or no emacs found"};
+ _ ->
+ emacs(["-l erlang.elc ",
+ "-l erlang-test.elc -f ert-run-tests-batch-and-exit"]),
+ ok
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+indent(Config) ->
+ Def = filename:dirname(code:which(?MODULE))
+ ++ "/"
+ ++ ?MODULE_STRING
+ ++ "_data",
+ Dir = proplists:get_value(data_dir, Config, Def),
+ OrigFs = filelib:wildcard(Dir ++ "/*"),
+ io:format("Dir: ~s~nFs: ~p~n", [Dir, OrigFs]),
+ Fs = [{File, unindent(File)} || File <- OrigFs,
+ filename:extension(File) =:= ""],
+ Indent = fun(File) ->
+ emacs([
+ File, " ",
+ "--eval '(indent-region (point-min) (point-max) nil)' ",
+ "--eval '(save-buffer 0)'"
+ ]),
+ ok
+ end,
+ [Indent(File) || {_, File} <- Fs],
+ Res = [diff(Orig, File) || {Orig, File} <- Fs],
+ [file:delete(File) || {ok, File} <- Res], %% Cleanup
+ [] = [Fail || {fail, Fail} <- Res],
+ ok.
+
unindent(Input) ->
Output = Input ++ ".erl",
{ok, Bin} = file:read_file(Input),
@@ -112,14 +187,13 @@ diff(Orig, File) ->
{fail, File}
end.
-emacs_version_ok() ->
+emacs_version_ok(AcceptVer) ->
case os:cmd("emacs --version | head -1") of
"GNU Emacs " ++ Ver ->
case string:to_float(Ver) of
- {Vsn, _} when Vsn >= 24.1 ->
- true;
+ {Vsn, _} when Vsn >= AcceptVer ->
+ Vsn;
_ ->
- io:format("Emacs version fail~n~s~n~n",[Ver]),
false
end;
Res ->
@@ -127,16 +201,19 @@ emacs_version_ok() ->
false
end.
-emacs(File) ->
- EmacsErlDir = filename:join([code:lib_dir(tools), "emacs"]),
+emacs(EmacsCmds) when is_list(EmacsCmds) ->
Cmd = ["emacs ",
"--batch --quick ",
- "--directory ", EmacsErlDir, " ",
- "--eval \"(require 'erlang-start)\" ",
- File, " ",
- "--eval '(indent-region (point-min) (point-max) nil)' ",
- "--eval '(save-buffer 0)'"
- ],
- _Res = os:cmd(Cmd),
- % io:format("cmd ~s:~n=> ~s~n", [Cmd, _Res]),
- ok.
+ "--directory ", emacs_dir(), " ",
+ "--eval \"(require 'erlang-start)\" "
+ | EmacsCmds],
+ Res0 = os:cmd(Cmd ++ " ; echo $?"),
+ Rows = string:lexemes(Res0, ["\r\n", $\n]),
+ Res = lists:last(Rows),
+ Output = string:join(lists:droplast(Rows), "\n"),
+ io:format("Cmd ~s:~n => ~s ~ts~n", [Cmd, Res, Output]),
+ "0" = Res,
+ Output.
+
+emacs_dir() ->
+ filename:join([code:lib_dir(tools), "emacs"]).
diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl
index 5f2a21aa60..9fe49c6f5c 100644
--- a/lib/tools/test/eprof_SUITE_data/eed.erl
+++ b/lib/tools/test/eprof_SUITE_data/eed.erl
@@ -54,7 +54,7 @@ edit(Name) ->
loop(St0) ->
{ok, St1, Cmd} = get_line(St0),
- case catch command(lib:nonl(Cmd), St1) of
+ case catch command(nonl(Cmd), St1) of
{'EXIT', Reason} ->
%% XXX Should clear outstanding global command here.
loop(print_error({'EXIT', Reason}, St1));
@@ -66,6 +66,10 @@ loop(St0) ->
loop(St2)
end.
+nonl([$\n]) -> [];
+nonl([]) -> [];
+nonl([H|T]) -> [H|nonl(T)].
+
command(Cmd, St) ->
case parse_command(Cmd, St) of
quit ->
diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl
index 8fd164a4b3..ae0e7253ad 100644
--- a/lib/tools/test/fprof_SUITE.erl
+++ b/lib/tools/test/fprof_SUITE.erl
@@ -51,7 +51,7 @@
suite() ->
[{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,60}}].
+ {timetrap,{seconds,240}}].
all() ->
case test_server:is_native(fprof_SUITE) of
@@ -571,7 +571,7 @@ seq_r(Start, Stop, Succ, R) ->
create_file_slow(Name, N) when is_integer(N), N >= 0 ->
{ok, FD} =
- file:open(Name, [raw, write, delayed_write, binary]),
+ file:open(Name, [raw, write, binary]),
if N > 256 ->
ok = file:write(FD,
lists:map(fun (X) -> <<X:32/unsigned>> end,
diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl
index f37d28c277..8c521b2e1a 100644
--- a/lib/tools/test/instrument_SUITE.erl
+++ b/lib/tools/test/instrument_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -20,89 +20,274 @@
-module(instrument_SUITE).
-export([all/0, suite/0]).
--export(['+Mim true'/1, '+Mis true'/1]).
+
+-export([allocations_enabled/1, allocations_disabled/1, allocations_ramv/1,
+ carriers_enabled/1, carriers_disabled/1]).
+
+-export([test_all_alloc/2, test_per_alloc/2, test_format/3, test_abort/1,
+ generate_test_blocks/0, churn_memory/0]).
-include_lib("common_test/include/ct.hrl").
suite() ->
[{ct_hooks,[ts_install_cth]},
- {timetrap,{seconds,10}}].
+ {timetrap,{minutes,5}}].
all() ->
- ['+Mim true', '+Mis true'].
-
-
-%% Check that memory data can be read and processed
-'+Mim true'(Config) when is_list(Config) ->
- Node = start_slave("+Mim true"),
- MD = rpc:call(Node, instrument, memory_data, []),
- [{total,[{sizes,S1,S2,S3},{blocks,B1,B2,B3}]}]
- = rpc:call(Node, instrument, memory_status, [total]),
- stop_slave(Node),
- true = S1 =< S2,
- true = S2 =< S3,
- true = B1 =< B2,
- true = B2 =< B3,
- MDS = instrument:sort(MD),
- {Low, High} = instrument:mem_limits(MDS),
- true = Low < High,
- {_, AL} = MDS,
- SumBlocks = instrument:sum_blocks(MD),
- case SumBlocks of
- N when is_integer(N) ->
- N = lists:foldl(fun ({_,_,Size,_}, Sum) ->
- Size+Sum
- end, 0, AL),
- true = N =< S3;
- Other ->
- ct:fail(Other)
+ [allocations_enabled, allocations_disabled, allocations_ramv,
+ carriers_enabled, carriers_disabled].
+
+-define(GENERATED_SBC_BLOCK_COUNT, 1000).
+-define(GENERATED_MBC_BLOCK_COUNT, ?GENERATED_SBC_BLOCK_COUNT).
+
+-define(GENERATED_BLOCK_COUNT, (?GENERATED_SBC_BLOCK_COUNT +
+ ?GENERATED_MBC_BLOCK_COUNT)).
+-define(GENERATED_CARRIER_COUNT, ?GENERATED_SBC_BLOCK_COUNT).
+
+allocations_test(Args, Plain, PerAlloc) ->
+ run_test(Args, fun(Node) ->
+ ok = rpc:call(Node, ?MODULE, test_all_alloc,
+ [fun instrument:allocations/0, Plain]),
+ ok = rpc:call(Node, ?MODULE, test_per_alloc,
+ [fun instrument:allocations/1, PerAlloc]),
+ ok = rpc:call(Node, ?MODULE, test_format,
+ [#{ histogram_start => 512,
+ histogram_width => 4 },
+ fun instrument:allocations/1,
+ fun verify_allocations_output/2]),
+ ok = rpc:call(Node, ?MODULE, test_abort,
+ [fun erts_internal:gather_alloc_histograms/1])
+ end).
+
+allocations_enabled(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags true",
+ fun verify_allocations_enabled/1,
+ fun verify_allocations_enabled/2).
+
+allocations_disabled(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags false",
+ fun verify_allocations_disabled/1,
+ fun verify_allocations_disabled/2).
+
+allocations_ramv(Config) when is_list(Config) ->
+ allocations_test("+Meamax +Muatags true +Muramv true",
+ fun verify_allocations_enabled/1,
+ fun verify_allocations_enabled/2).
+
+verify_allocations_disabled(_AllocType, Result) ->
+ verify_allocations_disabled(Result).
+
+verify_allocations_disabled({error, not_enabled}) ->
+ ok.
+
+%% Skip types that have unstable results or are unaffected by +Muatags
+verify_allocations_enabled(literal_alloc, _Result) -> ok;
+verify_allocations_enabled(exec_alloc, _Result) -> ok;
+verify_allocations_enabled(temp_alloc, _Result) -> ok;
+verify_allocations_enabled(sl_alloc, _Result) -> ok;
+verify_allocations_enabled(_AllocType, Result) ->
+ verify_allocations_enabled(Result).
+
+verify_allocations_enabled({ok, {_HistStart, _UnscannedBytes, Allocs}}) ->
+ true = Allocs =/= #{}.
+
+verify_allocations_output(#{ histogram_start := HistStart,
+ histogram_width := HistWidth },
+ {ok, {HistStart, _UnscannedBytes, ByOrigin}}) ->
+ AllHistograms = lists:flatten([maps:values(ByType) ||
+ ByType <- maps:values(ByOrigin)]),
+
+ %% Do the histograms look alright?
+ HistogramSet = ordsets:from_list(AllHistograms),
+ Verified = [H || H <- HistogramSet,
+ tuple_size(H) =:= HistWidth,
+ hist_sum(H) >= 1],
+ [] = ordsets:subtract(HistogramSet, Verified),
+
+ %% Do we have at least as many blocks as we've generated?
+ BlockCount = lists:foldl(fun(Hist, Acc) ->
+ hist_sum(Hist) + Acc
+ end, 0, AllHistograms),
+ GenTotalBlockCount = ?GENERATED_BLOCK_COUNT,
+ GenSBCBlockCount = ?GENERATED_SBC_BLOCK_COUNT,
+ if
+ BlockCount < GenSBCBlockCount ->
+ ct:fail("Found ~p blocks, required at least ~p (SB)." ,
+ [BlockCount, GenSBCBlockCount]);
+ BlockCount >= GenTotalBlockCount ->
+ ct:pal("Found ~p blocks, expected at least ~p (SB + MB).",
+ [BlockCount, GenTotalBlockCount]);
+ BlockCount < GenTotalBlockCount ->
+ ct:pal("Found ~p blocks, expected at least ~p (SB + MB), but this "
+ "may be due to MBCs being skipped if they're about to be "
+ "scanned just as they're fetched from the carrier pool.",
+ [BlockCount, GenTotalBlockCount])
+ end,
+
+ ok;
+verify_allocations_output(#{}, {error, not_enabled}) ->
+ ok.
+
+%% %% %% %% %% %%
+
+carriers_test(Args, Plain, PerAlloc) ->
+ run_test(Args, fun(Node) ->
+ ok = rpc:call(Node, ?MODULE, test_all_alloc,
+ [fun instrument:carriers/0, Plain]),
+ ok = rpc:call(Node, ?MODULE, test_per_alloc,
+ [fun instrument:carriers/1, PerAlloc]),
+ ok = rpc:call(Node, ?MODULE, test_format,
+ [#{ histogram_start => 1024,
+ histogram_width => 4 },
+ fun instrument:carriers/1,
+ fun verify_carriers_output/2]),
+ ok = rpc:call(Node, ?MODULE, test_abort,
+ [fun erts_internal:gather_carrier_info/1])
+ end).
+
+carriers_enabled(Config) when is_list(Config) ->
+ carriers_test("+Meamax",
+ fun verify_carriers_enabled/1,
+ fun verify_carriers_enabled/2).
+
+carriers_disabled(Config) when is_list(Config) ->
+ carriers_test("+Meamin",
+ fun verify_carriers_disabled/1,
+ fun verify_carriers_disabled/2).
+
+verify_carriers_disabled(_AllocType, Result) ->
+ verify_carriers_disabled(Result).
+
+verify_carriers_disabled({error, not_enabled}) ->
+ ok;
+verify_carriers_disabled({ok, {_HistStart, Carriers}}) ->
+ verify_carriers_disabled_1(Carriers).
+
+verify_carriers_disabled_1([]) ->
+ ok;
+%% literal_alloc, exec_alloc, and temp_alloc can't be disabled, so we have to
+%% accept their presence in carriers_disabled/test_all_alloc.
+verify_carriers_disabled_1([Carrier | Rest]) when
+ element(1, Carrier) =:= literal_alloc;
+ element(1, Carrier) =:= exec_alloc;
+ element(1, Carrier) =:= temp_alloc ->
+ verify_carriers_disabled_1(Rest).
+
+%% exec_alloc only has a carrier if it's actually used.
+verify_carriers_enabled(exec_alloc, _Result) -> ok;
+verify_carriers_enabled(_AllocType, Result) -> verify_carriers_enabled(Result).
+
+verify_carriers_enabled({ok, {_HistStart, Carriers}}) when Carriers =/= [] ->
+ ok.
+
+verify_carriers_output(#{ histogram_start := HistStart,
+ histogram_width := HistWidth },
+ {ok, {HistStart, AllCarriers}}) ->
+
+ %% Do the carriers look alright?
+ CarrierSet = ordsets:from_list(AllCarriers),
+ Verified = [C || {AllocType,
+ TotalSize,
+ UnscannedSize,
+ AllocatedSize,
+ AllocatedCount,
+ InPool,
+ FreeBlockHist} = C <- CarrierSet,
+ is_atom(AllocType),
+ is_integer(TotalSize), TotalSize >= 1,
+ is_integer(UnscannedSize), UnscannedSize < TotalSize,
+ UnscannedSize >= 0,
+ is_integer(AllocatedSize), AllocatedSize < TotalSize,
+ AllocatedSize >= 0,
+ is_integer(AllocatedCount), AllocatedCount =< AllocatedSize,
+ AllocatedCount >= 0,
+ is_boolean(InPool),
+ tuple_size(FreeBlockHist) =:= HistWidth,
+ carrier_block_check(AllocatedCount, FreeBlockHist)],
+ [] = ordsets:subtract(CarrierSet, Verified),
+
+ %% Do we have at least as many carriers as we've generated?
+ CarrierCount = length(AllCarriers),
+ GenSBCCount = ?GENERATED_SBC_BLOCK_COUNT,
+ if
+ CarrierCount < GenSBCCount ->
+ ct:fail("Carrier count is ~p, expected at least ~p (SBC).",
+ [CarrierCount, GenSBCCount]);
+ CarrierCount >= GenSBCCount ->
+ ok
end,
- lists:foldl(
- fun ({TDescr,Addr,Size,Proc}, MinAddr) ->
- true = TDescr /= invalid_type,
- true = is_integer(TDescr),
- true = is_integer(Addr),
- true = is_integer(Size),
- true = Addr >= MinAddr,
- case Proc of
- {0, Number, Serial} ->
- true = is_integer(Number),
- true = is_integer(Serial);
- undefined ->
- ok;
- BadProc ->
- ct:fail({badproc, BadProc})
- end,
- NextMinAddr = Addr+Size,
- true = NextMinAddr =< High,
- NextMinAddr
- end, Low, AL),
- {_, DAL} = instrument:descr(MDS),
- lists:foreach(
- fun ({TDescr,_,_,Proc}) ->
- true = TDescr /= invalid_type,
- true = is_atom(TDescr) orelse is_list(TDescr),
- true = is_pid(Proc) orelse Proc == undefined
- end, DAL),
- ASL = lists:map(fun ({_,A,S,_}) -> {A,S} end, AL),
- ASL = lists:map(fun ({_,A,S,_}) -> {A,S} end, DAL),
- instrument:holes(MDS),
- {comment, "total status - sum of blocks = " ++ integer_to_list(S1-SumBlocks)}.
-
-%% Check that memory data can be read and processed
-'+Mis true'(Config) when is_list(Config) ->
- Node = start_slave("+Mis true"),
- [{total,[{sizes,S1,S2,S3},{blocks,B1,B2,B3}]}]
- = rpc:call(Node, instrument, memory_status, [total]),
- true = S1 =< S2,
- true = S2 =< S3,
- true = B1 =< B2,
- true = B2 =< B3,
- true = is_list(rpc:call(Node,instrument,memory_status,[allocators])),
- true = is_list(rpc:call(Node,instrument,memory_status,[classes])),
- true = is_list(rpc:call(Node,instrument,memory_status,[types])),
+
+ ok;
+verify_carriers_output(#{}, {error, not_enabled}) ->
+ ok.
+
+carrier_block_check(AllocCount, FreeHist) ->
+ %% A carrier must contain at least one block, and th. number of free blocks
+ %% must not exceed the number of allocated blocks + 1.
+ FreeCount = hist_sum(FreeHist),
+
+ (AllocCount + FreeCount) >= 1 andalso FreeCount =< (AllocCount + 1).
+
+%% %% %% %% %% %%
+
+test_all_alloc(Gather, Verify) ->
+ Verify(Gather()),
ok.
+test_per_alloc(Gather, Verify) ->
+ [begin
+ Verify(T, Gather(#{ allocator_types => [T] }))
+ end || T <- erlang:system_info(alloc_util_allocators)],
+ ok.
+
+test_format(#{ allocator_types := _ }, _, _) ->
+ error(badarg);
+test_format(Options0, Gather, Verify) ->
+ %% We limit format checking to binary_alloc since we generated the test
+ %% vectors there.
+ Options = Options0#{ allocator_types => [binary_alloc] },
+ Verify(Options, Gather(Options)),
+ ok.
+
+test_abort(Gather) ->
+ %% There's no way for us to tell whether this actually aborted or ran to
+ %% completion, but it might catch a few segfaults.
+ Runner = self(),
+ Ref = make_ref(),
+ spawn_opt(fun() ->
+ [Gather({Type, SchedId, 1, 1, Ref}) ||
+ Type <- erlang:system_info(alloc_util_allocators),
+ SchedId <- lists:seq(0, erlang:system_info(schedulers))],
+ Runner ! Ref
+ end, [{priority, max}]),
+ receive
+ Ref -> ok
+ end.
+
+hist_sum(H) -> hist_sum_1(H, tuple_size(H), 0).
+hist_sum_1(_H, 0, A) -> A;
+hist_sum_1(H, N, A) -> hist_sum_1(H, N - 1, element(N, H) + A).
+
+%%
+
+run_test(Args0, Test) ->
+ %% Override single-block carrier threshold for binaries to ensure we have
+ %% coverage for that path. generate_test_blocks builds a few binaries that
+ %% crosses this threshold.
+ %%
+ %% We also set the abandon carrier threshold to 70% to provoke more
+ %% activity in the carrier pool.
+ Args = Args0 ++ " +MBsbct 1 +Muacul 70",
+ Node = start_slave(Args),
+
+ ok = rpc:call(Node, ?MODULE, generate_test_blocks, []),
+ ok = Test(Node),
+
+ ok = rpc:call(Node, ?MODULE, churn_memory, []),
+ ok = Test(Node),
+
+ true = test_server:stop_node(Node).
+
start_slave(Args) ->
MicroSecs = erlang:monotonic_time(),
Name = "instr" ++ integer_to_list(MicroSecs),
@@ -112,6 +297,60 @@ start_slave(Args) ->
[{args, "-pa " ++ Pa ++ " " ++ Args}]),
Node.
+generate_test_blocks() ->
+ Runner = self(),
+ Ref = make_ref(),
+ spawn(fun() ->
+ %% We've set the single-block carrier threshold to 1KB so one
+ %% ought to land in a SBC and the other in a MBC. Both are kept
+ %% alive forever.
+ SBCs = [<<I, 0:(1 bsl 10)/unit:8>> ||
+ I <- lists:seq(1, ?GENERATED_SBC_BLOCK_COUNT)],
+ MBCs = [<<I, 0:64/unit:8>> ||
+ I <- lists:seq(1, ?GENERATED_MBC_BLOCK_COUNT)],
+ Runner ! Ref,
+ receive after infinity -> ok end,
+ unreachable ! {SBCs, MBCs}
+ end),
+ receive
+ Ref -> ok
+ end.
-stop_slave(Node) ->
- true = test_server:stop_node(Node).
+churn_memory() ->
+ %% All processes spawned from here on have 'low' priority to avoid starving
+ %% others (e.g. the rpc process) which could cause the test to time out.
+ [begin
+ churn_list_to_binary(),
+ churn_processes(),
+ churn_ets()
+ end || _ <- lists:seq(1, erlang:system_info(schedulers))],
+ ok.
+
+churn_processes() ->
+ Pid = spawn_opt(fun churn_processes/0, [{priority, low}]),
+ [Pid ! <<I, 0:128/unit:8>> || I <- lists:seq(1, 128)].
+
+%% Nearly all types have a few allocations at all times but sl_alloc is
+%% often empty. list_to_binary on large inputs will yield and spill the
+%% state into an 'estack' which is allocated through sl_alloc.
+%%
+%% This is inherently unstable so we skip the verification step for this
+%% type, but there's still a point to hammering it.
+churn_list_to_binary() ->
+ List = binary_to_list(<<0:(1 bsl 20)/unit:8>>),
+ spawn_opt(fun() -> churn_list_to_binary_1(List) end, [{priority, low}]).
+
+churn_list_to_binary_1(List) ->
+ _ = id(list_to_binary(List)),
+ churn_list_to_binary_1(List).
+
+churn_ets() ->
+ spawn_opt(fun() -> churn_ets_1(ets:new(gurka, [])) end, [{priority, low}]).
+
+churn_ets_1(Tab) ->
+ ets:insert(Tab, {gaffel, lists:seq(1, 16)}),
+ ets:delete_all_objects(Tab),
+ churn_ets_1(Tab).
+
+id(I) ->
+ I.
diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl
index a79572a742..8a2f6bfc89 100644
--- a/lib/tools/test/lcnt_SUITE.erl
+++ b/lib/tools/test/lcnt_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl
index d651cbcfee..da4f56c09b 100644
--- a/lib/tools/test/xref_SUITE.erl
+++ b/lib/tools/test/xref_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1112,27 +1112,16 @@ read_expected(Version) ->
{POS7+2,{FF,{erlang,spawn_opt,4}}},
{POS8+1,{FF,{hej,san,1}}},
{POS8+4,{FF,{a,b,1}}},
- {POS8+4,{FF,{erlang,apply,2}}},
- {POS8+5,{FF,{erlang,apply,2}}},
{POS8+6,{FF,{m,f,1}}},
{POS9+1,{FF,{read,bi,0}}},
{POS9+2,{FF,{a,b,1}}},
- {POS9+2,{FF,{erlang,apply,2}}},
- {POS9+3,{FF,{erlang,apply,2}}},
- {POS9+4,{FF,{erlang,apply,2}}},
{POS9+4,{FF,{erlang,not_a_function,1}}},
{POS9+5,{FF,{mod,func,2}}},
{POS9+6,{FF,{erlang,apply,1}}},
- {POS9+7,{FF,{erlang,apply,2}}},
{POS9+7,{FF,{math,add3,1}}},
{POS9+8,{FF,{q,f,1}}},
- {POS10+4,{FF,{erlang,apply,2}}},
{POS10+5,{FF,{mod1,fun1,1}}},
- {POS11+6,{FF,{erlang,apply,2}}},
- {POS12+1,{FF,{erlang,apply,2}}},
- {POS12+4,{FF,{erlang,apply,2}}},
{POS12+5,{FF,{m3,f3,2}}},
- {POS12+7,{FF,{erlang,apply,2}}},
{POS13+1,{FF,{dm,df,1}}},
{POS13+6,{{read,bi,0},{foo,module_info,0}}},
{POS13+7,{{read,bi,0},{read,module_info,0}}},
@@ -1162,15 +1151,26 @@ read_expected(Version) ->
{POS3+3, {FF,{erlang,spawn_link,3}}},
{POS3+4, {FF,{erlang,spawn_link,3}}},
{POS6+4, {FF,{erlang,spawn,3}}},
+ {POS8+4,{FF,{erlang,apply,2}}},
+ {POS8+5,{FF,{erlang,apply,2}}},
{POS8+6,{FF,{erlang,apply,3}}},
{POS8+7,{FF,{erlang,apply,3}}},
{POS9+1,{FF,{erlang,apply,3}}},
+ {POS9+2,{FF,{erlang,apply,2}}},
+ {POS9+3,{FF,{erlang,apply,2}}},
+ {POS9+4,{FF,{erlang,apply,2}}},
{POS9+5,{FF,{erlang,apply,3}}},
+ {POS9+7,{FF,{erlang,apply,2}}},
+ {POS10+4,{FF,{erlang,apply,2}}},
{POS11+1,{FF,{erlang,apply,3}}},
{POS11+2,{FF,{erlang,apply,3}}},
{POS11+3,{FF,{erlang,apply,3}}},
{POS11+4,{FF,{erlang,apply,3}}},
+ {POS11+6,{FF,{erlang,apply,2}}},
+ {POS12+1,{FF,{erlang,apply,2}}},
+ {POS12+4,{FF,{erlang,apply,2}}},
{POS12+5,{FF,{erlang,apply,3}}},
+ {POS12+7,{FF,{erlang,apply,2}}},
{POS12+8,{FF,{erlang,apply,3}}},
{POS13+5, {{read,bi,0},{erlang,length,1}}},
{POS14+3, {{read,bi,0},{erlang,length,1}}}],
@@ -2233,18 +2233,18 @@ variables(Conf) when is_list(Conf) ->
{{error, _, _}, _} = xref_base:variables(S108, [{verbose,false}]),
{ok, S109} = xref_base:set_library_path(S108, [], [{verbose,false}]),
- Tabs = length(ets:all()),
+ NoOfTables = erlang:system_info(ets_count),
{ok, S110} = eval("Eplus := closure E, TT := Eplus",
'closure()', S109),
{{ok, [{user, ['Eplus','TT']}]}, S111} = xref_base:variables(S110),
{ok, S112} = xref_base:forget(S111, ['TT','Eplus']),
- true = Tabs =:= length(ets:all()),
+ true = NoOfTables =:= erlang:system_info(ets_count),
{ok, NS0} = eval("Eplus := closure E", 'closure()', S112),
{{ok, [{user, ['Eplus']}]}, NS} = xref_base:variables(NS0),
ok = xref_base:delete(NS),
- true = Tabs =:= length(ets:all()),
+ true = NoOfTables =:= erlang:system_info(ets_count),
ok = file:delete(Beam),
ok.