%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2004-2011. 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% %% %%%------------------------------------------------------------------- %%% File : ethread_SUITE.erl %%% Author : Rickard Green <rickard.s.green@ericsson.com> %%% Description : %%% %%% Created : 17 Jun 2004 by Rickard Green <rickard.s.green@ericsson.com> %%%------------------------------------------------------------------- -module(ethread_SUITE). -author('rickard.s.green@ericsson.com'). %-define(line_trace, 1). -define(DEFAULT_TIMEOUT, ?t:minutes(10)). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2, fin_per_testcase/2]). -export([create_join_thread/1, equal_tids/1, mutex/1, try_lock_mutex/1, cond_wait/1, broadcast/1, detached_thread/1, max_threads/1, tsd/1, spinlock/1, rwspinlock/1, rwmutex/1, atomic/1]). -include_lib("test_server/include/test_server.hrl"). tests() -> [create_join_thread, equal_tids, mutex, try_lock_mutex, cond_wait, broadcast, detached_thread, max_threads, tsd, spinlock, rwspinlock, rwmutex, atomic]. suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> tests(). groups() -> []. init_per_suite(Config) -> Config. end_per_suite(_Config) -> ok. init_per_group(_GroupName, Config) -> Config. end_per_group(_GroupName, Config) -> Config. %% %% %% The test-cases %% %% create_join_thread(doc) -> ["Tests ethr_thr_create and ethr_thr_join."]; create_join_thread(suite) -> []; create_join_thread(Config) -> run_case(Config, "create_join_thread", ""). equal_tids(doc) -> ["Tests ethr_equal_tids."]; equal_tids(suite) -> []; equal_tids(Config) -> run_case(Config, "equal_tids", ""). mutex(doc) -> ["Tests mutexes."]; mutex(suite) -> []; mutex(Config) -> run_case(Config, "mutex", ""). try_lock_mutex(doc) -> ["Tests try lock on mutex."]; try_lock_mutex(suite) -> []; try_lock_mutex(Config) -> run_case(Config, "try_lock_mutex", ""). wd_dispatch(P) -> receive bye -> ?line true = port_command(P, "-1 "), ?line bye; L when is_list(L) -> ?line true = port_command(P, L), ?line wd_dispatch(P) end. watchdog(Port) -> ?line process_flag(priority, max), ?line receive after 500 -> ok end, ?line random:seed(), ?line true = port_command(Port, "0 "), ?line lists:foreach(fun (T) -> erlang:send_after(T, self(), integer_to_list(T) ++ " ") end, lists:usort(lists:map(fun (_) -> random:uniform(4500)+500 end, lists:duplicate(50,0)))), ?line erlang:send_after(5100, self(), bye), wd_dispatch(Port). cond_wait(doc) -> ["Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast."]; cond_wait(suite) -> []; cond_wait(Config) -> run_case(Config, "cond_wait", ""). broadcast(doc) -> ["Tests that a ethr_cond_broadcast really wakes up all waiting threads"]; broadcast(suite) -> []; broadcast(Config) -> run_case(Config, "broadcast", ""). detached_thread(doc) -> ["Tests detached threads."]; detached_thread(suite) -> []; detached_thread(Config) -> run_case(Config, "detached_thread", ""). max_threads(doc) -> ["Tests maximum number of threads."]; max_threads(suite) -> []; max_threads(Config) -> case {os:type(), os:version()} of {{unix,darwin}, {9, _, _}} -> %% For some reason pthread_create() crashes when more %% threads cannot be created, instead of returning an %% error code on our MacOS X Leopard machine... {skipped, "MacOS X Leopard cannot cope with this test..."}; _ -> run_case(Config, "max_threads", "") end. tsd(doc) -> ["Tests thread specific data."]; tsd(suite) -> []; tsd(Config) -> run_case(Config, "tsd", ""). spinlock(doc) -> ["Tests spinlocks."]; spinlock(suite) -> []; spinlock(Config) -> run_case(Config, "spinlock", ""). rwspinlock(doc) -> ["Tests rwspinlocks."]; rwspinlock(suite) -> []; rwspinlock(Config) -> run_case(Config, "rwspinlock", ""). rwmutex(doc) -> ["Tests rwmutexes."]; rwmutex(suite) -> []; rwmutex(Config) -> run_case(Config, "rwmutex", ""). atomic(doc) -> ["Tests atomics."]; atomic(suite) -> []; atomic(Config) -> run_case(Config, "atomic", ""). %% %% %% Auxiliary functions %% %% init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), [{watchdog, Dog}|Config]. fin_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. -define(TESTPROG, "ethread_tests"). -define(FAILED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E). -define(SKIPPED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$K,$I,$P). -define(SUCCESS_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$U,$C,$C,$E,$S,$S). -define(PID_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$P,$I,$D). port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) -> ?line process_flag(trap_exit, true), ?line Ref = erlang:monitor(process, EProc), ?line receive {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), element(1, Reason) == timetrap_timeout -> ?line Cmd = "kill -9 " ++ OSProc, ?line ?t:format("Test case timed out. " "Trying to kill port program.~n" " Executing: ~p~n", [Cmd]), ?line case os:cmd(Cmd) of [] -> ok; OsCmdRes -> ?line ?t:format(" ~s", [OsCmdRes]) end; {'DOWN', Ref, _, _, _} -> %% OSProc is assumed to have terminated by itself ?line ok end. get_line(_Port, eol, Data) -> ?line Data; get_line(Port, noeol, Data) -> ?line receive {Port, {data, {Flag, NextData}}} -> ?line get_line(Port, Flag, Data ++ NextData); {Port, eof} -> ?line ?t:fail(port_prog_unexpectedly_closed) end. read_case_data(Port, TestCase) -> ?line receive {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> ?line ok; {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> ?line {comment, get_line(Port, Flag, CommentStart)}; {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> ?line {skipped, get_line(Port, Flag, CommentStart)}; {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> ?line ?t:fail(get_line(Port, Flag, ReasonStart)); {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> ?line ?t:format("Port program pid: ~s~n", [PidStr]), ?line CaseProc = self(), ?line list_to_integer(PidStr), % Sanity check spawn_opt(fun () -> port_prog_killer(CaseProc, PidStr) end, [{priority, max}, link]), read_case_data(Port, TestCase); {Port, {data, {Flag, LineStart}}} -> ?line ?t:format("~s~n", [get_line(Port, Flag, LineStart)]), read_case_data(Port, TestCase); {Port, eof} -> ?line ?t:fail(port_prog_unexpectedly_closed) end. run_case(Config, Test, TestArgs) -> run_case(Config, Test, TestArgs, fun (_Port) -> ok end). run_case(Config, Test, TestArgs, Fun) -> TestProg = filename:join([?config(data_dir, Config), ?TESTPROG]), Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs, case catch open_port({spawn, Cmd}, [stream, use_stdio, stderr_to_stdout, eof, {line, 1024}]) of Port when is_port(Port) -> ?line Fun(Port), ?line CaseResult = read_case_data(Port, Test), ?line receive {Port, eof} -> ?line ok end, ?line CaseResult; Error -> ?line ?t:fail({open_port_failed, Error}) end.