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%%----------------------------------------------------------------------
23%% Purpose : Test suite for c-client/erl-server
24%%----------------------------------------------------------------------
25
26-module(c_client_erl_server_proto_SUITE).
27-include_lib("common_test/include/ct.hrl").
28
29-export([init_per_testcase/2, end_per_testcase/2,
30	all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
31	 init_per_group/2,end_per_group/2,
32	 void_test/1, long_test/1, long_long_test/1,
33	 unsigned_short_test/1, unsigned_long_test/1,
34	 unsigned_long_long_test/1, double_test/1, char_test/1,
35	 wchar_test/1, octet_test/1, bool_test/1, struct_test/1,
36	 struct2_test/1, seq1_test/1, seq2_test/1, seq3_test/1,
37	 seq4_test/1, seq5_test/1, array1_test/1, array2_test/1,
38	 enum_test/1, string1_test/1, string2_test/1, string3_test/1,
39	 string4_test/1, pid_test/1, port_test/1, ref_test/1, term_test/1,
40	 typedef_test/1, inline_sequence_test/1, term_sequence_test/1,
41	 term_struct_test/1, wstring1_test/1]).
42
43-define(DEFAULT_TIMEOUT, 20000).
44-define(PORT_TIMEOUT, 15000).
45-define(ERLANG_SERVER_NAME, idl_erlang_server).
46-define(C_CLIENT_NODE_NAME, c_client_idl_test).
47
48%% Add/remove code path and watchdog before/after each test case.
49%%
50init_per_testcase(_Case, Config) ->
51    DataDir = proplists:get_value(data_dir, Config),
52    code:add_patha(DataDir),
53
54    %% Since other test suites use the module m_i, we have
55    %% to make sure we are using the right m_i module.
56    code:purge(m_i),
57    code:load_file(m_i),
58
59    WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT),
60    [{watchdog, WatchDog}| Config].
61
62end_per_testcase(_Case, Config) ->
63    DataDir = proplists:get_value(data_dir, Config),
64    code:del_path(DataDir),
65    WatchDog = proplists:get_value(watchdog, Config),
66    test_server:timetrap_cancel(WatchDog).
67
68suite() -> [{ct_hooks,[ts_install_cth]}].
69
70all() ->
71    [void_test, long_test, long_long_test,
72     unsigned_short_test, unsigned_long_test,
73     unsigned_long_long_test, double_test, char_test,
74     wchar_test, octet_test, bool_test, struct_test,
75     struct2_test, seq1_test, seq2_test, seq3_test,
76     seq4_test, seq5_test, array1_test, array2_test,
77     enum_test, string1_test, string2_test, string3_test,
78     string4_test, pid_test, port_test, ref_test, term_test,
79     typedef_test, inline_sequence_test, term_sequence_test,
80     term_struct_test, wstring1_test].
81
82groups() ->
83    [].
84
85init_per_suite(Config) ->
86    Config.
87
88end_per_suite(_Config) ->
89    ok.
90
91init_per_group(_GroupName, Config) ->
92    Config.
93
94end_per_group(_GroupName, Config) ->
95    Config.
96
97array1_test(Config) ->
98    do_test(array1_test, Config).
99
100array2_test(Config) ->
101    do_test(array2_test, Config).
102
103bool_test(Config) ->
104    do_test(bool_test, Config).
105
106char_test(Config) ->
107    do_test(char_test, Config).
108
109double_test(Config) ->
110    do_test(double_test, Config).
111
112enum_test(Config) ->
113    do_test(enum_test, Config).
114
115inline_sequence_test(Config) ->
116    do_test(inline_sequence_test, Config).
117
118long_long_test(Config) ->
119    do_test(long_long_test, Config).
120
121long_test(Config) ->
122    do_test(long_test, Config).
123
124octet_test(Config) ->
125    do_test(octet_test, Config).
126
127pid_test(Config) ->
128    do_test(pid_test, Config).
129
130port_test(Config) ->
131    do_test(port_test, Config).
132
133ref_test(Config) ->
134    do_test(ref_test, Config).
135
136seq1_test(Config) ->
137    do_test(seq1_test, Config).
138
139seq2_test(Config) ->
140    do_test(seq2_test, Config).
141
142seq3_test(Config) ->
143    do_test(seq3_test, Config).
144
145seq4_test(Config) ->
146    do_test(seq4_test, Config).
147
148seq5_test(Config) ->
149    do_test(seq5_test, Config).
150
151string1_test(Config) ->
152    do_test(string1_test, Config).
153
154string2_test(Config) ->
155    do_test(string2_test, Config).
156
157string3_test(Config) ->
158    do_test(string3_test, Config).
159
160string4_test(Config) ->
161    do_test(string4_test, Config).
162
163struct2_test(Config) ->
164    do_test(struct2_test, Config).
165
166struct_test(Config) ->
167    do_test(struct_test, Config).
168
169term_sequence_test(Config) ->
170    do_test(term_sequence_test, Config).
171
172term_struct_test(Config) ->
173    do_test(term_struct_test, Config).
174
175term_test(Config) ->
176    do_test(term_test, Config).
177
178typedef_test(Config) ->
179    do_test(typedef_test, Config).
180
181unsigned_long_long_test(Config) ->
182    do_test(unsigned_long_long_test, Config).
183
184unsigned_long_test(Config) ->
185    do_test(unsigned_long_test, Config).
186
187unsigned_short_test(Config) ->
188    do_test(unsigned_short_test, Config).
189
190void_test(Config) ->
191    do_test(void_test, Config).
192
193wchar_test(Config) ->
194    do_test(wchar_test, Config).
195
196wstring1_test(Config) ->
197    do_test(wstring1_test, Config).
198
199
200%% It is here that all tests really are done.
201%%
202
203do_test(Case, Config) ->
204    %% Trap exits
205    process_flag(trap_exit, true),
206    %% Start the server
207    {ok, _Pid} = m_i:oe_create_link([], {local, ?ERLANG_SERVER_NAME}),
208    Node = atom_to_list(node()),
209    %% [NodeName, HostName] = string:tokens(Node, "@"),
210    DataDir = proplists:get_value(data_dir, Config),
211    %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]),
212    Cookie = atom_to_list(erlang:get_cookie()),
213    %% Start C-client node as a port program.
214    Cmd = filename:join([DataDir, "c_client"]) ++
215	" -this-node-name " ++ atom_to_list(?C_CLIENT_NODE_NAME) ++
216	" -peer-node " ++ Node ++
217	" -peer-process-name " ++ atom_to_list(?ERLANG_SERVER_NAME) ++
218	" -cookie " ++ Cookie ++
219	" -test-case " ++ atom_to_list(Case),
220    Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]),
221    Res = wait_for_completion(Port),
222    %% Kill off node if there was timeout
223    case Res of
224	{error, timeout} ->
225	    catch rpc:cast(?C_CLIENT_NODE_NAME, erlang, halt, [1]);
226	_ ->
227	    ok
228    end,
229    process_flag(trap_exit, false),
230    catch m_i:stop(?ERLANG_SERVER_NAME),
231    ok = Res.
232
233
234%% Wait for eof *and* exit status, but return if exit status indicates
235%% an error, or we have been waiting more than PORT_TIMEOUT seconds.
236%%
237wait_for_completion(Port) ->
238    wait_for_completion(Port, 0).
239
240wait_for_completion(Port, N) when N < 2 ->
241    receive
242	{Port, {data, Bytes}} ->
243	    %% Relay output
244	    io:format("~s", [Bytes]),
245	    wait_for_completion(Port, N);
246	{Port, {exit_status, 0}} ->
247	    wait_for_completion(Port, N + 1);
248	{Port, {exit_status, Status}} ->
249	    {error, Status};
250	{Port, eof} ->
251	    wait_for_completion(Port, N + 1);
252	{'EXIT', Port, Reason} ->
253	    io:format("Port exited with reason: ~w~n", [Reason]),
254	    wait_for_completion(Port, N);
255	{'EXIT', From, Reason} ->
256	    io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]),
257	    wait_for_completion(Port, N)
258    after ?PORT_TIMEOUT ->
259	    {error, timeout}
260    end;
261wait_for_completion(_, _) ->
262    ok.
263
264
265
266