diff options
Diffstat (limited to 'lib/orber/src/orber_tc.erl')
| -rw-r--r-- | lib/orber/src/orber_tc.erl | 283 |
1 files changed, 283 insertions, 0 deletions
diff --git a/lib/orber/src/orber_tc.erl b/lib/orber/src/orber_tc.erl new file mode 100644 index 0000000000..7c2172b565 --- /dev/null +++ b/lib/orber/src/orber_tc.erl @@ -0,0 +1,283 @@ +%%-------------------------------------------------------------------- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%----------------------------------------------------------------- +%% File: orber_tc.erl +%% Description: +%% This file contains utility functions to create TypeCodes +%% +%%----------------------------------------------------------------- +-module(orber_tc). + +-include_lib("orber/include/ifr_types.hrl"). +-include_lib("orber/include/corba.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([null/0, void/0, short/0, unsigned_short/0, + long/0, longdouble/0, unsigned_long/0, long_long/0, + unsigned_long_long/0, float/0, double/0, + boolean/0, char/0, wchar/0, octet/0, any/0, + typecode/0, principal/0, + object_reference/2, struct/3, + union/5, enum/3, + string/1, wstring/1, sequence/2, array/2, alias/3, + exception/3, fixed/2, value/5, value_box/3, native/2, abstract_interface/2, + get_tc/1, check_tc/1]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% External interface functions +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Macros +%%----------------------------------------------------------------- +-define(DEBUG_LEVEL, 5). + +%%----------------------------------------------------------------- +%% A number of function which can be used to create TypeCodes +null() -> + tk_null. +void() -> + tk_void. +short() -> + tk_short. +unsigned_short() -> + tk_ushort. +long() -> + tk_long. +unsigned_long() -> + tk_ulong. +long_long() -> + tk_longlong. +unsigned_long_long() -> + tk_ulonglong. +float() -> + tk_float. +double() -> + tk_double. +longdouble() -> + tk_longdouble. + +boolean() -> + tk_boolean. +char() -> + tk_char. +wchar() -> + tk_wchar. +octet() -> + tk_octet. +any() -> + tk_any. +typecode() -> + tk_TypeCode. +principal() -> + tk_Principal. + +object_reference(Id, Name) -> + {tk_objref, Id, Name}. + +struct(Id, Name, ElementList) -> + {tk_struct, Id, Name, ElementList}. + +union(Id, Name, DiscrTC, Default, ElementList) -> + {tk_union, Id, Name, DiscrTC, Default, ElementList}. + +enum(Id, Name, ElementList) -> + {tk_enum, Id, Name, ElementList}. + +string(Length) -> + {tk_string, Length}. + +wstring(Length) -> + {tk_wstring, Length}. + +sequence(ElemTC, Length) -> + {tk_sequence, ElemTC, Length}. + +array(ElemTC, Length) -> + {tk_array, ElemTC, Length}. + +alias(Id, Name, TC) -> + {tk_alias, Id, Name, TC}. + +exception(Id, Name, ElementList) -> + {tk_except, Id, Name, ElementList}. + +fixed(Digits, Scale) -> + {tk_fixed, Digits, Scale}. + +value(RepId, Name, ValueModifier, TC, ElementList) -> + {tk_value, RepId, Name, ValueModifier, TC, ElementList}. + +value_box(RepId, Name, TC) -> + {tk_value_box, RepId, Name, TC}. + +native(RepId, Name) -> + {tk_native, RepId, Name}. + +abstract_interface(RepId, Name) -> + {tk_abstract_interface, RepId, Name}. + + +%%----------------------------------------------------------------- +%% Get TypeCode (can be used for constructed types like structs, +%% unions and exceptions) +%% +get_tc(T) when is_tuple(T) -> + Type = element(1, T), + case catch Type:tc() of + {'EXIT', R} -> + orber:dbg("[~p] ~p:get_tc(~p); Exit: ~p", + [?LINE, ?MODULE, T, R], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}); + X -> + X + end; +%% This call can be used if one have the IFR id and wants a typecode. +get_tc(IFRId) when is_list(IFRId) -> + Rep = orber_ifr:find_repository(), + Def = orber_ifr:lookup_id(Rep, IFRId), + Descr = orber_ifr:describe(Def), + TypeDescr = Descr#contained_description.value, + TypeDescr#typedescription.type. + + +%%----------------------------------------------------------------- +%% Check TypeCode format +%% +check_tc('tk_null') -> true; +check_tc('tk_void') -> true; +check_tc('tk_short') -> true; +check_tc('tk_ushort') -> true; +check_tc('tk_long') -> true; +check_tc('tk_ulong') -> true; +check_tc('tk_longlong') -> true; +check_tc('tk_ulonglong') -> true; +check_tc('tk_float') -> true; +check_tc('tk_double') -> true; +check_tc('tk_longdouble') -> true; +check_tc('tk_boolean') -> true; +check_tc('tk_char') -> true; +check_tc('tk_wchar') -> true; +check_tc('tk_octet') -> true; +check_tc('tk_any') -> true; +check_tc('tk_TypeCode') -> true; +check_tc('tk_Principal') -> true; +check_tc({'tk_objref', RepId, Name}) when is_list(RepId) andalso + is_list(Name) -> true; +check_tc({'tk_struct', RepId, Name, ElementList}) when is_list(RepId) andalso + is_list(Name) -> + Fun = fun(X) -> + case X of + {MemberName, MemberTC} when is_list(MemberName) -> + check_tc(MemberTC); + _ -> + false + end + end, + lists:all(Fun, ElementList); +check_tc({'tk_union', RepId, Name, DiscrTC, + Default, ElementList}) when is_list(RepId) andalso + is_list(Name) andalso + is_integer(Default) -> + case check_tc(DiscrTC) of + false -> + false; + true -> + Fun = fun(X) -> + case X of + {_, MemberName, MemberTC} when + is_list(MemberName) -> + check_tc(MemberTC); + _ -> + false + end + end, + lists:all(Fun, ElementList) + end; +check_tc({'tk_enum', RepId, Name, ElementList}) when is_list(RepId) andalso + is_list(Name) -> + Fun = fun(X) -> + if + is_list(X) -> + true; + true -> + false + end + end, + lists:all(Fun, ElementList); +check_tc({'tk_string', MaxLength}) when is_integer(MaxLength) -> true; +check_tc({'tk_wstring', MaxLength}) when is_integer(MaxLength) -> true; +check_tc({'tk_fixed', Digits, Scale}) when is_integer(Digits) andalso + is_integer(Scale) -> true; +check_tc({'tk_sequence', ElemTC, MaxLength}) when is_integer(MaxLength) -> + check_tc(ElemTC); +check_tc({'tk_array', ElemTC, Length}) when is_integer(Length) -> + check_tc(ElemTC); +check_tc({'tk_alias', RepId, Name, TC}) when is_list(RepId) andalso + is_list(Name) -> + check_tc(TC); +check_tc({'tk_except', RepId, Name, ElementList}) when is_list(RepId) andalso + is_list(Name) -> + Fun = fun(X) -> + case X of + {MemberName, TC} when is_list(MemberName) -> + check_tc(TC); + _ -> + false + end + end, + lists:all(Fun, ElementList); +check_tc({'tk_value', RepId, Name, ValueModifier, + TC, ElementList}) when is_list(RepId) andalso + is_list(Name) andalso + is_integer(ValueModifier) -> + case check_tc(TC) of + false -> + false; + true -> + Fun = fun(X) -> + case X of + {MemberName, MemberTC, Visibility} when + is_list(MemberName) andalso is_integer(Visibility) -> + check_tc(MemberTC); + _ -> + false + end + end, + lists:all(Fun, ElementList) + end; +check_tc({'tk_value_box', RepId, Name, TC}) when is_list(RepId) andalso + is_list(Name) -> + check_tc(TC); +check_tc({'tk_native', RepId, Name}) when is_list(RepId) andalso + is_list(Name) -> true; +check_tc({'tk_abstract_interface', RepId, Name}) when is_list(RepId) andalso + is_list(Name) -> true; +check_tc({'none', Indirection}) when is_integer(Indirection) -> true; +check_tc(_) -> false. + |