1: %%
    2: %% %CopyrightBegin%
    3: %%
    4: %% Copyright Ericsson AB 2004-2012. 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: 
   20: %%%-------------------------------------------------------------------
   21: %%% File    : ethread_SUITE.erl
   22: %%% Author  : Rickard Green <rickard.s.green@ericsson.com>
   23: %%% Description : 
   24: %%%
   25: %%% Created : 17 Jun 2004 by Rickard Green <rickard.s.green@ericsson.com>
   26: %%%-------------------------------------------------------------------
   27: -module(ethread_SUITE).
   28: -author('rickard.s.green@ericsson.com').
   29: 
   30: %-define(line_trace, 1).
   31: 
   32: -define(DEFAULT_TIMEOUT, ?t:minutes(10)).
   33: 
   34: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   35: 	 init_per_group/2,end_per_group/2, 
   36: 	 init_per_testcase/2, end_per_testcase/2]).
   37: 
   38: -export([create_join_thread/1,
   39: 	 equal_tids/1,
   40: 	 mutex/1,
   41: 	 try_lock_mutex/1,
   42: 	 cond_wait/1,
   43: 	 broadcast/1,
   44: 	 detached_thread/1,
   45: 	 max_threads/1,
   46: 	 tsd/1,
   47: 	 spinlock/1,
   48: 	 rwspinlock/1,
   49: 	 rwmutex/1,
   50: 	 atomic/1,
   51: 	 dw_atomic_massage/1]).
   52: 
   53: -include_lib("test_server/include/test_server.hrl").
   54: 
   55: tests() ->
   56:     [create_join_thread,
   57:      equal_tids,
   58:      mutex,
   59:      try_lock_mutex,
   60:      cond_wait,
   61:      broadcast,
   62:      detached_thread,
   63:      max_threads,
   64:      tsd,
   65:      spinlock,
   66:      rwspinlock,
   67:      rwmutex,
   68:      atomic,
   69:      dw_atomic_massage].
   70: 
   71: suite() -> [{ct_hooks,[ts_install_cth]}].
   72: 
   73: all() -> 
   74:     tests().
   75: 
   76: groups() -> 
   77:     [].
   78: 
   79: init_per_suite(Config) ->
   80:     Config.
   81: 
   82: end_per_suite(_Config) ->
   83:     ok.
   84: 
   85: init_per_group(_GroupName, Config) ->
   86:     Config.
   87: 
   88: end_per_group(_GroupName, Config) ->
   89:     Config.
   90: 
   91: %%
   92: %%
   93: %% The test-cases
   94: %%
   95: %%
   96: 
   97: create_join_thread(doc) ->
   98:     ["Tests ethr_thr_create and ethr_thr_join."];
   99: create_join_thread(suite) ->
  100:     [];
  101: create_join_thread(Config) ->
  102:     run_case(Config, "create_join_thread", "").
  103: 
  104: equal_tids(doc) ->
  105:     ["Tests ethr_equal_tids."];
  106: equal_tids(suite) ->
  107:     [];
  108: equal_tids(Config) ->
  109:     run_case(Config, "equal_tids", "").
  110: 
  111: mutex(doc) ->
  112:     ["Tests mutexes."];
  113: mutex(suite) ->
  114:     [];
  115: mutex(Config) ->
  116:     run_case(Config, "mutex", "").
  117: 
  118: try_lock_mutex(doc) ->
  119:     ["Tests try lock on mutex."];
  120: try_lock_mutex(suite) ->
  121:     [];
  122: try_lock_mutex(Config) ->
  123:     run_case(Config, "try_lock_mutex", "").
  124: 
  125: %% Remove dead code?
  126: 
  127: % wd_dispatch(P) ->
  128: %     receive
  129: % 	bye ->
  130: % 	    ?line true = port_command(P, "-1 "),
  131: % 	    ?line bye;
  132: % 	L when is_list(L) ->
  133: % 	    ?line true = port_command(P, L),
  134: % 	    ?line wd_dispatch(P)
  135: %     end.
  136: % 
  137: % watchdog(Port) ->
  138: %     ?line process_flag(priority, max),
  139: %     ?line receive after 500 -> ok end,
  140: % 
  141: %     ?line random:seed(),
  142: %     ?line true = port_command(Port, "0 "),
  143: %     ?line lists:foreach(fun (T) ->
  144: % 				erlang:send_after(T,
  145: % 						  self(),
  146: % 						  integer_to_list(T)
  147: % 						  ++ " ")
  148: % 			end,
  149: % 			lists:usort(lists:map(fun (_) ->
  150: % 						      random:uniform(4500)+500
  151: % 					      end,
  152: % 					      lists:duplicate(50,0)))),
  153: %     ?line erlang:send_after(5100, self(), bye),
  154: % 
  155: %     wd_dispatch(Port).
  156: 
  157: cond_wait(doc) ->
  158:     ["Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast."];
  159: cond_wait(suite) ->
  160:     [];
  161: cond_wait(Config) ->
  162:     run_case(Config, "cond_wait", "").
  163: 
  164: broadcast(doc) ->
  165:     ["Tests that a ethr_cond_broadcast really wakes up all waiting threads"];
  166: broadcast(suite) ->
  167:     [];
  168: broadcast(Config) ->
  169:     run_case(Config, "broadcast", "").
  170: 
  171: detached_thread(doc) ->
  172:     ["Tests detached threads."];
  173: detached_thread(suite) ->
  174:     [];
  175: detached_thread(Config) ->
  176:     case {os:type(), os:version()} of
  177: 	{{unix,darwin}, {9, _, _}} ->
  178: 	    %% For some reason pthread_create() crashes when more
  179: 	    %% threads cannot be created, instead of returning an
  180: 	    %% error code on our MacOS X Leopard machine...
  181: 	    {skipped, "MacOS X Leopard cannot cope with this test..."};
  182: 	_ ->
  183: 	    run_case(Config, "detached_thread", "")
  184:     end.
  185: 
  186: max_threads(doc) ->
  187:     ["Tests maximum number of threads."];
  188: max_threads(suite) ->
  189:     [];
  190: max_threads(Config) ->
  191:     case {os:type(), os:version()} of
  192: 	{{unix,darwin}, {9, _, _}} ->
  193: 	    %% For some reason pthread_create() crashes when more
  194: 	    %% threads cannot be created, instead of returning an
  195: 	    %% error code on our MacOS X Leopard machine...
  196: 	    {skipped, "MacOS X Leopard cannot cope with this test..."};
  197: 	_ ->
  198: 	    run_case(Config, "max_threads", "")
  199:     end.
  200: 
  201: tsd(doc) ->
  202:     ["Tests thread specific data."];
  203: tsd(suite) ->
  204:     [];
  205: tsd(Config) ->
  206:     run_case(Config, "tsd", "").
  207: 
  208: spinlock(doc) ->
  209:     ["Tests spinlocks."];
  210: spinlock(suite) ->
  211:     [];
  212: spinlock(Config) ->
  213:     run_case(Config, "spinlock", "").
  214: 
  215: rwspinlock(doc) ->
  216:     ["Tests rwspinlocks."];
  217: rwspinlock(suite) ->
  218:     [];
  219: rwspinlock(Config) ->
  220:     run_case(Config, "rwspinlock", "").
  221: 
  222: rwmutex(doc) ->
  223:     ["Tests rwmutexes."];
  224: rwmutex(suite) ->
  225:     [];
  226: rwmutex(Config) ->
  227:     run_case(Config, "rwmutex", "").
  228: 
  229: atomic(doc) ->
  230:     ["Tests atomics."];
  231: atomic(suite) ->
  232:     [];
  233: atomic(Config) ->
  234:     run_case(Config, "atomic", "").
  235: 
  236: dw_atomic_massage(doc) ->
  237:     ["Massage double word atomics"];
  238: dw_atomic_massage(suite) ->
  239:     [];
  240: dw_atomic_massage(Config) ->
  241:     run_case(Config, "dw_atomic_massage", "").
  242: 
  243: %%
  244: %%
  245: %% Auxiliary functions
  246: %%
  247: %%
  248: 
  249: init_per_testcase(Case, Config) ->
  250:     case inet:gethostname() of
  251: 	{ok,"fenris"} when Case == max_threads ->
  252: 	    %% Cannot use os:type+os:version as not all
  253: 	    %% solaris10 machines are buggy.
  254: 	    {skip, "This machine is buggy"};
  255: 	_Else ->
  256: 	    Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
  257: 	    [{watchdog, Dog}|Config]
  258:     end.
  259: 
  260: end_per_testcase(_Case, Config) ->
  261:     Dog = ?config(watchdog, Config),
  262:     ?t:timetrap_cancel(Dog),
  263:     ok.
  264: 
  265: -define(TESTPROG, "ethread_tests").
  266: -define(FAILED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E).
  267: -define(SKIPPED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$K,$I,$P).
  268: -define(SUCCESS_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$U,$C,$C,$E,$S,$S).
  269: -define(PID_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$P,$I,$D).
  270: 
  271: port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) ->
  272:     ?line process_flag(trap_exit, true),
  273:     ?line Ref = erlang:monitor(process, EProc),
  274:     ?line receive
  275: 	      {'DOWN', Ref, _, _, Reason} when is_tuple(Reason),
  276: 					       element(1, Reason)
  277: 					       == timetrap_timeout ->
  278: 		  ?line Cmd = "kill -9 " ++ OSProc,
  279: 		  ?line ?t:format("Test case timed out. "
  280: 				  "Trying to kill port program.~n"
  281: 				  "  Executing: ~p~n", [Cmd]),
  282: 		  ?line case os:cmd(Cmd) of
  283: 			    [] ->
  284: 				ok;
  285: 			    OsCmdRes ->
  286: 				?line ?t:format("             ~s", [OsCmdRes])
  287: 			end;
  288: 	      {'DOWN', Ref, _, _, _} ->
  289: 		  %% OSProc is assumed to have terminated by itself
  290: 		  ?line ok 
  291: 	  end.
  292: 
  293: get_line(_Port, eol, Data) ->
  294:     ?line Data;
  295: get_line(Port, noeol, Data) ->
  296:     ?line receive
  297: 	      {Port, {data, {Flag, NextData}}} ->
  298: 		  ?line get_line(Port, Flag, Data ++ NextData);
  299: 	      {Port, eof} ->
  300: 		  ?line ?t:fail(port_prog_unexpectedly_closed)
  301: 	  end.
  302: 
  303: read_case_data(Port, TestCase) ->
  304:     ?line receive
  305: 	      {Port, {data, {eol, [?SUCCESS_MARKER]}}} ->
  306: 		  ?line ok;
  307: 	      {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} ->
  308: 		  ?line {comment, get_line(Port, Flag, CommentStart)};
  309: 	      {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} ->
  310: 		  ?line {skipped, get_line(Port, Flag, CommentStart)};
  311: 	      {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} ->
  312: 		  ?line ?t:fail(get_line(Port, Flag, ReasonStart));
  313: 	      {Port, {data, {eol, [?PID_MARKER | PidStr]}}} ->
  314: 		  ?line ?t:format("Port program pid: ~s~n", [PidStr]),
  315: 		  ?line CaseProc = self(),
  316: 		  ?line _ = list_to_integer(PidStr), % Sanity check
  317: 		  spawn_opt(fun () ->
  318: 				    port_prog_killer(CaseProc, PidStr)
  319: 			    end,
  320: 			    [{priority, max}, link]),
  321: 		  read_case_data(Port, TestCase);
  322: 	      {Port, {data, {Flag, LineStart}}} ->
  323: 		  ?line ?t:format("~s~n", [get_line(Port, Flag, LineStart)]),
  324: 		  read_case_data(Port, TestCase);
  325: 	      {Port, eof} ->
  326: 		  ?line ?t:fail(port_prog_unexpectedly_closed)
  327: 	  end.
  328: 
  329: run_case(Config, Test, TestArgs) ->
  330:     run_case(Config, Test, TestArgs, fun (_Port) -> ok end).
  331: 
  332: run_case(Config, Test, TestArgs, Fun) ->
  333:     TestProg = filename:join([?config(data_dir, Config), ?TESTPROG]),
  334:     Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs,
  335:     case catch open_port({spawn, Cmd}, [stream,
  336: 					use_stdio,
  337: 					stderr_to_stdout,
  338: 					eof,
  339: 					{line, 1024}]) of
  340: 	Port when is_port(Port) ->
  341: 	    ?line Fun(Port),
  342: 	    ?line CaseResult = read_case_data(Port, Test),
  343: 	    ?line receive
  344: 		      {Port, eof} ->
  345: 			  ?line ok
  346: 		  end,
  347: 	    ?line CaseResult;
  348: 	Error ->
  349: 	    ?line ?t:fail({open_port_failed, Error})
  350:     end.
  351: 	    
  352: 
  353: 
  354: