From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- erts/test/ethread_SUITE.erl | 365 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 365 insertions(+) create mode 100644 erts/test/ethread_SUITE.erl (limited to 'erts/test/ethread_SUITE.erl') 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 +%%% Description : +%%% +%%% Created : 17 Jun 2004 by Rickard Green +%%%------------------------------------------------------------------- +-module(ethread_SUITE). +-author('rickard.s.green@ericsson.com'). + +%-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. + + + + -- cgit v1.2.3