1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-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: ic_pragma_SUITE.erl
23%%
24%% Description:
25%% Test suite for the IFR object registration when
26%% pragmas are engaged
27%%
28%%-----------------------------------------------------------------
29-module(ic_pragma_SUITE).
30
31-include_lib("common_test/include/ct.hrl").
32-include_lib("orber/include/corba.hrl").
33%%-----------------------------------------------------------------
34%% External exports
35%%-----------------------------------------------------------------
36-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
37	 init_per_suite/1, end_per_suite/1]).
38-export([ifr_pragma_reg/1, pragma_error/1, uggly_pragmas/1]).
39
40
41%%-----------------------------------------------------------------
42%% Macros
43%%-----------------------------------------------------------------
44-define(REMAP_EXCEPT(F), case catch F of
45			     {'EXCEPTION', E} -> exit(E);
46			     R -> R
47			 end).
48%% Standard options to the ic compiler, NOTE unholy use of OutDir
49
50-define(OUT(X), filename:join([proplists:get_value(priv_dir, Config), gen, to_list(X)])).
51
52
53%%-----------------------------------------------------------------
54%% Func: all/1
55%% Args:
56%% Returns:
57%%-----------------------------------------------------------------
58suite() -> [{ct_hooks,[ts_install_cth]}].
59
60all() ->
61    cases().
62
63groups() ->
64    [].
65
66init_per_group(_GroupName, Config) ->
67    Config.
68
69end_per_group(_GroupName, Config) ->
70    Config.
71
72
73cases() ->
74    [ifr_pragma_reg, pragma_error, uggly_pragmas].
75
76%%-----------------------------------------------------------------
77%% Init and cleanup functions.
78%%-----------------------------------------------------------------
79init_per_suite(Config) ->
80    io:format("Setting up.....~n"),
81    mnesia:stop(),
82    mnesia:delete_schema([node()]),
83    mnesia:create_schema([node()]),
84    mnesia:start(),
85    orber:install([node()]),
86    orber:start(),
87    if
88	is_list(Config) ->
89	    Config;
90	true ->
91	    exit("Config not a list")
92    end.
93
94end_per_suite(Config) ->
95    io:format("Setting down.....~n"),
96    orber:stop(),
97    orber:uninstall(),
98    mnesia:stop(),
99    mnesia:delete_schema([node()]),
100    Config.
101
102
103
104
105%%-----------------------------------------------------------------
106%% Test Case: IFR registration with pragmas
107%%-----------------------------------------------------------------
108%% Checks that IFR object is correctly registered under pragma engagement.
109ifr_pragma_reg(Config) when is_list(Config) ->
110    ?REMAP_EXCEPT(ifr_pragma_reg_run(Config)).
111
112ifr_pragma_reg_run(Config) ->
113    DataDir = proplists:get_value(data_dir, Config),
114    OutDir = ?OUT(ifr_pragma_reg),
115    File0 = filename:join(DataDir, reg_m0),
116    ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags,
117						"-I" ++ DataDir}]),
118    ok = compile(OutDir, ifr_pragma_files()),
119    code:add_pathz(OutDir),
120
121    %% OE_register for all files
122    ok = 'oe_reg_m0':'oe_register'(),
123
124    %% Pragma registration test
125    OE_IFR = orber_ifr:find_repository(),
126    io:format("~n##### Starting the test case #####~n"),
127    check_pragma_effect(OE_IFR,"IDL:M1/T1:1.0"),
128    check_pragma_effect(OE_IFR,"DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3"),
129    check_pragma_effect(OE_IFR,"IDL:P2/T3:1.0"),
130    check_pragma_effect(OE_IFR,"IDL:P1/M2/T4:2.4"),
131
132    %% OE_unregister for all files
133    ok = 'oe_reg_m0':'oe_unregister'(),
134    code:del_path(OutDir),
135    ok.
136
137
138ifr_pragma_files() -> ['oe_reg_m0'].
139
140
141check_pragma_effect(OE_IFR,ID) ->
142    io:format("Checking for existance of : ~s~n",[ID]),
143    case orber_ifr:lookup_id(OE_IFR,ID) of
144        [] ->
145	    test_server:fail(ID ++ " does not exist"),
146	    false;
147	{Def,_} ->
148	    io:format("Id refers to = {~p,#Bin}~n",[Def]),
149	    true
150    end.
151
152
153
154
155%%-----------------------------------------------------------------
156%% Test Case: Syntactical / Semantical error pragma definitions
157%%-----------------------------------------------------------------
158%% Finds errornous pragma definitions under compilation.
159pragma_error(Config) when is_list(Config) ->
160    ?REMAP_EXCEPT(pragma_error_run(Config)).
161
162pragma_error_run(Config) ->
163    DataDir = proplists:get_value(data_dir, Config),
164    OutDir = ?OUT(pragma_error),
165    File1 = filename:join(DataDir, reg_m1),
166    File2 = filename:join(DataDir, reg_m2),
167    File3 = filename:join(DataDir, reg_m3),
168    File4 = filename:join(DataDir, reg_m4),
169    File5 = filename:join(DataDir, reg_m5),
170    File6 = filename:join(DataDir, reg_m6),
171
172    error = ic:gen(File1, stdopts(OutDir)++[{preproc_flags,
173						   "-I" ++ DataDir}] ),
174
175    error = ic:gen(File2, stdopts(OutDir)++[{preproc_flags,
176						   "-I" ++ DataDir}] ),
177
178    error = ic:gen(File3, stdopts(OutDir)++[{preproc_flags,
179						   "-I" ++ DataDir}] ),
180
181    ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags,
182						"-I" ++ DataDir}] ),
183
184    error = ic:gen(File5, stdopts(OutDir)++[{preproc_flags,
185						   "-I" ++ DataDir}] ),
186
187    error = ic:gen(File6, stdopts(OutDir)++[{preproc_flags,
188						   "-I" ++ DataDir}] ),
189    ok.
190
191
192
193
194%%-----------------------------------------------------------------
195%% Test Case: IFR registration with realy uggly placed pragmas
196%%-----------------------------------------------------------------
197%% Checks that IFR object is correctly registered under really uggly pragma engagement.
198uggly_pragmas(Config) when is_list(Config) ->
199    ?REMAP_EXCEPT(uggly_pragmas_run(Config)).
200
201uggly_pragmas_run(Config) ->
202    DataDir = proplists:get_value(data_dir, Config),
203    OutDir = ?OUT(ifr_pragma_reg),
204    File0 = filename:join(DataDir, uggly),
205
206    ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags,
207						"-I" ++ DataDir}]),
208
209    ok = compile(OutDir, uggly_pragma_files()),
210    code:add_pathz(OutDir),
211
212    %% OE_register for all files
213    ok = 'oe_uggly':'oe_register'(),
214
215    %% Pragma registration test
216    OE_IFR = orber_ifr:find_repository(),
217    io:format("~n##### Starting the test case #####~n"),
218
219    check_pragma_effect(OE_IFR, "IDL:M:1.0"),
220    check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:10"),
221    check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:11"),
222    check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:17"),
223    check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:34"),
224    check_pragma_effect(OE_IFR, "IDL:Exc1:2.2"),
225    check_pragma_effect(OE_IFR, "IDL:Exc2:2.2"),
226    check_pragma_effect(OE_IFR, "IDL:S:1.0"),
227    check_pragma_effect(OE_IFR, "IDL:U:1.0"),
228    check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:23"),
229
230    %% OE_unregister for all files
231    ok = 'oe_uggly':'oe_unregister'(),
232
233    code:del_path(OutDir),
234    ok.
235
236
237uggly_pragma_files() -> ['oe_uggly'].
238
239
240
241
242%%----------------------------
243
244
245stdopts(OutDir) ->
246    [{outdir, OutDir}, {maxerrs, infinity}].
247
248
249compile(Dir, Files) ->
250    compile(Dir, Files, []).
251
252compile(Dir, Files, Opts) ->
253    {ok, Cwd} = file:get_cwd(),
254    file:set_cwd(Dir),
255    io:format("Changing to ~p~n", [Dir]),
256    case catch do_compile(Files, Opts) of
257	ok ->
258	    file:set_cwd(Cwd);
259	Err ->
260	    file:set_cwd(Cwd),
261	    test_server:fail(Err)
262    end.
263
264do_compile([], _Opts) -> ok;
265do_compile([F | Fs], Opts) ->
266    io:format("Compiling ~p", [F]),
267    case compile:file(F, Opts) of
268	ok ->
269	    io:format(" ok~n", []),
270	    do_load(F, Opts),
271	    do_compile(Fs, Opts);
272	{ok, _} ->
273	    io:format(" ok~n", []),
274	    do_load(F, Opts),
275	    do_compile(Fs, Opts);
276	{ok, _, _} ->
277	    io:format(" ok~n", []),
278	    do_load(F, Opts),
279	    do_compile(Fs, Opts);
280	Err ->
281	    io:format(" error: ~p~n", [Err]),
282	    Err
283    end.
284
285do_load(File, Opts) ->
286    case lists:member(load, Opts) of
287	true ->
288	    io:format("Loading file ~p", [File]),
289	    code:purge(File),
290	    R = code:load_abs(File),
291	    io:format("Loaded: ~p", [R]);
292	false ->
293	    ok
294    end.
295
296
297to_list(X) when is_atom(X) -> atom_to_list(X);
298to_list(X) -> X.
299
300
301
302