1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%%-------------------------------------------------------------------
22%%% File    : ethread_SUITE.erl
23%%% Author  : Rickard Green <rickard.s.green@ericsson.com>
24%%% Description :
25%%%
26%%% Created : 17 Jun 2004 by Rickard Green <rickard.s.green@ericsson.com>
27%%%-------------------------------------------------------------------
28-module(ethread_SUITE).
29-author('rickard.s.green@ericsson.com').
30
31-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]).
32
33-export([create_join_thread/1,
34	 equal_tids/1,
35	 mutex/1,
36	 try_lock_mutex/1,
37	 cond_wait/1,
38	 broadcast/1,
39	 detached_thread/1,
40	 max_threads/1,
41	 tsd/1,
42	 spinlock/1,
43	 rwspinlock/1,
44	 rwmutex/1,
45	 atomic/1,
46	 dw_atomic_massage/1]).
47
48-include_lib("common_test/include/ct.hrl").
49
50suite() ->
51    [{ct_hooks,[ts_install_cth]},
52     {timetrap, {minutes, 10}}].
53
54all() ->
55    [create_join_thread,
56     equal_tids,
57     mutex,
58     try_lock_mutex,
59     cond_wait,
60     broadcast,
61     detached_thread,
62     max_threads,
63     tsd,
64     spinlock,
65     rwspinlock,
66     rwmutex,
67     atomic,
68     dw_atomic_massage].
69
70init_per_testcase(Case, Config) ->
71    case inet:gethostname() of
72	{ok,"fenris"} when Case == max_threads ->
73	    %% Cannot use os:type+os:version as not all
74	    %% solaris10 machines are buggy.
75	    {skip, "This machine is buggy"};
76	_Else ->
77            Config
78    end.
79
80end_per_testcase(_Case, _Config) ->
81    ok.
82
83%%
84%%
85%% The test-cases
86%%
87%%
88
89%% Tests ethr_thr_create and ethr_thr_join.
90create_join_thread(Config) ->
91    run_case(Config, "create_join_thread", "").
92
93%% Tests ethr_equal_tids.
94equal_tids(Config) ->
95    run_case(Config, "equal_tids", "").
96
97%% Tests mutexes.
98mutex(Config) ->
99    run_case(Config, "mutex", "").
100
101%% Tests try lock on mutex.
102try_lock_mutex(Config) ->
103    run_case(Config, "try_lock_mutex", "").
104
105%% Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast.
106cond_wait(Config) ->
107    run_case(Config, "cond_wait", "").
108
109%% Tests that a ethr_cond_broadcast really wakes up all waiting threads
110broadcast(Config) ->
111    run_case(Config, "broadcast", "").
112
113%% Tests detached threads.
114detached_thread(Config) ->
115    case {os:type(), os:version()} of
116	{{unix,darwin}, {9, _, _}} ->
117	    %% For some reason pthread_create() crashes when more
118	    %% threads cannot be created, instead of returning an
119	    %% error code on our MacOS X Leopard machine...
120	    {skipped, "MacOS X Leopard cannot cope with this test..."};
121	_ ->
122	    run_case(Config, "detached_thread", "")
123    end.
124
125%% Tests maximum number of threads.
126max_threads(Config) ->
127    case {os:type(), os:version()} of
128	{{unix,darwin}, {9, _, _}} ->
129	    %% For some reason pthread_create() crashes when more
130	    %% threads cannot be created, instead of returning an
131	    %% error code on our MacOS X Leopard machine...
132	    {skipped, "MacOS X Leopard cannot cope with this test..."};
133	_ ->
134	    run_case(Config, "max_threads", "")
135    end.
136
137%% Tests thread specific data.
138tsd(Config) ->
139    run_case(Config, "tsd", "").
140
141%% Tests spinlocks.
142spinlock(Config) ->
143    run_case(Config, "spinlock", "").
144
145%% Tests rwspinlocks.
146rwspinlock(Config) ->
147    run_case(Config, "rwspinlock", "").
148
149%% Tests rwmutexes.
150rwmutex(Config) ->
151    run_case(Config, "rwmutex", "").
152
153%% Tests atomics.
154atomic(Config) ->
155    run_case(Config, "atomic", "").
156
157%% Massage double word atomics
158dw_atomic_massage(Config) ->
159    run_case(Config, "dw_atomic_massage", "").
160
161%%
162%%
163%% Auxiliary functions
164%%
165%%
166
167-define(TESTPROG, "ethread_tests").
168-define(FAILED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E).
169-define(SKIPPED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$K,$I,$P).
170-define(SUCCESS_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$U,$C,$C,$E,$S,$S).
171-define(PID_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$P,$I,$D).
172
173port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) ->
174    process_flag(trap_exit, true),
175    Ref = erlang:monitor(process, EProc),
176    receive
177        {'DOWN', Ref, _, _, Reason} when is_tuple(Reason),
178                                         element(1, Reason)
179                                         == timetrap_timeout ->
180            Cmd = "kill -9 " ++ OSProc,
181            io:format("Test case timed out. "
182                      "Trying to kill port program.~n"
183                      "  Executing: ~p~n", [Cmd]),
184            case os:cmd(Cmd) of
185                [] ->
186                    ok;
187                OsCmdRes ->
188                    io:format("             ~s", [OsCmdRes])
189            end;
190        %% OSProc is assumed to have terminated by itself
191        {'DOWN', Ref, _, _, _} ->
192            ok
193    end.
194
195get_line(_Port, eol, Data) ->
196    Data;
197get_line(Port, noeol, Data) ->
198    receive
199	      {Port, {data, {Flag, NextData}}} ->
200		  get_line(Port, Flag, Data ++ NextData);
201	      {Port, eof} ->
202		  ct:fail(port_prog_unexpectedly_closed)
203	  end.
204
205read_case_data(Port, TestCase) ->
206    receive
207        {Port, {data, {eol, [?SUCCESS_MARKER]}}} ->
208            ok;
209        {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} ->
210            {comment, get_line(Port, Flag, CommentStart)};
211        {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} ->
212            {skipped, get_line(Port, Flag, CommentStart)};
213        {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} ->
214            ct:fail(get_line(Port, Flag, ReasonStart));
215        {Port, {data, {eol, [?PID_MARKER | PidStr]}}} ->
216            io:format("Port program pid: ~s~n", [PidStr]),
217            CaseProc = self(),
218            _ = list_to_integer(PidStr), % Sanity check
219            spawn_opt(fun () ->
220                              port_prog_killer(CaseProc, PidStr)
221                      end,
222                      [{priority, max}, link]),
223            read_case_data(Port, TestCase);
224        {Port, {data, {Flag, LineStart}}} ->
225            io:format("~s~n", [get_line(Port, Flag, LineStart)]),
226            read_case_data(Port, TestCase);
227        {Port, eof} ->
228            ct:fail(port_prog_unexpectedly_closed)
229    end.
230
231run_case(Config, Test, TestArgs) ->
232    run_case(Config, Test, TestArgs, fun (_Port) -> ok end).
233
234run_case(Config, Test, TestArgs, Fun) ->
235    TestProg = filename:join([proplists:get_value(data_dir, Config), ?TESTPROG]),
236    Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs,
237    case catch open_port({spawn, Cmd}, [stream,
238					use_stdio,
239					stderr_to_stdout,
240					eof,
241					{line, 1024}]) of
242	Port when is_port(Port) ->
243	    Fun(Port),
244	    CaseResult = read_case_data(Port, Test),
245            receive
246                {Port, eof} ->
247                    ok
248            end,
249	    CaseResult;
250	Error ->
251	    ct:fail({open_port_failed, Error})
252    end.
253