aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel/test/bif_SUITE.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/kernel/test/bif_SUITE.erl')
-rw-r--r--lib/kernel/test/bif_SUITE.erl649
1 files changed, 649 insertions, 0 deletions
diff --git a/lib/kernel/test/bif_SUITE.erl b/lib/kernel/test/bif_SUITE.erl
new file mode 100644
index 0000000000..c78d82659f
--- /dev/null
+++ b/lib/kernel/test/bif_SUITE.erl
@@ -0,0 +1,649 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(bif_SUITE).
+-export([all/1]).
+
+-export([spawn_tests/1,
+ spawn1/1, spawn2/1, spawn3/1, spawn4/1,
+
+ spawn_link_tests/1,
+ spawn_link1/1, spawn_link2/1, spawn_link3/1, spawn_link4/1,
+
+ spawn_opt_tests/1,
+ spawn_opt2/1, spawn_opt3/1, spawn_opt4/1, spawn_opt5/1,
+
+ spawn_failures/1,
+
+ run_fun/1,
+ wilderness/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+-include("test_server.hrl").
+
+% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog = ?t:timetrap(?default_timeout),
+ [{watchdog, Dog} | Config].
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+all(suite) ->
+ [spawn_tests, spawn_link_tests, spawn_opt_tests, spawn_failures, wilderness].
+
+spawn_tests(doc) -> ["Test spawn"];
+spawn_tests(suite) ->
+ [spawn1, spawn2, spawn3, spawn4].
+
+spawn_link_tests(doc) -> ["Test spawn_link"];
+spawn_link_tests(suite) ->
+ [spawn_link1, spawn_link2, spawn_link3, spawn_link4].
+
+spawn_opt_tests(doc) -> ["Test spawn_opt"];
+spawn_opt_tests(suite) ->
+ [spawn_opt2, spawn_opt3, spawn_opt4, spawn_opt5].
+
+spawn1(doc) -> ["Test spawn/1"];
+spawn1(suite) ->
+ [];
+spawn1(Config) when list(Config) ->
+ ?line Node = node(),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn
+ ?line P = spawn(fun() -> Parent ! {self(), fetch_proc_vals(self())} end),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(false, normal, FA, 0, PV)
+ end,
+ ok.
+
+spawn2(doc) -> ["Test spawn/2"];
+spawn2(suite) ->
+ [];
+spawn2(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn2),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn(Node,
+ fun() -> Parent ! {self(), fetch_proc_vals(self())} end),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(false, normal, FA, 0, PV)
+ end,
+
+ ?line true = stop_node(Node),
+ ok.
+
+
+spawn3(doc) -> ["Test spawn/3"];
+spawn3(suite) ->
+ [];
+spawn3(Config) when list(Config) ->
+ ?line Node = node(),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn(?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end]),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(false, normal, FA, 0, PV)
+ end,
+ ok.
+
+spawn4(doc) -> ["Test spawn/4"];
+spawn4(suite) ->
+ [];
+spawn4(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn4),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn(Node,
+ ?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end]),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(false, normal, FA, 0, PV)
+ end,
+
+ ?line true = stop_node(Node),
+ ok.
+
+
+
+spawn_link1(doc) -> ["Test spawn_link/1"];
+spawn_link1(suite) ->
+ [];
+spawn_link1(Config) when list(Config) ->
+ ?line Node = node(),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn_link(fun() -> Parent ! {self(), fetch_proc_vals(self())} end),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(true, normal, FA, 0, PV)
+ end,
+ ok.
+
+spawn_link2(doc) -> ["Test spawn_link/2"];
+spawn_link2(suite) ->
+ [];
+spawn_link2(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn_link2),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn_link(Node,
+ fun() -> Parent ! {self(), fetch_proc_vals(self())} end),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(true, normal, FA, 0, PV)
+ end,
+
+ ?line true = stop_node(Node),
+ ok.
+
+spawn_link3(doc) -> ["Test spawn_link/3"];
+spawn_link3(suite) ->
+ [];
+spawn_link3(Config) when list(Config) ->
+ ?line Node = node(),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn_link(?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end]),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(true, normal, FA, 0, PV)
+ end,
+ ok.
+
+spawn_link4(doc) -> ["Test spawn_link/4"];
+spawn_link4(suite) ->
+ [];
+spawn_link4(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn_link4),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn_link(Node,
+ ?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end]),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(true, normal, FA, 0, PV)
+ end,
+
+ ?line true = stop_node(Node),
+ ok.
+
+
+spawn_opt2(doc) -> ["Test spawn_opt/2"];
+spawn_opt2(suite) ->
+ [];
+spawn_opt2(Config) when list(Config) ->
+ ?line Node = node(),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ ?line P1 = spawn_opt(fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end,
+ case heap_type() of
+ separate ->
+ [{fullsweep_after, 0},{min_heap_size, 1000}];
+ shared ->
+ []
+ end
+ ++ [link, {priority, max}]),
+ ?line receive
+ {P1, PV1} ->
+ ?line Node = node(P1),
+ ?line check_proc_vals(true, max, 0, 1000, PV1)
+ end,
+ ?line P2 = spawn_opt(fun() -> Parent ! {self(), fetch_proc_vals(self())} end,
+ case heap_type() of
+ separate -> [{min_heap_size, 10}];
+ shared -> []
+ end),
+ ?line receive
+ {P2, PV2} ->
+ ?line Node = node(P2),
+ ?line check_proc_vals(false, normal, FA, 10, PV2)
+ end,
+ ok.
+
+spawn_opt3(doc) -> ["Test spawn_opt/3"];
+spawn_opt3(suite) ->
+ [];
+spawn_opt3(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn_opt3),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+ ?line P1 = spawn_opt(Node,
+ fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end,
+ case heap_type() of
+ separate ->
+ [{fullsweep_after,0}, {min_heap_size,1000}];
+ shared ->
+ []
+ end
+ ++ [link, {priority, max}]),
+ ?line receive
+ {P1, PV1} ->
+ ?line Node = node(P1),
+ ?line check_proc_vals(true, max, 0, 1000, PV1)
+ end,
+ ?line P2 = spawn_opt(Node,
+ fun() -> Parent ! {self(), fetch_proc_vals(self())} end,
+ case heap_type() of
+ separate -> [{min_heap_size, 10}];
+ shared -> []
+ end),
+ ?line receive
+ {P2, PV2} ->
+ ?line Node = node(P2),
+ ?line check_proc_vals(false, normal, FA, 10, PV2)
+ end,
+ ?line true = stop_node(Node),
+ ok.
+
+spawn_opt4(doc) -> ["Test spawn_opt/4"];
+spawn_opt4(suite) ->
+ [];
+spawn_opt4(Config) when list(Config) ->
+ ?line Node = node(),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+ ?line P1 = spawn_opt(?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end],
+ case heap_type() of
+ separate ->
+ [{fullsweep_after,0}, {min_heap_size,1000}];
+ shared ->
+ []
+ end
+ ++ [link, {priority, max}]),
+ ?line receive
+ {P1, PV1} ->
+ ?line Node = node(P1),
+ ?line check_proc_vals(true, max, 0, 1000, PV1)
+ end,
+ ?line P2 = spawn_opt(?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end],
+ case heap_type() of
+ separate -> [{min_heap_size, 10}];
+ shared -> []
+ end),
+ ?line receive
+ {P2, PV2} ->
+ ?line Node = node(P2),
+ ?line check_proc_vals(false, normal, FA, 10, PV2)
+ end,
+ ok.
+
+spawn_opt5(doc) -> ["Test spawn_opt/5"];
+spawn_opt5(suite) ->
+ [];
+spawn_opt5(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn_opt5),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+ ?line P1 = spawn_opt(Node,
+ ?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end],
+ case heap_type() of
+ separate ->
+ [{fullsweep_after,0}, {min_heap_size,1000}];
+ shared ->
+ []
+ end
+ ++ [link, {priority, max}]),
+ ?line receive
+ {P1, PV1} ->
+ ?line Node = node(P1),
+ ?line check_proc_vals(true, max, 0, 1000, PV1)
+ end,
+ ?line P2 = spawn_opt(Node,
+ ?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end],
+ case heap_type() of
+ separate -> [{min_heap_size, 10}];
+ shared -> []
+ end),
+ ?line receive
+ {P2, PV2} ->
+ ?line Node = node(P2),
+ ?line check_proc_vals(false, normal, FA, 10, PV2)
+ end,
+ ?line true = stop_node(Node),
+ ok.
+
+spawn_failures(doc) ->
+ ["Test failure behavior of spawn bifs"];
+spawn_failures(suite) ->
+ [];
+spawn_failures(Config) when list(Config) ->
+ ?line ThisNode = node(),
+ ?line {ok, Node} = start_node(spawn_remote_failure),
+
+ % unknown nodes
+ test_server:format("Testing unknown nodes~n", []),
+ ?line CrashPid1 = (catch spawn_opt('unknown@node',
+ erlang,
+ nodes,
+ [],
+ [])),
+ ?line true = is_pid(CrashPid1),
+ ?line ThisNode = node(CrashPid1),
+ ?line CrashPid2 = (catch spawn_opt('unknown@node',
+ fun () -> erlang:nodes() end,
+ [])),
+ ?line true = is_pid(CrashPid2),
+ ?line ThisNode = node(CrashPid2),
+
+ ?line CrashPid3 = (catch spawn('unknown@node',
+ erlang,
+ nodes,
+ [])),
+ ?line true = is_pid(CrashPid3),
+ ?line ThisNode = node(CrashPid3),
+ ?line CrashPid4 = (catch spawn('unknown@node',
+ fun () -> erlang:nodes() end)),
+ ?line true = is_pid(CrashPid4),
+ ?line ThisNode = node(CrashPid4),
+
+ ?line OTE = process_flag(trap_exit,true),
+ ?line CrashPid5 = (catch spawn_link('unknown@node',
+ erlang,
+ nodes,
+ [])),
+ receive
+ {'EXIT', CrashPid5, noconnection} ->
+ ?line true = is_pid(CrashPid5),
+ ?line ThisNode = node(CrashPid5)
+ end,
+ ?line CrashPid6 = (catch spawn_link('unknown@node',
+ fun () -> erlang:nodes() end)),
+ receive
+ {'EXIT', CrashPid6, noconnection} ->
+ ?line true = is_pid(CrashPid6),
+ ?line ThisNode = node(CrashPid6)
+ end,
+ process_flag(trap_exit,OTE),
+ case OTE of
+ false ->
+ receive
+ {'EXIT', P, R} ->
+ ?line test_server:fail({'EXIT', P, R})
+ after 0 ->
+ ok
+ end;
+ _ ->
+ ok
+ end,
+
+ % bad node
+ test_server:format("Testing bad nodes~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt("Node",erlang,nodes,[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt("Node",
+ fun () ->
+ erlang:nodes()
+ end,
+ [])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link("Node",
+ fun () ->
+ erlang:nodes()
+ end)),
+ ?line {'EXIT', {badarg, _}} = (catch spawn("Node",erlang,nodes,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn("Node",
+ fun () ->
+ erlang:nodes()
+ end)),
+
+ % bad module
+ test_server:format("Testing bad modules~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,"erlang",nodes,[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt("erlang",nodes,[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,"erlang",nodes,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link("erlang",nodes,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(Node,"erlang",nodes,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn("erlang",nodes,[])),
+
+ % bad function
+ test_server:format("Testing bad functions~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,"nodes",[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,not_a_fun,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,"nodes",[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(not_a_fun,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,erlang,"nodes",[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,not_a_fun)),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(erlang,"nodes",[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(not_a_fun)),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(Node,erlang,"nodes",[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(Node,not_a_fun)),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(erlang,"nodes",[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(not_a_fun)),
+
+
+ % bad argument
+ test_server:format("Testing bad arguments~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,nodes,[a|b],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,nodes,[a|b],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,erlang,nodes,[a|b])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(erlang,nodes,[a|b])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(Node,erlang,nodes,[a|b])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(erlang,nodes,[a|b])),
+
+ % bad option
+ test_server:format("Testing bad options~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,nodes,[],[a|b])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,nodes,[],[a|b])),
+
+
+ ?line true = stop_node(Node),
+ ok.
+
+check_proc_vals(Link, Priority, FullsweepAfter, MinHeapSize, {Ls, P, FA, HS}) ->
+ ?line Link = lists:member(self(), Ls),
+ ?line Priority = P,
+ ?line case heap_type() of
+ separate ->
+ ?line FullsweepAfter = FA,
+ ?line true = (HS >= MinHeapSize);
+ shared ->
+ ?line ok
+ end,
+ ?line ok.
+
+fetch_proc_vals(Pid) ->
+ ?line PI = process_info(Pid),
+ ?line {value,{links, Ls}} = lists:keysearch(links, 1, PI),
+ ?line {value,{priority,P}} = lists:keysearch(priority, 1, PI),
+ ?line {FA, HS}
+ = case heap_type() of
+ separate ->
+ ?line {value,
+ {garbage_collection,
+ Gs}} = lists:keysearch(garbage_collection, 1, PI),
+ ?line {value,
+ {fullsweep_after,
+ Fa}} = lists:keysearch(fullsweep_after, 1, Gs),
+ ?line {value,
+ {heap_size,Hs}} = lists:keysearch(heap_size, 1, PI),
+ ?line {Fa, Hs};
+ shared ->
+ {undefined, undefined}
+ end,
+ ?line {Ls, P, FA, HS}.
+
+% This testcase should probably be moved somewhere else
+wilderness(doc) ->
+ ["Test that memory allocation command line options affecting the"
+ "wilderness of the heap are interpreted correct by the emulator "];
+wilderness(suite) ->
+ [];
+wilderness(Config) when list(Config) ->
+ ?line Dog = ?t:timetrap(?default_timeout),
+ ?line OKParams = {512, 8},
+ ?line Alloc = erlang:system_info(allocator),
+ ?line test_server:format("Test server allocator info:~n~p", [Alloc]),
+ Result = case Alloc of
+ {Allocator, _, _, _} when Allocator == glibc;
+ Allocator == dlmalloc ->
+ ?line run_wilderness_test(OKParams, OKParams),
+ ?line {comment,
+ "Allocator used: " ++ atom_to_list(Allocator)};
+ {OtherAllocator, _, _, _} ->
+ ?line {skipped,
+ "Only run when glibc is used. "
+ "Allocator used: "
+ ++ atom_to_list(OtherAllocator)}
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ Result.
+
+run_wilderness_test({Set_tt, Set_tp}, {Exp_tt, Exp_tp}) ->
+ Self = self(),
+ Ref = make_ref(),
+ SuiteDir = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = test_server:start_node(allocator_test,
+ slave,
+ [{args,
+ " -pa "
+ ++ SuiteDir
+ ++" +MYtt "++to_string(Set_tt)
+ ++" +MYtp "++to_string(Set_tp)},
+ {linked, false}]),
+ spawn(Node, fun () ->
+ Self ! {Ref, erlang:system_info(allocator)}
+ end),
+ receive
+ {Ref, {A, V, F, S}} ->
+ Ett = Exp_tt*1024,
+ Etp = Exp_tp*1024,
+ ?line test_server:format("Test allocator info:~n~p",
+ [{A, V, F, S}]),
+ ?line {value, {sys_alloc, SA_Opts}}
+ = lists:keysearch(sys_alloc, 1, S),
+ ?line {value, {tt, Ett}} = lists:keysearch(tt, 1, SA_Opts),
+ ?line {value, {tp, Etp}} = lists:keysearch(tp, 1, SA_Opts)
+ end,
+ stop_node(Node).
+
+to_string(X) when integer(X) ->
+ integer_to_list(X);
+to_string(X) when atom(X) ->
+ atom_to_list(X);
+to_string(X) when list(X) ->
+ X.
+
+get_nodenames(N, T) ->
+ get_nodenames(N, T, []).
+
+get_nodenames(0, _, Acc) ->
+ Acc;
+get_nodenames(N, T, Acc) ->
+ {A, B, C} = now(),
+ get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(T)
+ ++ "-"
+ ++ integer_to_list(A)
+ ++ "-"
+ ++ integer_to_list(B)
+ ++ "-"
+ ++ integer_to_list(C)) | Acc]).
+
+start_node(TestCase) ->
+ ?line [Name] = get_nodenames(1, TestCase),
+ ?line Pa = filename:dirname(code:which(?MODULE)),
+ ?line test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]).
+
+stop_node(Node) ->
+ ?line true = test_server:stop_node(Node).
+
+run_fun(Fun) ->
+ Fun().
+
+heap_type() ->
+ case catch erlang:system_info(heap_type) of
+ shared -> shared;
+ unified -> shared;
+ _ -> separate
+ end.
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 14:55:30 +0000