diff options
Diffstat (limited to 'lib/ic/test/ic_SUITE.erl')
| -rw-r--r-- | lib/ic/test/ic_SUITE.erl | 894 |
1 files changed, 0 insertions, 894 deletions
diff --git a/lib/ic/test/ic_SUITE.erl b/lib/ic/test/ic_SUITE.erl deleted file mode 100644 index 42c1dbb415..0000000000 --- a/lib/ic/test/ic_SUITE.erl +++ /dev/null @@ -1,894 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. 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% -%% -%% -%%%---------------------------------------------------------------------- -%%% Purpose : Test suite for the IDL compiler -%%%---------------------------------------------------------------------- - --module(ic_SUITE). --include_lib("common_test/include/ct.hrl"). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). - - --include_lib("orber/src/orber_ifr.hrl"). --include_lib("orber/src/ifr_objects.hrl"). --include_lib("orber/include/ifr_types.hrl"). - - -%% The type cases --export([ type_norm/1]). - -%% The syntax case --export([]). --export([syntax1/1, syntax2/1, syntax3/1, syntax4/1, syntax5/1, syntax6/1]). - -%% The constant cases --export([]). --export([const_norm/1, const_bad_tk/1, const_bad_type/1]). --export([const_bad_comb/1]). - -%% The union cases --export([]). --export([union_norm/1, union_type/1, union_mult_err/1, union_case_mult/1]). --export([union_default/1]). - -%% The enum cases --export([]). --export([enum_norm/1]). - -%% The struct cases --export([]). --export([struct_norm/1]). - -%% The oneway cases --export([]). --export([oneway_norm/1, oneway_raises/1, oneway_out/1, oneway_void/1, oneway_followed/1]). - -%% The attributes cases --export([]). --export([attr_norm/1]). - -%% The raises registration case --export([raises_reg/1]). - - -%% The typeID case - -%% general stuff --export([]). --export([typeid/1, undef_id/1, dir/1, nasty_names/1, coss/1, mult_ids/1]). --export([forward/1, include/1, app_test/1]). - -%% inheritance stuff --export([ inherit_norm/1, inherit_warn/1, inherit_err/1]). - -%% Standard options to the ic compiler, NOTE unholy use of OutDir - --define(OUT(X), filename:join([proplists:get_value(priv_dir, Config), gen, to_list(X)])). - - -%% Top of cases - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [app_test, {group, const}, {group, union}, - {group, enum}, {group, attr}, {group, type}, - {group, struct}, {group, general}, {group, inherit}, - {group, oneway}, {group, syntax}, raises_reg]. - -groups() -> - [{const, [], - [const_norm, const_bad_tk, const_bad_type, - const_bad_comb]}, - {union, [], - [union_norm, union_type, union_mult_err, - union_case_mult, union_default]}, - {enum, [], [enum_norm]}, {struct, [], [struct_norm]}, - {general, [], - [typeid, undef_id, mult_ids, forward, include, - nasty_names]}, - {inherit, [], - [inherit_norm, inherit_warn, inherit_err]}, - {oneway, [], - [oneway_norm, oneway_out, oneway_raises, oneway_void, - oneway_followed]}, - {attr, [], [attr_norm]}, {type, [], [type_norm]}, - {syntax, [], - [syntax1, syntax2, syntax3, syntax4, syntax5, syntax6]}]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -app_test(_Config) -> - ok=test_server:app_test(ic), - ok. - -%%--------------------------------------------------------------------- -%% -%% Test of constant expressions. -%% - -%% Checks normal constant types and values -const_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(const_norm), - File = filename:join(DataDir, c_norm), - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, const_norm_files()), - ok. - -%% Checks when the constant value doesn't match the declared type -const_bad_tk(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, c_err1), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(18, bad_tk_match, R), - ok. - -%% Checks operands of ops are of correct type -const_bad_type(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, c_err2), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(4, bad_type, R), - ok. - -%% Checks operands of ops are of conflicting types -const_bad_comb(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, c_err3), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(3, bad_type_combination, R), - ok. - - -%% Checks that normal union declarations works. -union_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(union_norm), - File = filename:join(DataDir, u_norm), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, union_norm_files()), - ok. - - -%% Checks OTP-2007 -%% Checks that default cases are correct in type code. -union_default(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(union_default), - File = filename:join(DataDir, u_default), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, union_default_files(), [load]), - TkList = i1:oe_get_interface(), - check_label("op0", 0, TkList), - check_label("op1", 1, TkList), - check_label("op2", 2, TkList), - check_label("op3", -1, TkList), - ok. - -check_label(Id, N, List) -> - case lists:keysearch(Id, 1, List) of - {value, {_, {{_, _, _, _, D, L}, _, _}}} -> - if D /= N -> - test_server:fail({bad_default_num, D, N}); - D /= -1 -> - case lists:nth(D+1, L) of - T when element(1, T) == default -> - ok; - _Que -> - test_server:fail({bad_default_list, D, L}) - end; - true -> - %% D = N = -1, just check that there is no default label - case lists:keysearch(default, 1, L) of - false -> - ok; - _ -> - test_server:fail({bad_default_label, D, L}) - end - end; - _ -> - test_server:fail({'no_such_op!', Id, List}) - end. - -%% Checks that errors are detected. Check that mismatch between case -%% value and declared discriminator type is detected. -union_type(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, u_type), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(28, bad_case_type, R), - ok. - - -%% Check that multiple declared declarators are caught. -%% Also check that if the discriminator is an enum, then the enum name -%% must not be used as a declarator in the union switch (declarator -%% as opposed to label). -union_mult_err(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, u_mult), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(8, multiply_defined, R), - ok. - -%% Check that multiply defined case labels are found in the -%% correct order -union_case_mult(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, u_case_mult), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(7, multiple_cases, R), - ok. - - -%%-------------------------------------------------------------------- -%% -%% Enum cases -%% -%%Checks that normal enum declarations works. -enum_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(enum_norm), - File = filename:join(DataDir, enum), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, enum_norm_files()), - ok. - - -%%-------------------------------------------------------------------- -%% -%% Struct cases -%% -%% Checks that normal struct declarations works. -struct_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(struct_norm), - File = filename:join(DataDir, struct), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, struct_norm_files()), - Mod = ridiculous_name_to_avoid_clash_svenne, - TestFile = filename:join(OutDir, Mod), - ok = gen_struct_file(TestFile, Mod), - ok = compile(OutDir, [Mod], [load]), -%% {ok, Mod, []} = compile:file(TestFile, -%% [{i, OutDir}, {outdir, OutDir}, -%% return, load]), - ok = Mod:test(), - ok. - - -%%-------------------------------------------------------------------- -%% -%% General cases -%% - -%% coss (add sometimes, takes 440 seconds!) -%% Check that type id's are generated correctly -typeid(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(typeid), - File = filename:join(DataDir, typeid), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, typeid_files(), [load]), - "IDL:I1:1.0" = 'I1':'typeID'(), - "IDL:M1/I1:1.0" = 'M1_I1':'typeID'(), - "IDL:M2/M1/I1:1.0" = 'M2_M1_I1':'typeID'(), - "IDL:M3/M2/M1/I1:1.0" = 'M3_M2_M1_I1':'typeID'(), - ok. - - -%%% This test case is removed because there's no way to test this from -%%% an automated test suite. -%% Check that relative directories work, absolute is used in -%% all other cases in the suite. -dir(Config) when is_list(Config) -> - ok; -dir(Config) -> - DataDir = proplists:get_value(data_dir, Config), - - %% Needs a unique directory (any better way?) - OutDir = mk_unique("oe_the_dir"), - - %% More unique names - File = filename:join(DataDir, mk_unique("oe_the_file")), - Const = mk_unique("oe_the_constant"), - Mod = list_to_atom(File), - Func = list_to_atom(Const), - - %% Generate a unique IDL file with a single constant - gen_file(File, Const), - - ok = ic:gen(File, stdopts(OutDir)), - ok = compile(OutDir, [load]), - 19955 = Mod:Func(), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, [load]), - 19955 = Mod:Func(), - - ok = ic:gen(File), -%%% ok = compile(".", [load]), - ok. - -%% Check that various undefied id's are detected correctly -undef_id(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, undef_id), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(16, tk_not_found, R), - ok. - -%% Check that multiply defined ids are caught. -mult_ids(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, mult_ids), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(22, multiply_defined, R), - ok. - - -%% Check that various nasty names can be generated. -%% Try to provoke name clashes and name conflicts with -%% Erlang and IDL -nasty_names(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(nasty_names), - File = filename:join(DataDir, nasty), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, nasty_names_files(), [load]), - ok. - -%% Check that the Coss standard specification works. -coss(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(coss), - File = filename:join(DataDir, 'Coss'), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, [_W1]} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, []), - ok. - -%% Check that forward declaratios work. -forward(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(forward), - File = filename:join(DataDir, forward), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, forward_files(), [load]), - ok. - -%% Check that various undefied id's are detected correctly -include(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, include), - error = ic:gen(File, stdopts(OutDir)++[{preproc_flags,"-I" ++ DataDir}]), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[{preproc_flags,"-I" ++ DataDir},silent2]), - case lists:map(fun(D) -> - filename:rootname(filename:basename(element(3, D))) - end, - lists:sort(R)) of - ["include", - "include2", - "include2", - "include3"] -> - ok; - RRR -> - test_server:fail({bad_include_file, RRR}) - end, - ok. - - - - -%%-------------------------------------------------------------------- -%% -%% Inhertit cases -%% - -%% Checks that normal inheritance works. -inherit_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(inherit_norm), - File = filename:join(DataDir, inherit), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, _Ws} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, inherit_norm_files(), [load]), - - %% Now check constant values: - 9 = m1_I1:c1(), - - 9 = m1_I2:c1(), - 14 = m1_I2:c2(), - 27 = m1_I2:c3(), - - 50 = m1_I3:c1(), - 14 = m1_I3:c2(), - 27 = m1_I3:c3(), - 91 = m1_I3:c4(), - 100 = m1_I3:c5(), - ok. - -%% Check that various inheritance shadowing is detected -inherit_warn(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, inherit_warn), - ok = ic:gen(File, stdopts(OutDir)), - {ok, R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(7, inherit_name_shadow, R), - ok. - -%% Check that various inheritance errors is detected -inherit_err(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, inherit_err), - error = ic:gen(File, stdopts(OutDir)), - {error, _Ws, R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(21, inherit_name_collision, R), - ok. - - -%% Checks that normal oneway operations works. -oneway_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(oneway_norm), - File = filename:join(DataDir, one), - - ok = ic:gen(File, stdopts(OutDir)), - ok = compile(OutDir, oneway_norm_files(), [load]), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, oneway_norm_files(), [load]), - ok. - -%% Check that non-void oneways are detected. -oneway_void(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, one_void), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(2, bad_oneway_type, R), - ok. - -%% Check that oneways cannot raise exceptions. -oneway_raises(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, one_raises), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(3, oneway_raises, R), - ok. - -%% Check that illegal out parameters are detected -oneway_out(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, one_out), - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(2, oneway_outparams, R), - ok. - -%% Checks that normal oneways, followed by other operations. -oneway_followed(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(oneway_followed), - File = filename:join(DataDir, one_followed), - - ok = ic:gen(File, stdopts(OutDir)), - ok = compile(OutDir, oneway_followed_files(), [load]), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, oneway_followed_files(), [load]), - ok. - - -%% Checks that normal attr operations works. -attr_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(attr_norm), - File = filename:join(DataDir, attr), - - ok = ic:gen(File, stdopts(OutDir)), - ok = compile(OutDir, attr_norm_files(), [load]), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, attr_norm_files(), [load]), - ok. - - -%% Checks all types are handled. -type_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(type_norm), - File = filename:join(DataDir, type), - - ok = ic:gen(File, stdopts(OutDir)), - ok = compile(OutDir, type_norm_files(), [load]), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, type_norm_files(), [load]), - ok. - -syntax1(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, syntax1), - - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(1, parse_error, R), - ok. - -syntax2(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, syntax2), - - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(1, parse_error, R), - ok. - -syntax3(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, syntax3), - - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(1, parse_error, R), - ok. - -syntax4(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, syntax4), - - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(1, parse_error, R), - ok. - -syntax5(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, syntax5), - - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(1, parse_error, R), - ok. - -syntax6(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, syntax6), - - error = ic:gen(File, stdopts(OutDir)), - {error, [], R} = - ic:gen(File, stdopts(OutDir)++[silent2]), - check_errors(1, parse_error, R), - ok. - - - -%%-------------------------------------------------------------------- -%% -%% Checks RAISES to be registered under IFR operation registration -%% ( OTP-2102 ) -%% - -%% Check that exceptions are really registered to operations. -raises_reg(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(raises_reg_check), - File = filename:join(DataDir, raises_reg), - - ok = ic:gen(File, stdopts(OutDir)), - {ok, []} = ic:gen(File, stdopts(OutDir)++[silent2]), - ok = compile(OutDir, raises_reg_files(), [load]), - - set_up('oe_raises_reg'), - - io:format("~n##### Starting the test case #####~n"), - io:format("Checking for existance of exception : ~s~n",["IDL:Raises_RegModule/Exception_1:1.0"]), - raises_register_check("IDL:Raises_RegModule/R_R/op:1.0","IDL:Raises_RegModule/Exception_1:1.0"), - - io:format("Checking for existance of exception : ~s~n",["IDL:Raises_RegModule/Exception_2:1.0"]), - raises_register_check("IDL:Raises_RegModule/R_R/op:1.0","IDL:Raises_RegModule/Exception_2:1.0"), - - io:format("Checking for existance of exception : ~s~n",["IDL:Raises_RegModule/XXXXXXXX:1.0"]), - raises_register_check("IDL:Raises_RegModule/R_R/op:1.0","IDL:RaisesModule/XXXXXXXX:1.0"), - - set_down('oe_raises_reg'), - - ok. - -set_up(Register) -> - io:format("Setting up.....~n"), - mnesia:stop(), - mnesia:delete_schema([node()]), - mnesia:create_schema([node()]), - mnesia:start(), - orber:install([node()]), - orber:start(), - io:format("Running OE_register()~n"), - Register:'oe_register'(). - -set_down(Register) -> - io:format("Running OE_unregister()~n"), - Register:'oe_unregister'(), - io:format("Setting down.....~n"), - orber:stop(), - orber:uninstall(), - mnesia:stop(), - mnesia:delete_schema([node()]). - - -raises_register_check(OpId,ExcId) -> - case is_valid_exc(OpId,ExcId) of - true -> - ok; % Because right exception where found, - % the test succeeds for normal cases. - false -> - ok; % Because the exception tested, is not - % registered for that operation. - FailReason -> - test_server:fail({FailReason, OpId, ExcId}) - % Because the test descovered errors in a previous - % stage, or no exceptions where registered att all. - % ( This testcase assumes that operations to be - % checked allways raise excption(s) ) - end. - -is_valid_exc(OpId,ExcId) -> - OE_IFR = orber_ifr:find_repository(), - OpDef = orber_ifr:'Repository_lookup_id'(OE_IFR,OpId), - ExcDefList = orber_ifr:get_exceptions(OpDef), - case ExcDefList of - [] -> - no_exceptions_registered; - _ -> - ExcDef=orber_ifr:lookup_id(OE_IFR,ExcId), - lists:member(ExcDef,ExcDefList) - end. - -%%-------------------------------------------------------------------- -%% -%% Utilities - - -stdopts(OutDir) -> - [{outdir, OutDir},{maxerrs, infinity}]. - -mk_unique(Prefix) -> - {A,B,C} = now(), - Prefix++"_"++integer_to_list(A)++"_"++integer_to_list(B)++"_"++ - integer_to_list(C). - -gen_file(File, Const) -> - {ok, Fd} = file:open(File++".idl", [write]), - io:format(Fd, "interface ~s {~n", [File]), - io:format(Fd, " const long ~s = 19955;~n", [Const]), - io:format(Fd, "};~n", []), - file:close(Fd). - - -%% Compile all files in Dir. Used for checking that valid Erlang has -%% been generated. -%%compile(Dir) -> -%% compile(Dir, []). -%%compile(Dir, Opts) -> -%% {ok, Cwd} = file:get_cwd(), -%% catch do_compile(Dir, Opts), -%% file:set_cwd(Cwd). - -%%do_compile(Dir, Opts) -> -%% ok = file:set_cwd(Dir), -%% up_to_date = ts_make_erl:all(Opts), -%% ok. - -compile(Dir, Files) -> - compile(Dir, Files, []). - -compile(Dir, Files, Opts) -> - {ok, Cwd} = file:get_cwd(), - file:set_cwd(Dir), - io:format("Changing to ~p~n", [Dir]), - case catch do_compile(Files, Opts) of - ok -> - file:set_cwd(Cwd); - Err -> - file:set_cwd(Cwd), - test_server:fail(Err) - end. - -do_compile([], _Opts) -> ok; -do_compile([F | Fs], Opts) -> - io:format("Compiling ~p", [F]), - case compile:file(F, Opts) of - ok -> - io:format(" ok~n", []), - do_load(F, Opts), - do_compile(Fs, Opts); - {ok, _} -> - io:format(" ok~n", []), - do_load(F, Opts), - do_compile(Fs, Opts); - {ok, _, _} -> - io:format(" ok~n", []), - do_load(F, Opts), - do_compile(Fs, Opts); - Err -> - io:format(" error: ~p~n", [Err]), - Err - end. - -do_load(File, Opts) -> - case lists:member(load, Opts) of - true -> - io:format("Loading file ~p", [File]), - code:purge(File), - R = code:load_abs(File), - io:format("Loaded: ~p", [R]); - false -> - ok - end. - - -%% Check that ErrList consists of exactly Num errors of type ErrType -check_errors(Num, ErrType, ErrList) -> - Num = length(ErrList), - lists:foreach(fun(T) -> - case catch element(1, element(4, T)) of - ErrType -> ok; - Else -> - test_server:fail({bad, ErrType, Else}) - end end, ErrList). - -to_list(X) when is_atom(X) -> atom_to_list(X); -to_list(X) -> X. - - -%% File must be an atom -gen_struct_file(File, Mod) -> - - {ok, Fd} = file:open(to_list(File)++".erl", [write]), - io:format(Fd, "~n", []), - io:format(Fd, "-module(~p).~n", [Mod]), - io:format(Fd, "-export([test/0]).~n", []), - io:format(Fd, "-include(\"oe_struct.hrl\").~n", []), - io:format(Fd, "test() ->~n", []), - io:format(Fd, " A = #'S1'{a=99, b=$a, s=\"123456789\"},~n", []), - io:format(Fd, " B = #'S2'{a=9, b=#'S2_S3'{a=1, b=9, b1=5, c=$2},~n", []), - io:format(Fd, " c=[#'S1'{a=1}, #'S1'{a=2}],~n", []), - io:format(Fd, -" c2=[#'S1'{a=2}, #'S1'{a=3}, #'S1'{a=2}, #'S1'{a=3}]},~n", []), - io:format(Fd, " C = #'S2_S3'{a=11, b=999, b1=19},~n", []), - io:format(Fd, " D = #s4{a=7},~n", []), - io:format(Fd, " E = {1, #'U1_S5'{a=3}},~n", []), - io:format(Fd, " F = {2, {$b, #'U1_U2_s6'{a=6, b=false}}},~n", []), - io:format(Fd, " ok.~n", []), - file:close(Fd). - - -union_norm_files() -> ['oe_u_norm']. -union_default_files() -> ['oe_u_default', i1]. - -typeid_files() -> ['oe_typeid', 'M3_M2_M1_I1', 'M2_M1_I1', 'M1_I1', 'I1']. - -struct_norm_files() -> ['oe_struct']. -oneway_norm_files() -> ['oe_one', 'I1']. -oneway_followed_files() -> ['oe_one_followed', 'I1']. -nasty_names_files() -> ['oe_nasty', 'I2', 'I1']. - -inherit_norm_files() -> [m1_I3, m1_I2, m1_I1, 'oe_inherit', 'I4', 'I3', - 'I2', 'I1']. - -forward_files() -> [i1, 'oe_forward']. -enum_norm_files() -> ['oe_enum']. -const_norm_files() -> ['oe_c_norm']. -attr_norm_files() -> ['oe_attr', 'I1', 'I2']. -type_norm_files() -> ['oe_type']. - -raises_reg_files() -> ['oe_raises_reg']. - - - - - - - - - - - - - - - - |