path: root/erts/test/ethread_SUITE.erl

%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2004-2012. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions 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]').

-export([all/0, suite/0, init_per_testcase/2, end_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,
	 dw_atomic_massage/1]).

-include_lib("common_test/include/ct.hrl").

suite() ->
    [{ct_hooks,[ts_install_cth]},
     {timetrap, {minutes, 10}}].

all() ->
    [create_join_thread,
     equal_tids,
     mutex,
     try_lock_mutex,
     cond_wait,
     broadcast,
     detached_thread,
     max_threads,
     tsd,
     spinlock,
     rwspinlock,
     rwmutex,
     atomic,
     dw_atomic_massage].

init_per_testcase(Case, Config) ->
    case inet:gethostname() of
	{ok,"fenris"} when Case == max_threads ->
	    %% Cannot use os:type+os:version as not all
	    %% solaris10 machines are buggy.
	    {skip, "This machine is buggy"};
	_Else ->
            Config
    end.

end_per_testcase(_Case, _Config) ->
    ok.

%%
%%
%% 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", "").

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) ->
    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, "detached_thread", "")
    end.

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", "").

dw_atomic_massage(doc) ->
    ["Massage double word atomics"];
dw_atomic_massage(suite) ->
    [];
dw_atomic_massage(Config) ->
    run_case(Config, "dw_atomic_massage", "").

%%
%%
%% Auxiliary functions
%%
%%

-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) ->
    process_flag(trap_exit, true),
    Ref = erlang:monitor(process, EProc),
    receive
        {'DOWN', Ref, _, _, Reason} when is_tuple(Reason),
                                         element(1, Reason)
                                         == timetrap_timeout ->
            Cmd = "kill -9 " ++ OSProc,
            io:format("Test case timed out. "
                      "Trying to kill port program.~n"
                      "  Executing: ~p~n", [Cmd]),
            case os:cmd(Cmd) of
                [] ->
                    ok;
                OsCmdRes ->
                    io:format("             ~s", [OsCmdRes])
            end;
        %% OSProc is assumed to have terminated by itself
        {'DOWN', Ref, _, _, _} ->
            ok
    end.

get_line(_Port, eol, Data) ->
    Data;
get_line(Port, noeol, Data) ->
    receive
	      {Port, {data, {Flag, NextData}}} ->
		  get_line(Port, Flag, Data ++ NextData);
	      {Port, eof} ->
		  ct:fail(port_prog_unexpectedly_closed)
	  end.

read_case_data(Port, TestCase) ->
    receive
        {Port, {data, {eol, [?SUCCESS_MARKER]}}} ->
            ok;
        {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} ->
            {comment, get_line(Port, Flag, CommentStart)};
        {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} ->
            {skipped, get_line(Port, Flag, CommentStart)};
        {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} ->
            ct:fail(get_line(Port, Flag, ReasonStart));
        {Port, {data, {eol, [?PID_MARKER | PidStr]}}} ->
            io:format("Port program pid: ~s~n", [PidStr]),
            CaseProc = self(),
            _ = 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}}} ->
            io:format("~s~n", [get_line(Port, Flag, LineStart)]),
            read_case_data(Port, TestCase);
        {Port, eof} ->
            ct: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([proplists:get_value(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) ->
	    Fun(Port),
	    CaseResult = read_case_data(Port, Test),
            receive
                {Port, eof} ->
                    ok
            end,
	    CaseResult;
	Error ->
	    ct:fail({open_port_failed, Error})
    end.