aboutsummaryrefslogtreecommitdiffstats
path: root/lib/orber/src/orber_tc.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/orber/src/orber_tc.erl')
-rw-r--r--lib/orber/src/orber_tc.erl283
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.
+