aboutsummaryrefslogtreecommitdiffstats
path: root/erts/test/ethread_SUITE.erl
diff options
context:
space:
mode:
Diffstat (limited to 'erts/test/ethread_SUITE.erl')
-rw-r--r--erts/test/ethread_SUITE.erl365
1 files changed, 365 insertions, 0 deletions
diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl
new file mode 100644
index 0000000000..a8f4f5e90c
--- /dev/null
+++ b/erts/test/ethread_SUITE.erl
@@ -0,0 +1,365 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-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%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File : ethread_SUITE.erl
+%%% Author : Rickard Green <[email protected]>
+%%% Description :
+%%%
+%%% Created : 17 Jun 2004 by Rickard Green <[email protected]>
+%%%-------------------------------------------------------------------
+-module(ethread_SUITE).
+-author('[email protected]').
+
+%-define(line_trace, 1).
+
+-define(DEFAULT_TIMEOUT, ?t:minutes(10)).
+
+-export([all/1, init_per_testcase/2, fin_per_testcase/2]).
+
+-export([create_join_thread/1,
+ equal_tids/1,
+ mutex/1,
+ try_lock_mutex/1,
+ recursive_mutex/1,
+ time_now/1,
+ cond_wait/1,
+ cond_timedwait/1,
+ broadcast/1,
+ detached_thread/1,
+ max_threads/1,
+ forksafety/1,
+ vfork/1,
+ tsd/1,
+ spinlock/1,
+ rwspinlock/1,
+ rwmutex/1,
+ atomic/1,
+ gate/1]).
+
+-include("test_server.hrl").
+
+tests() ->
+ [create_join_thread,
+ equal_tids,
+ mutex,
+ try_lock_mutex,
+ recursive_mutex,
+ time_now,
+ cond_wait,
+ cond_timedwait,
+ broadcast,
+ detached_thread,
+ max_threads,
+ forksafety,
+ vfork,
+ tsd,
+ spinlock,
+ rwspinlock,
+ rwmutex,
+ atomic,
+ gate].
+
+all(doc) -> [];
+all(suite) -> tests().
+
+
+%%
+%%
+%% 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", "").
+
+recursive_mutex(doc) ->
+ ["Tests recursive mutexes."];
+recursive_mutex(suite) ->
+ [];
+recursive_mutex(Config) ->
+ run_case(Config, "recursive_mutex", "").
+
+time_now(doc) ->
+ ["Tests ethr_time_now by comparing time values with Erlang."];
+time_now(suite) ->
+ [];
+time_now(Config) ->
+ run_case(Config, "time_now", "", fun (P) ->
+ spawn_link(fun () ->
+ watchdog(P)
+ end)
+ end).
+
+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", "").
+
+cond_timedwait(doc) ->
+ ["Tests ethr_cond_timedwait with ethr_cond_signal and ethr_cond_broadcast."];
+cond_timedwait(suite) ->
+ [];
+cond_timedwait(Config) ->
+ run_case(Config, "cond_timedwait", "").
+
+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) ->
+ run_case(Config, "max_threads", "").
+
+forksafety(doc) ->
+ ["Tests forksafety."];
+forksafety(suite) ->
+ [];
+forksafety(Config) ->
+ run_case(Config, "forksafety", "").
+
+vfork(doc) ->
+ ["Tests vfork with threads."];
+vfork(suite) ->
+ case ?t:os_type() of
+ {unix, osf1} ->
+ {skip, "vfork() known to hang multi-threaded applications on osf1"};
+ _ ->
+ []
+ end;
+vfork(Config) ->
+ run_case(Config, "vfork", "").
+
+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", "").
+
+gate(doc) ->
+ ["Tests gates."];
+gate(suite) ->
+ [];
+gate(Config) ->
+ run_case(Config, "gate", "").
+
+%%
+%%
+%% 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.
+
+
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-02 17:23:02 +0000