1: %%
    2: %% %CopyrightBegin%
    3: %% 
    4: %% Copyright Ericsson AB 2003-2013. All Rights Reserved.
    5: %% 
    6: %% The contents of this file are subject to the Erlang Public License,
    7: %% Version 1.1, (the "License"); you may not use this file except in
    8: %% compliance with the License. You should have received a copy of the
    9: %% Erlang Public License along with this software. If not, it can be
   10: %% retrieved online at http://www.erlang.org/.
   11: %% 
   12: %% Software distributed under the License is distributed on an "AS IS"
   13: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
   14: %% the License for the specific language governing rights and limitations
   15: %% under the License.
   16: %% 
   17: %% %CopyrightEnd%
   18: 
   19: -module(alloc_SUITE).
   20: -author('rickard.green@uab.ericsson.se').
   21: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   22: 	 init_per_group/2,end_per_group/2]).
   23: 
   24: -export([basic/1,
   25: 	 coalesce/1,
   26: 	 threads/1,
   27: 	 realloc_copy/1,
   28: 	 bucket_index/1,
   29: 	 bucket_mask/1,
   30: 	 rbtree/1,
   31: 	 mseg_clear_cache/1,
   32: 	 erts_mmap/1,
   33: 	 cpool/1]).
   34: 
   35: -export([init_per_testcase/2, end_per_testcase/2]).
   36: 
   37: -include_lib("test_server/include/test_server.hrl").
   38: 
   39: -define(DEFAULT_TIMETRAP_SECS, 240).
   40: 
   41: suite() -> [{ct_hooks,[ts_install_cth]}].
   42: 
   43: all() -> 
   44:     [basic, coalesce, threads, realloc_copy, bucket_index,
   45:      bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool].
   46: 
   47: groups() -> 
   48:     [].
   49: 
   50: init_per_suite(Config) ->
   51:     Config.
   52: 
   53: end_per_suite(_Config) ->
   54:     ok.
   55: 
   56: init_per_group(_GroupName, Config) ->
   57:     Config.
   58: 
   59: end_per_group(_GroupName, Config) ->
   60:     Config.
   61: 
   62: 
   63: 
   64: init_per_testcase(Case, Config) when is_list(Config) ->
   65:     Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)),
   66:     [{watchdog, Dog},{testcase, Case}|Config].
   67: 
   68: end_per_testcase(_Case, Config) when is_list(Config) ->
   69:     Dog = ?config(watchdog, Config),
   70:     ?t:timetrap_cancel(Dog),
   71:     ok.
   72: 
   73: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   74: %%                                                                        %%
   75: %% Testcases                                                              %%
   76: %%                                                                        %%
   77: 
   78: basic(suite) -> [];
   79: basic(doc) ->   [];
   80: basic(Cfg) -> ?line drv_case(Cfg).
   81: 
   82: coalesce(suite) -> [];
   83: coalesce(doc) ->   [];
   84: coalesce(Cfg) -> ?line drv_case(Cfg).
   85: 
   86: threads(suite) -> [];
   87: threads(doc) ->   [];
   88: threads(Cfg) -> ?line drv_case(Cfg).
   89: 
   90: realloc_copy(suite) -> [];
   91: realloc_copy(doc) ->   [];
   92: realloc_copy(Cfg) -> ?line drv_case(Cfg).
   93: 
   94: bucket_index(suite) -> [];
   95: bucket_index(doc) ->   [];
   96: bucket_index(Cfg) -> ?line drv_case(Cfg).
   97: 
   98: bucket_mask(suite) -> [];
   99: bucket_mask(doc) ->   [];
  100: bucket_mask(Cfg) -> ?line drv_case(Cfg).
  101: 
  102: rbtree(suite) -> [];
  103: rbtree(doc) ->   [];
  104: rbtree(Cfg) -> ?line drv_case(Cfg).
  105: 
  106: mseg_clear_cache(suite) -> [];
  107: mseg_clear_cache(doc) ->   [];
  108: mseg_clear_cache(Cfg) -> ?line drv_case(Cfg).
  109: 
  110: cpool(suite) -> [];
  111: cpool(doc) ->   [];
  112: cpool(Cfg) -> ?line drv_case(Cfg).
  113: 
  114: erts_mmap(Config) when is_list(Config) ->
  115:     case {?t:os_type(), is_halfword_vm()} of
  116: 	{{unix, _}, false} ->
  117: 	    [erts_mmap_do(Config, SCO, SCRPM, SCRFSD)
  118: 	     || SCO <-[true,false], SCRFSD <-[1234,0], SCRPM <- [true,false]];
  119: 
  120: 	{_,true} ->
  121: 	    {skipped, "No supercarrier support on halfword vm"};
  122: 	{SkipOs,_} ->
  123: 	    ?line {skipped,
  124: 		   lists:flatten(["Not run on "
  125: 				  | io_lib:format("~p",[SkipOs])])}
  126:     end.
  127: 
  128: 
  129: erts_mmap_do(Config, SCO, SCRPM, SCRFSD) ->
  130:     %% We use the number of schedulers + 1 * approx main carriers size
  131:     %% to calculate how large the super carrier has to be
  132:     %% and then use a minimum of 100 for systems with a low amount of
  133:     %% schedulers
  134:     Schldr = erlang:system_info(schedulers_online)+1,
  135:     SCS = max(round((262144 * 6 + 3 * 1048576) * Schldr / 1024 / 1024),100),
  136:     O1 = "+MMscs" ++ integer_to_list(SCS)
  137: 	++ " +MMsco" ++ atom_to_list(SCO)
  138: 	++ " +MMscrpm" ++ atom_to_list(SCRPM),
  139:     Opts = case SCRFSD of
  140: 	       0 -> O1;
  141: 	       _ -> O1 ++ " +MMscrfsd"++integer_to_list(SCRFSD)
  142: 	   end,
  143:     {ok, Node} = start_node(Config, Opts),
  144:     Self = self(),
  145:     Ref = make_ref(),
  146:     F = fun () ->
  147: 		SI = erlang:system_info({allocator,mseg_alloc}),
  148: 		{erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI),
  149: 		{supercarrier,SC} = lists:keyfind(supercarrier, 1, EM),
  150: 		{sizes,Sizes} = lists:keyfind(sizes, 1, SC),
  151: 		{free_segs,Segs} = lists:keyfind(free_segs,1,SC),
  152: 		{total,Total} = lists:keyfind(total,1,Sizes),
  153: 		Total = SCS*1024*1024,
  154: 
  155: 		{reserved,Reserved} = lists:keyfind(reserved,1,Segs),
  156: 		true = (Reserved >= SCRFSD),
  157: 
  158: 		case {SCO,lists:keyfind(os,1,EM)} of
  159: 		    {true, false} -> ok;
  160: 		    {false, {os,_}} -> ok
  161: 		end,
  162: 
  163: 		Self ! {Ref, ok}
  164: 	end,
  165: 
  166:     spawn_link(Node, F),
  167:     Result = receive {Ref, Rslt} -> Rslt end,
  168:     stop_node(Node),
  169:     Result.
  170: 
  171: 
  172: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  173: %%                                                                        %%
  174: %% Internal functions                                                     %%
  175: %%                                                                        %%
  176: 
  177: drv_case(Config) ->
  178:     drv_case(Config, "").
  179: 
  180: drv_case(Config, Command) when is_list(Config),
  181: 			       is_list(Command) ->
  182:     case ?t:os_type() of
  183: 	{Family, _} when Family == unix; Family == win32 ->
  184: 	    ?line {ok, Node} = start_node(Config),
  185: 	    ?line Self = self(),
  186: 	    ?line Ref = make_ref(),
  187: 	    ?line spawn_link(Node,
  188: 			     fun () ->
  189: 				     Res = run_drv_case(Config, Command),
  190: 				     Self ! {Ref, Res}
  191: 			     end),
  192: 	    ?line Result = receive {Ref, Rslt} -> Rslt end,
  193: 	    ?line stop_node(Node),
  194: 	    ?line Result;
  195: 	SkipOs ->
  196: 	    ?line {skipped,
  197: 		   lists:flatten(["Not run on "
  198: 				  | io_lib:format("~p",[SkipOs])])}
  199:     end.
  200: 
  201: run_drv_case(Config, Command) ->
  202:     ?line DataDir = ?config(data_dir,Config),
  203:     ?line CaseName = ?config(testcase,Config),
  204:     case erl_ddll:load_driver(DataDir, CaseName) of
  205: 	ok -> ok;
  206: 	{error, Error} ->
  207: 	    io:format("~s\n", [erl_ddll:format_error(Error)]),
  208: 	    ?line ?t:fail()
  209:     end,
  210:     ?line Port = open_port({spawn, atom_to_list(CaseName)}, []),
  211:     ?line true = is_port(Port),
  212:     ?line Port ! {self(), {command, Command}},
  213:     ?line Result = receive_drv_result(Port, CaseName),
  214:     ?line Port ! {self(), close},
  215:     ?line receive 
  216: 	      {Port, closed} ->
  217: 		  ok
  218: 	  end,
  219:     ?line ok = erl_ddll:unload_driver(CaseName),
  220:     ?line Result.
  221: 
  222: receive_drv_result(Port, CaseName) ->
  223:     ?line receive
  224: 	      {print, Port, CaseName, Str} ->
  225: 		  ?line ?t:format("~s", [Str]),
  226: 		  ?line receive_drv_result(Port, CaseName);
  227: 	      {'EXIT', Port, Error} ->
  228: 		  ?line ?t:fail(Error);
  229: 	      {'EXIT', error, Error} ->
  230: 		  ?line ?t:fail(Error);
  231: 	      {failed, Port, CaseName, Comment} ->
  232: 		  ?line ?t:fail(Comment);
  233: 	      {skipped, Port, CaseName, Comment} ->
  234: 		  ?line {skipped, Comment};
  235: 	      {succeeded, Port, CaseName, ""} ->
  236: 		  ?line succeeded;
  237: 	      {succeeded, Port, CaseName, Comment} ->
  238: 		  ?line {comment, Comment}
  239: 	  end.
  240: 
  241: start_node(Config) ->
  242:     start_node(Config, []).
  243: start_node(Config, Opts) when is_list(Config), is_list(Opts) ->
  244:     ?line Pa = filename:dirname(code:which(?MODULE)),
  245:     ?line {A, B, C} = now(),
  246:     ?line Name = list_to_atom(atom_to_list(?MODULE)
  247: 			      ++ "-"
  248: 			      ++ atom_to_list(?config(testcase, Config))
  249: 			      ++ "-"
  250: 			      ++ integer_to_list(A)
  251: 			      ++ "-"
  252: 			      ++ integer_to_list(B)
  253: 			      ++ "-"
  254: 			      ++ integer_to_list(C)),
  255:     ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
  256: 
  257: stop_node(Node) ->
  258:     ?t:stop_node(Node).
  259: 
  260: is_halfword_vm() ->
  261:     case {erlang:system_info({wordsize, internal}),
  262: 	  erlang:system_info({wordsize, external})} of
  263: 	{4, 8} -> true;
  264: 	{WS, WS} -> false
  265:     end.