path: root/lib/kernel/test/bif_SUITE.erl

%%
%% %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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_integer(X) ->
    integer_to_list(X);
to_string(X) when is_atom(X) ->
    atom_to_list(X);
to_string(X) when is_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.