diff options
Diffstat (limited to 'lib/ic')
303 files changed, 0 insertions, 69164 deletions
diff --git a/lib/ic/AUTHORS b/lib/ic/AUTHORS deleted file mode 100644 index f3791aabaa..0000000000 --- a/lib/ic/AUTHORS +++ /dev/null @@ -1,8 +0,0 @@ -Original Authors: - -Peter Lundel -Lars Thorsen -Babbis Xagorarakis - - -Contributors: diff --git a/lib/ic/Makefile b/lib/ic/Makefile deleted file mode 100644 index 624aa62a6e..0000000000 --- a/lib/ic/Makefile +++ /dev/null @@ -1,42 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-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% -# -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include vsn.mk -VSN=$(ORBER_VSN) - -# ---------------------------------------------------- -# Common Macros -# ---------------------------------------------------- - -SUB_DIRECTORIES = src c_src java_src doc/src examples/pre_post_condition - -SPECIAL_TARGETS = - -# ---------------------------------------------------- -# Default Subdir Targets -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_subdir.mk - diff --git a/lib/ic/c_src/Makefile b/lib/ic/c_src/Makefile deleted file mode 100644 index 35d6013279..0000000000 --- a/lib/ic/c_src/Makefile +++ /dev/null @@ -1,25 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-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% -# -# -# -# Invoke with GNU make or clearmake -C gnu. -# - -include $(ERL_TOP)/make/run_make.mk diff --git a/lib/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in deleted file mode 100644 index c0dad59557..0000000000 --- a/lib/ic/c_src/Makefile.in +++ /dev/null @@ -1,165 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-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% -# -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -CC = @CC@ -LIBS = @LIBS@ - -LIBDIR = ../priv/lib/$(TARGET) -OBJDIR = ../priv/obj/$(TARGET) -INCDIR = ../include -ERL_INTERFACE_FLAGS = \ - -I$(ERL_TOP)/lib/erl_interface/include \ - -I$(ERL_TOP)/lib/erl_interface/src - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(IC_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) - -# ---------------------------------------------------- -# File Specs -# ---------------------------------------------------- - -IDL_FILES = \ - $(INCDIR)/erlang.idl - -ifeq ($(findstring win32,$(TARGET)),win32) -USING_MINGW=@MIXED_CYGWIN_MINGW@ -ifeq ($(USING_MINGW),yes) -AR_OUT = rcv -CC_FLAGS = -LIBRARY = $(LIBDIR)/libic.a -SKIP_BUILDING_BINARIES := false -else -LIBRARY = $(LIBDIR)/ic.lib -AR_OUT = -out: -CC_FLAGS = -MT -endif -ifeq ($(HOST_OS),) -HOST_OS := $(shell $(ERL_TOP)/erts/autoconf/config.guess) -endif -ifeq ($(findstring solaris,$(HOST_OS)),solaris) -SKIP_BUILDING_BINARIES := true -endif -else -ifeq ($(V),0) -AR_OUT = rc -else -AR_OUT = rcv -endif -CC_FLAGS = @DED_CFLAGS@ -LIBRARY = $(LIBDIR)/libic.a -SKIP_BUILDING_BINARIES := false -endif - -C_FILES = \ - ic.c \ - ic_tmo.c \ - oe_ei_encode_version.c \ - oe_ei_encode_long.c \ - oe_ei_encode_ulong.c \ - oe_ei_encode_double.c \ - oe_ei_encode_char.c \ - oe_ei_encode_string.c \ - oe_ei_encode_atom.c \ - oe_ei_encode_pid.c \ - oe_ei_encode_port.c \ - oe_ei_encode_ref.c \ - oe_ei_encode_term.c \ - oe_ei_encode_tuple_header.c \ - oe_ei_encode_list_header.c \ - oe_ei_encode_longlong.c \ - oe_ei_encode_ulonglong.c \ - oe_ei_encode_wchar.c \ - oe_ei_encode_wstring.c \ - oe_ei_decode_longlong.c \ - oe_ei_decode_ulonglong.c \ - oe_ei_decode_wchar.c \ - oe_ei_decode_wstring.c \ - oe_ei_code_erlang_binary.c - -H_FILES = $(INCDIR)/ic.h - -OBJ_FILES= $(C_FILES:%.c=$(OBJDIR)/%.o) - -ALL_CFLAGS = @CFLAGS@ @DEFS@ -I$(INCDIR) $(ERL_INTERFACE_FLAGS) $(CFLAGS) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -ifeq ($(SKIP_BUILDING_BINARIES), true) -debug opt: -else -debug opt: $(LIBRARY) -endif - -clean: - rm -f $(LIBRARY) $(OBJ_FILES) - rm -f core *~ - -docs: - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) - -$(LIBRARY): $(OBJ_FILES) - -$(V_AR) $(AR_OUT) $@ $(OBJ_FILES) - -$(V_RANLIB) $@ - -$(OBJDIR)/%.o: %.c - $(V_CC) $(CC_FLAGS) -c -o $@ $(ALL_CFLAGS) $< - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/c_src" - $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" - $(INSTALL_DIR) "$(RELEASE_PATH)/usr/include" - $(INSTALL_DIR) "$(RELEASE_PATH)/usr/lib" - $(INSTALL_DATA) ic.c ic_tmo.c "$(RELSYSDIR)/c_src" - $(INSTALL_DATA) $(IDL_FILES) $(H_FILES) "$(RELSYSDIR)/include" - $(INSTALL_DATA) $(LIBRARY) "$(RELSYSDIR)/priv/lib" - $(INSTALL_DATA) $(IDL_FILES) $(H_FILES) "$(RELEASE_PATH)/usr/include" - $(INSTALL_DATA) $(LIBRARY) "$(RELEASE_PATH)/usr/lib" - -release_docs_spec: - - - - - - diff --git a/lib/ic/c_src/Makefile.win32 b/lib/ic/c_src/Makefile.win32 deleted file mode 100644 index 670a17f958..0000000000 --- a/lib/ic/c_src/Makefile.win32 +++ /dev/null @@ -1,109 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-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% -# -# - -CC = cl.exe -LIBRARIAN = lib.exe /nologo - -IC_INCLUDE = ..\include -EI_INCLUDE = \erts\lib\erl_interface\src - -CFLAGS = /MT /nologo /Ox /I$(IC_INCLUDE) /I$(EI_INCLUDE) -TARGET = win32 -OBJDIR = ..\priv\obj\$(TARGET) -LIBDIR = ..\priv\lib\$(TARGET) - - -C_FILES = \ - ic.c \ - oe_ei_encode_version.c \ - oe_ei_encode_long.c \ - oe_ei_encode_ulong.c \ - oe_ei_encode_double.c \ - oe_ei_encode_char.c \ - oe_ei_encode_string.c \ - oe_ei_encode_atom.c \ - oe_ei_encode_pid.c \ - oe_ei_encode_port.c \ - oe_ei_encode_ref.c \ - oe_ei_encode_term.c \ - oe_ei_encode_tuple_header.c \ - oe_ei_encode_list_header.c \ - oe_ei_encode_longlong.c \ - oe_ei_encode_ulonglong.c \ - oe_ei_encode_wchar.c \ - oe_ei_encode_wstring.c \ - oe_ei_decode_longlong.c \ - oe_ei_decode_ulonglong.c \ - oe_ei_decode_wchar.c \ - oe_ei_decode_wstring.c - -OBJ_FILES = \ - $(OBJDIR)\ic.obj \ - $(OBJDIR)\oe_ei_encode_version.obj \ - $(OBJDIR)\oe_ei_encode_long.obj \ - $(OBJDIR)\oe_ei_encode_ulong.obj \ - $(OBJDIR)\oe_ei_encode_double.obj \ - $(OBJDIR)\oe_ei_encode_char.obj \ - $(OBJDIR)\oe_ei_encode_string.obj \ - $(OBJDIR)\oe_ei_encode_atom.obj \ - $(OBJDIR)\oe_ei_encode_pid.obj \ - $(OBJDIR)\oe_ei_encode_port.obj \ - $(OBJDIR)\oe_ei_encode_ref.obj \ - $(OBJDIR)\oe_ei_encode_term.obj \ - $(OBJDIR)\oe_ei_encode_tuple_header.obj \ - $(OBJDIR)\oe_ei_encode_list_header.obj \ - $(OBJDIR)\oe_ei_encode_longlong.obj \ - $(OBJDIR)\oe_ei_encode_ulonglong.obj \ - $(OBJDIR)\oe_ei_encode_wchar.obj \ - $(OBJDIR)\oe_ei_encode_wstring.obj \ - $(OBJDIR)\oe_ei_decode_longlong.obj \ - $(OBJDIR)\oe_ei_decode_ulonglong.obj \ - $(OBJDIR)\oe_ei_decode_wchar.obj \ - $(OBJDIR)\oe_ei_decode_wstring.obj - - -LIBRARY = $(LIBDIR)\ic.lib - - -all: $(OBJDIR) $(LIBDIR) $(LIBRARY) - -release: - echo "Nothing to do" - -clean: - -del $(OBJ_FILES) $(LIBRARY) - -$(LIBRARY): $(OBJ_FILES) - $(LIBRARIAN) /OUT:$@ $** - -{}.c{$(OBJDIR)}.obj: - $(CC) $(CFLAGS) /c /Fo$@ $< - -$(OBJDIR): - -mkdir $(OBJDIR) - -$(LIBDIR): - -mkdir $(LIBDIR) - -$(LIBRARY): - - -{}.c: $(EI_INCLUDE)\ei.h $(IC_INCLUDE)\ic. diff --git a/lib/ic/c_src/ic.c b/lib/ic/c_src/ic.c deleted file mode 100644 index 6e55a13f4f..0000000000 --- a/lib/ic/c_src/ic.c +++ /dev/null @@ -1,613 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - -static int oe_send(CORBA_Environment *env); - -void CORBA_free(void *p) -{ - if (p != NULL) - free(p); -} - - -CORBA_char *CORBA_string_alloc(CORBA_unsigned_long len) -{ - return (CORBA_char *) malloc(len+1); -} - - -CORBA_wchar *CORBA_wstring_alloc(CORBA_unsigned_long len) -{ - return (CORBA_wchar *) malloc(len*(__OE_WCHAR_SIZE_OF__+1)); -} - - -CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz) -{ - CORBA_Environment *env; - - env = malloc(sizeof(CORBA_Environment)); - - if (env != NULL) { - - /* CORBA */ - env->_major = CORBA_NO_EXCEPTION; - - /* Set by user */ - env->_fd= -1; - env->_inbufsz = inbufsz; - env->_inbuf = malloc(inbufsz); - env->_outbufsz = outbufsz; - env->_outbuf = malloc(outbufsz); - env->_memchunk = __OE_MEMCHUNK__; - env->_regname[0] = '\0'; - env->_to_pid = NULL; - env->_from_pid = NULL; - - /* Set by client or server */ - env->_iin = 0; - env->_iout = 0; - env->_operation[0] = '\0'; - env->_received = 0; - /* env->_caller */ - /* env->_unique */ - env->_exc_id = NULL; - env->_exc_value = NULL; - env->_ref_counter_1 = 0; - env->_ref_counter_2 = 0; - env->_ref_counter_3 = 0; - } - - return env; -} - -#if 0 -/* NOT EXPORTED SO FAR */ -void CORBA_Environment_free(CORBA_Environment *env) -{ - - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_exception_free(env); - CORBA_free(env); -} -#endif - - -CORBA_char *CORBA_exception_id(CORBA_Environment *env) -{ - - return env->_exc_id; -} - -void *CORBA_exception_value(CORBA_Environment *env) -{ - - return env->_exc_value; -} - -void CORBA_exception_free(CORBA_Environment *env) -{ - - /* Setting major value */ - env->_major=CORBA_NO_EXCEPTION; - - /* Freeing storage */ - CORBA_free(env->_exc_id); - CORBA_free(env->_exc_value); - env->_exc_id = env->_exc_value = NULL; -} - -void CORBA_exc_set(CORBA_Environment *env, - CORBA_exception_type Major, - CORBA_char *Id, - CORBA_char *Value) -{ - int ilen,vlen; - - /* Create exception only if exception not already set */ - if (env->_major == CORBA_NO_EXCEPTION) { - - /* Counting lengths */ - ilen = strlen(Id)+1; - vlen = strlen(Value)+1; - - /* Allocating storage */ - env->_exc_id = (CORBA_char *) malloc(ilen); - env->_exc_value = (CORBA_char *) malloc(vlen); - - /* Initiating */ - env->_major = Major; - strcpy(env->_exc_id,Id); - strcpy(env->_exc_value,Value); - } -} - -#define ERLANG_REF_NUM_SIZE 18 -#define ERLANG_REF_MASK (~(~((unsigned int)0) << ERLANG_REF_NUM_SIZE)) - -/* Initiating message reference */ -void ic_init_ref(CORBA_Environment *env, erlang_ref *ref) -{ - - strcpy(ref->node, erl_thisnodename()); - - ref->len = 3; - - ++env->_ref_counter_1; - env->_ref_counter_1 &= ERLANG_REF_MASK; - if (env->_ref_counter_1 == 0) - if (++env->_ref_counter_2 == 0) - ++env->_ref_counter_3; - ref->n[0] = env->_ref_counter_1; - ref->n[1] = env->_ref_counter_2; - ref->n[2] = env->_ref_counter_3; - - ref->creation = erl_thiscreation(); -} - -/* Comparing message references */ -int ic_compare_refs(erlang_ref *ref1, erlang_ref *ref2) -{ - int i; - - if(strcmp(ref1->node, ref2->node) != 0) - return -1; - - if (ref1->len != ref2->len) - return -1; - - for (i = 0; i < ref1->len; i++) - if (ref1->n[i] != ref2->n[i]) - return -1; - - return 0; -} - -/* Length counter for wide strings */ -int ic_wstrlen(CORBA_wchar * p) -{ - int len = 0; - - while(1) { - if (p[len] == 0) - return len; - - len+=1; - } -} - - -/* Wide string compare function */ -int ic_wstrcmp(CORBA_wchar * ws1, CORBA_wchar * ws2) -{ - int index = 0; - - while(1) { - if (ws1[index] == ws2[index]) { - - if (ws1[index] == 0) - return 0; - - index += 1; - - } else - return -1; - } -} - -/* For backward compatibility -- replaced by prepare_request_decoding() */ -int ___call_info___(CORBA_Object obj, CORBA_Environment *env) -{ - return oe_prepare_request_decoding(env); -} - -/* #define DEBUG_MAP */ - -#if defined(DEBUG_MAP) - -#define PRINT_MAPS(P, M, S) print_maps(P, M, S) -#define PRINT_MAP(T, M) print_map(T, "", M) - -static void print_map(char *title, char *prefix, oe_map_t *map) -{ - if (map == NULL) { - fprintf(stdout, "%s => NULL\n", title); - return; - } - - fprintf(stdout, "%s%s\n", prefix, title); - - { - int j, len = map->length; - - fprintf(stdout, "%s length: %d\n", prefix, len); - fprintf(stdout, "%s operations: 0x%X%d\n", prefix, map->operations); - - for (j = 0 ; j < len ; j++) { - fprintf(stdout, "%s operation[%d]:\n", prefix, j); - - if (map->operations[j].interface != NULL) { - fprintf(stdout, "%s intf: %s\n", prefix, - map->operations[j].interface); - } else { - fprintf(stdout, "%s intf: NULL\n", prefix); - } - fprintf(stdout, "%s name: %s\n", prefix, - map->operations[j].name); - fprintf(stdout, "%s func: 0x%X\n", prefix, - map->operations[j].function); - } - } - fflush(stdout); -} - -static void print_maps(char* title, oe_map_t * maps, int size) -{ - int i; - char p[64]; - - fprintf(stdout, "%s\n", title); - - for (i = 0 ; i < size ; i++) { - sprintf(p, "map[%d]:", i); - print_map(p, " ", &maps[i]); - } - fprintf(stdout, "\n"); - fflush(stdout); -} - -#else - -#define PRINT_MAPS(P, M, S) -#define PRINT_MAP(T, M) - -#endif /* if defined(DEBUG_MAP) */ - - -/* Generic server switch */ -int oe_exec_switch(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map) -{ - /* Setting local variables */ - int res = 0; - int index = 0; - - /* XXX map may be NULL !! */ - int length = map->length; - char* op = env->_operation; - - PRINT_MAP("switching on map", map); - - /* Initiating exception indicator */ - env->_major = CORBA_NO_EXCEPTION; - - if ((res = oe_prepare_request_decoding(env) < 0)) - return res; -#if defined(DEBUG_MAP) - fprintf(stdout, "looking for operation: %s\n", op); fflush(stdout); -#endif - for (index = 0; index < length; index++) { -#if defined(DEBUG_MAP) - fprintf(stdout, "map->operations[%d].name: %s\n", - index, map->operations[index].name); - fflush(stdout); -#endif - if(strcmp(map->operations[index].name, op) == 0) { -#if defined(DEBUG_MAP) - fprintf(stdout, "calling map->operations[%d].function: 0x%X\n", - index, map->operations[index].function); - fflush(stdout); -#endif - return map->operations[index].function(obj, env); - } - } - /* Bad call */ - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION, - "Invalid operation"); - return -1; -} - -/* For backward compatibility */ -int ___switch___(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map) -{ - return oe_exec_switch(obj, env, map); -} - - -oe_map_t* oe_merge_maps(oe_map_t *maps, int size) -{ - int i, j, length, len, maplen, malloc_size; - void *memp; - oe_map_t *merged; - - if ((maps == NULL) || (size <= 0)) - return NULL; - - PRINT_MAPS("merging maps", maps, size); - - length = 0; - for (i = 0; i < size; i++) - length += (maps[i].length); - - maplen = OE_ALIGN(sizeof(oe_map_t)); - malloc_size = maplen + OE_ALIGN(length*sizeof(oe_operation_t)); - if ((memp = malloc(malloc_size)) == NULL) - return NULL; - - merged = memp; - merged->length = length; - merged->operations = (oe_operation_t *)((char*)memp + maplen); - - for (i = 0, len = 0; i < size; i++) { - for(j = 0 ; j < maps[i].length; j++) - merged->operations[len+j] = maps[i].operations[j]; - len += maps[i].length; - } - PRINT_MAP("merged map", merged); - return merged; -} - -/* For backward compatibility */ -oe_map_t* ___merge___(oe_map_t *maps, int size) -{ - return oe_merge_maps(maps, size); -} - -/* Client send message (Erlang distribution protocol) */ -static int oe_send(CORBA_Environment *env) -{ - if (strlen(env->_regname) == 0) { - if (ei_send_encoded(env->_fd, env->_to_pid, env->_outbuf, - env->_iout) < 0) { - /* XXX Cannot send to peer? */ - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE, - "Cannot connect to server"); - return -1; - } - } else { - if (ei_send_reg_encoded(env->_fd, env->_from_pid, - env->_regname, env->_outbuf, - env->_iout) < 0) { - /* XXX Cannot send to peer? */ - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE, - "Cannot connect to server"); - return -1; - } - } - return 0; -} - -/* Send notification (gen_server client) */ -int oe_send_notification(CORBA_Environment *env) -{ - return oe_send(env); -} - -/* Send request and receive reply (gen_server client) */ -int oe_send_request_and_receive_reply(CORBA_Environment *env) -{ - int msgType = 0; - erlang_msg msg; - - if (oe_send(env) < 0) - return -1; - - do { - if ((msgType = ei_receive_encoded(env->_fd, - &env->_inbuf, - &env->_inbufsz, - &msg, &env->_iin)) < 0) { - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, - "Cannot decode message"); - return -1; - } - } while (msgType != ERL_SEND && msgType != ERL_REG_SEND); - - /* Extracting return message header */ - if (oe_prepare_reply_decoding(env) < 0) { - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, "Bad message"); - return -1; - } - return 0; -} - -/* Prepare notification encoding (gen_server client) */ -int oe_prepare_notification_encoding(CORBA_Environment *env) -{ - env->_iout = 0; - oe_ei_encode_version(env); - oe_ei_encode_tuple_header(env, 2); - oe_ei_encode_atom(env, "$gen_cast"); - return 0; -} - -/* Prepare request encoding (gen_server client) */ -int oe_prepare_request_encoding(CORBA_Environment *env) -{ - int error = 0; - - env->_iout = 0; - oe_ei_encode_version(env); - oe_ei_encode_tuple_header(env, 3); - oe_ei_encode_atom(env, "$gen_call"); - oe_ei_encode_tuple_header(env, 2); - if ((error = oe_ei_encode_pid(env, env->_from_pid)) < 0) - return error; - if ((error = oe_ei_encode_ref(env, &env->_unique)) < 0) - return error; - return 0; -} - -/* Prepare reply decoding (gen_server client) */ -int oe_prepare_reply_decoding(CORBA_Environment *env) -{ - int error = 0; - int version = 0; - erlang_ref unique; - - env->_iin = 0; - env->_received = 0; - - if ((error = ei_decode_version(env->_inbuf, - &env->_iin, - &version)) < 0) - return error; - if ((error = ei_decode_tuple_header(env->_inbuf, - &env->_iin, - &env->_received)) < 0) - return error; - if ((error = ei_decode_ref(env->_inbuf, - &env->_iin, - &unique)) < 0) - return error; - return ic_compare_refs(&env->_unique, &unique); -} - - -/* Prepare request decoding (gen_server server) */ -int oe_prepare_request_decoding(CORBA_Environment *env) -{ - char gencall_atom[10]; - int error = 0; - int version = 0; - - env->_iin = 0; - env->_received = 0; - memset(gencall_atom, 0, 10); - ei_decode_version(env->_inbuf, &env->_iin, &version); - ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received); - ei_decode_atom(env->_inbuf, &env->_iin, gencall_atom); - - if (strcmp(gencall_atom, "$gen_cast") == 0) { - if ((error = ei_decode_atom(env->_inbuf, &env->_iin, - env->_operation)) < 0) { - ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received); - if ((error = ei_decode_atom(env->_inbuf, &env->_iin, - env->_operation)) < 0) { - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION, - "Bad Message, cannot extract operation"); - return error; - } - env->_received -= 1; - } else - env->_received -= 2; - return 0; - } - if (strcmp(gencall_atom, "$gen_call") == 0) { - ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received); - if ((error = ei_decode_pid(env->_inbuf, &env->_iin, - &env->_caller)) < 0) { - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, - "Bad Message, bad caller identity"); - return error; - } - if ((error = ei_decode_ref(env->_inbuf, &env->_iin, - &env->_unique)) < 0) { - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, - "Bad Message, bad message reference"); - return error; - } - if ((error = ei_decode_atom(env->_inbuf, &env->_iin, - env->_operation)) < 0) { - - ei_decode_tuple_header(env->_inbuf, &env->_iin, &env->_received); - - if ((error = ei_decode_atom(env->_inbuf, &env->_iin, - env->_operation)) < 0) { - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, BAD_OPERATION, - "Bad Message, cannot extract operation"); - return error; - } - env->_received -= 1; - return 0; - } - else { - env->_received -= 2; - return 0; - } - } - - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, - "Bad message, neither cast nor call"); - return -1; -} - -/* Prepare reply encoding (gen_server server) */ -int oe_prepare_reply_encoding(CORBA_Environment *env) -{ - env->_iout = 0; - oe_ei_encode_version(env); - oe_ei_encode_tuple_header(env, 2); - oe_ei_encode_ref(env, &env->_unique); - return 0; -} - -/* ---- Function for making it more easy to implement a server */ -/* Server receive (possibly) send reply (gen_server server) */ - -int oe_server_receive(CORBA_Environment *env, oe_map_t *map) -{ - int res = 0, loop = 1; - erlang_msg msg; - - while (res >= 0 && loop > 0) { - res = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, - &msg, &env->_iin); - switch(res) { - case ERL_SEND: - case ERL_REG_SEND: - oe_exec_switch(NULL, env, map); - switch(env->_major) { - case CORBA_NO_EXCEPTION: - break; - case CORBA_SYSTEM_EXCEPTION: - /* XXX stderr */ - fprintf(stderr, "Request failure, reason : %s\n", - (char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - break; - default: /* Should not happen */ - CORBA_exception_free(env); - break; - } - /* send reply */ - /* XXX We are required to set env->_iout = 0 if oneway?? */ - if (env->_iout > 0) - ei_send_encoded(env->_fd, &env->_caller, env->_outbuf, - env->_iout); - loop = 0; - break; - case ERL_TICK: - break; - default: - /* XXX */ - if (res < 0) { - fprintf(stderr, "Result negative: %d\n", res); - loop = 0; - } - break; - } - } - - return 0; -} - diff --git a/lib/ic/c_src/ic_tmo.c b/lib/ic/c_src/ic_tmo.c deleted file mode 100644 index ef66f67d55..0000000000 --- a/lib/ic/c_src/ic_tmo.c +++ /dev/null @@ -1,136 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-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% - * - */ -#include <ic.h> - -static int oe_send_tmo(CORBA_Environment *env, unsigned int ms); - -/* Client send message (Erlang distribution protocol) */ -static int oe_send_tmo(CORBA_Environment *env, unsigned int ms) -{ - if (strlen(env->_regname) == 0) { - if (ei_send_encoded_tmo(env->_fd, env->_to_pid, env->_outbuf, - env->_iout, ms) < 0) { - /* XXX Cannot send to peer? */ - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE, - "Cannot connect to server"); - return -1; - } - } else { - if (ei_send_reg_encoded_tmo(env->_fd, env->_from_pid, - env->_regname, env->_outbuf, - env->_iout, ms) < 0) { - /* XXX Cannot send to peer? */ - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, NO_RESPONSE, - "Cannot connect to server"); - return -1; - } - } - return 0; -} - -/* Send notification (gen_server client) */ -int oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms) -{ - return oe_send_tmo(env, send_ms); -} - -/* Send request and receive reply (gen_server client) */ -int oe_send_request_and_receive_reply_tmo(CORBA_Environment *env, - unsigned int send_ms, - unsigned int recv_ms) -{ - int msgType = 0; - erlang_msg msg; - - if (oe_send_tmo(env, send_ms) < 0) - return -1; - - do { - if ((msgType = ei_receive_encoded_tmo(env->_fd, - &env->_inbuf, - &env->_inbufsz, - &msg, &env->_iin, - recv_ms)) < 0) { - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, - "Cannot decode message"); - return -1; - } - } while (msgType != ERL_SEND && msgType != ERL_REG_SEND); - - /* Extracting return message header */ - if (oe_prepare_reply_decoding(env) < 0) { - CORBA_exc_set(env, CORBA_SYSTEM_EXCEPTION, MARSHAL, "Bad message"); - return -1; - } - return 0; -} - -/* Server receive (possibly) send reply (gen_server server) */ - -int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, - unsigned int send_ms, - unsigned int recv_ms) -{ - int res = 0, loop = 1; - erlang_msg msg; - - while (res >= 0 && loop > 0) { - res = ei_receive_encoded_tmo(env->_fd, &env->_inbuf, &env->_inbufsz, - &msg, &env->_iin, recv_ms); - switch(res) { - case ERL_SEND: - case ERL_REG_SEND: - oe_exec_switch(NULL, env, map); - switch(env->_major) { - case CORBA_NO_EXCEPTION: - break; - case CORBA_SYSTEM_EXCEPTION: - /* XXX stderr */ - fprintf(stderr, "Request failure, reason : %s\n", - (char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - break; - default: /* Should not happen */ - CORBA_exception_free(env); - break; - } - /* send reply */ - /* XXX We are required to set env->_iout = 0 if oneway?? */ - if (env->_iout > 0) - ei_send_encoded_tmo(env->_fd, &env->_caller, env->_outbuf, - env->_iout, send_ms); - loop = 0; - break; - case ERL_TICK: - break; - default: - /* XXX */ - if (res < 0) { - fprintf(stderr, "Result negative: %d\n", res); - loop = 0; - } - break; - } - } - - return 0; -} - diff --git a/lib/ic/c_src/oe_ei_code_erlang_binary.c b/lib/ic/c_src/oe_ei_code_erlang_binary.c deleted file mode 100644 index 81610facbc..0000000000 --- a/lib/ic/c_src/oe_ei_code_erlang_binary.c +++ /dev/null @@ -1,106 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2001-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% - * - */ -#include <ic.h> - - -int oe_encode_erlang_binary(CORBA_Environment *ev, erlang_binary *binary) { - - int size = ev->_iout; - - ei_encode_binary(0, &size, binary->_buffer, binary->_length); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; - } - - return ei_encode_binary(ev->_outbuf, &ev->_iout, binary->_buffer, binary->_length); -} - - - -int oe_sizecalc_erlang_binary(CORBA_Environment *ev, int* _index, int* _size) { - - long _malloc_size = 0; - int _error = 0; - - if(*_size == 0) - *_size = ((*_size + sizeof(erlang_binary))+sizeof(double)-1)&~(sizeof(double)-1); - - if ((_error = ei_decode_binary(ev->_inbuf, _index, 0, &_malloc_size)) < 0) - return _error; - - *_size = ((*_size + (int)_malloc_size)+sizeof(double)-1)&~(sizeof(double)-1); - - return 0; -} - - -int oe_decode_erlang_binary(CORBA_Environment *ev, char *_first, int* _index, erlang_binary *binary) { - - long _length = 0; - int _error = 0; - - if((char*) binary == _first) - *_index = ((*_index + sizeof(erlang_binary))+sizeof(double)-1)&~(sizeof(double)-1); - - binary->_buffer = (CORBA_octet *)(_first+*_index); - - if ((_error = ei_decode_binary(ev->_inbuf, &ev->_iin, binary->_buffer, &_length)) < 0) - return _error; - - binary->_length = (CORBA_unsigned_long)_length; - - *_index = ((*_index)+_length+sizeof(double)-1)&~(sizeof(double)-1); - - return 0; -} - - - -int print_erlang_binary(erlang_binary *binary) { - - int i=0; - - if (binary == NULL) - return -1; - - fprintf(stdout,"binary->_length : %ld\n",binary->_length); - fprintf(stdout,"binary->_buffer : "); - if(binary->_buffer != NULL) { - for (i=0; i<binary->_length; i++) - fprintf(stdout,"%c",binary->_buffer[i]); - fprintf(stdout,"\n"); - } else - fprintf(stdout,"NULL\n"); - return 0; -} diff --git a/lib/ic/c_src/oe_ei_decode_longlong.c b/lib/ic/c_src/oe_ei_decode_longlong.c deleted file mode 100644 index 7d872ce94f..0000000000 --- a/lib/ic/c_src/oe_ei_decode_longlong.c +++ /dev/null @@ -1,26 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -#include <ic.h> - - -int oe_ei_decode_longlong(const char *buf, int *index, CORBA_long_long *p) { - return ei_decode_long(buf, index, p); -} diff --git a/lib/ic/c_src/oe_ei_decode_ulonglong.c b/lib/ic/c_src/oe_ei_decode_ulonglong.c deleted file mode 100644 index d071d09a43..0000000000 --- a/lib/ic/c_src/oe_ei_decode_ulonglong.c +++ /dev/null @@ -1,26 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -#include <ic.h> - - -int oe_ei_decode_ulonglong(const char *buf, int *index, CORBA_unsigned_long_long *p) { - return ei_decode_ulong(buf, index, p); -} diff --git a/lib/ic/c_src/oe_ei_decode_wchar.c b/lib/ic/c_src/oe_ei_decode_wchar.c deleted file mode 100644 index bb6899b7b3..0000000000 --- a/lib/ic/c_src/oe_ei_decode_wchar.c +++ /dev/null @@ -1,26 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -#include <ic.h> - - -int oe_ei_decode_wchar(const char *buf, int *index, CORBA_wchar *p) { - return ei_decode_ulong(buf, index, p); -} diff --git a/lib/ic/c_src/oe_ei_decode_wstring.c b/lib/ic/c_src/oe_ei_decode_wstring.c deleted file mode 100644 index 5b676fd579..0000000000 --- a/lib/ic/c_src/oe_ei_decode_wstring.c +++ /dev/null @@ -1,108 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -#include <ic.h> - - -/* Scratch function */ -int oe_ei_decode_wstring(const char *buf, int *index, CORBA_wchar *p) { - - int length,error_code,type,tmp=0; - char * tmp_space = NULL; - - - if ((error_code = ei_get_type(buf, index, &type, &length)) < 0) - return error_code; - - switch(type) { - - case ERL_LIST_EXT: /* A list */ - case ERL_NIL_EXT: /* An empty list */ - - if (p) { /* Decoding part */ - - if ((error_code = ei_decode_list_header(buf, index, &length)) < 0) - return error_code; - - if (length != 0) { - for(tmp = 0; tmp < length; tmp++) - if ((error_code = oe_ei_decode_wchar(buf, index, &(p[tmp]))) < 0) - return error_code; - - /* Read list tail also */ - if ((error_code = ei_decode_list_header(buf, index, &length)) < 0) - return error_code; - } - - p[tmp] = 0; /* Wide NULL */ - - } else { /* Allocation counting part */ - - if ((error_code = ei_decode_list_header(buf, index, &length)) < 0) - return error_code; - - if (length != 0) { - for(tmp = 0; tmp < length; tmp++) - if ((error_code = oe_ei_decode_wchar(buf, index, 0)) < 0) - return error_code; - - /* Read list tail also */ - if ((error_code = ei_decode_list_header(buf, index, &length)) < 0) - return error_code; - } - } - - break; - - case ERL_STRING_EXT: /* A string */ - - if (p) { /* Decoding part */ - - /* Allocate temporary string */ - tmp_space = (char*) malloc(length*(__OE_WCHARSZ__+1)); - - if ((error_code = ei_decode_string(buf, index, tmp_space)) < 0) - return error_code; - - /* Assign characters to wide characters */ - for(tmp = 0; tmp < length; tmp++) - p[tmp] = tmp_space[tmp]; - - p[tmp] = 0; /* Wide NULL */ - - /* Free temporary string */ - CORBA_free(tmp_space); - - } else { /* Allocation counting part */ - - if ((error_code = ei_decode_string(buf, index, 0)) < 0) - return error_code; - - } - break; - - default: /* Bad header */ - return -1; - } - - return 0; -} - - diff --git a/lib/ic/c_src/oe_ei_encode_atom.c b/lib/ic/c_src/oe_ei_encode_atom.c deleted file mode 100644 index 99a9fe26f0..0000000000 --- a/lib/ic/c_src/oe_ei_encode_atom.c +++ /dev/null @@ -1,56 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - -#include <string.h> - - -#define DIRTY_ATOM_ENC_MAX(LATIN1_CHARS) ((LATIN1_CHARS)*2 + 3) - - -int oe_ei_encode_atom(CORBA_Environment *ev, const char *p) { - int size = ev->_iout; - size_t len = strlen(p); - - if (DIRTY_ATOM_ENC_MAX(len) >= ev->_outbufsz) { - - ei_encode_atom_len(0,&size,p,len); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; - } - } - - return ei_encode_atom_len(ev->_outbuf,&ev->_iout,p,len); -} - diff --git a/lib/ic/c_src/oe_ei_encode_char.c b/lib/ic/c_src/oe_ei_encode_char.c deleted file mode 100644 index 9079cb4ecc..0000000000 --- a/lib/ic/c_src/oe_ei_encode_char.c +++ /dev/null @@ -1,45 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_char(CORBA_Environment *ev, char p) { - int size = ev->_iout + __OE_CHARSZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - return ei_encode_char(ev->_outbuf, &ev->_iout, p); -} - - - diff --git a/lib/ic/c_src/oe_ei_encode_double.c b/lib/ic/c_src/oe_ei_encode_double.c deleted file mode 100644 index 95fed6ff25..0000000000 --- a/lib/ic/c_src/oe_ei_encode_double.c +++ /dev/null @@ -1,44 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_double(CORBA_Environment *ev, double p) { - int size = ev->_iout + __OE_DOUBLESZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - return ei_encode_double(ev->_outbuf, &ev->_iout, p); -} - - diff --git a/lib/ic/c_src/oe_ei_encode_list_header.c b/lib/ic/c_src/oe_ei_encode_list_header.c deleted file mode 100644 index 57a0fc0d0f..0000000000 --- a/lib/ic/c_src/oe_ei_encode_list_header.c +++ /dev/null @@ -1,42 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_list_header(CORBA_Environment *ev, int arity) { - int size = ev->_iout + __OE_LISTHDRSZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - return ei_encode_list_header(ev->_outbuf, &ev->_iout, arity); -} diff --git a/lib/ic/c_src/oe_ei_encode_long.c b/lib/ic/c_src/oe_ei_encode_long.c deleted file mode 100644 index c0d8599b95..0000000000 --- a/lib/ic/c_src/oe_ei_encode_long.c +++ /dev/null @@ -1,45 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_long(CORBA_Environment *ev, long p) { - int size = ev->_iout + __OE_LONGSZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - return ei_encode_long(ev->_outbuf, &ev->_iout, p); -} - - - diff --git a/lib/ic/c_src/oe_ei_encode_longlong.c b/lib/ic/c_src/oe_ei_encode_longlong.c deleted file mode 100644 index ac208f1982..0000000000 --- a/lib/ic/c_src/oe_ei_encode_longlong.c +++ /dev/null @@ -1,45 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_longlong(CORBA_Environment *ev, CORBA_long_long p) { - int size = ev->_iout + __OE_LONGLONGSZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - /* CORBA_long_long = long because of erl_interface limitation */ - return ei_encode_long(ev->_outbuf, &ev->_iout, p); -} - - diff --git a/lib/ic/c_src/oe_ei_encode_pid.c b/lib/ic/c_src/oe_ei_encode_pid.c deleted file mode 100644 index ebd0d0b6ef..0000000000 --- a/lib/ic/c_src/oe_ei_encode_pid.c +++ /dev/null @@ -1,46 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_pid(CORBA_Environment *ev, const erlang_pid *p) { - int size = ev->_iout; - - ei_encode_pid(NULL, &size, p); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; - } - - return ei_encode_pid(ev->_outbuf, &ev->_iout, p); -} diff --git a/lib/ic/c_src/oe_ei_encode_port.c b/lib/ic/c_src/oe_ei_encode_port.c deleted file mode 100644 index a4ecf846b7..0000000000 --- a/lib/ic/c_src/oe_ei_encode_port.c +++ /dev/null @@ -1,47 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_port(CORBA_Environment *ev, const erlang_port *p) { - int size = ev->_iout; - - ei_encode_port(NULL, &size, p); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; - } - - return ei_encode_port(ev->_outbuf, &ev->_iout, p); -} - diff --git a/lib/ic/c_src/oe_ei_encode_ref.c b/lib/ic/c_src/oe_ei_encode_ref.c deleted file mode 100644 index 8dcbc3aeb7..0000000000 --- a/lib/ic/c_src/oe_ei_encode_ref.c +++ /dev/null @@ -1,47 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_ref(CORBA_Environment *ev, const erlang_ref *p) { - int size = ev->_iout; - - ei_encode_ref(NULL, &size, p); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; - } - - return ei_encode_ref(ev->_outbuf, &ev->_iout, p); -} - diff --git a/lib/ic/c_src/oe_ei_encode_string.c b/lib/ic/c_src/oe_ei_encode_string.c deleted file mode 100644 index 8612835e2b..0000000000 --- a/lib/ic/c_src/oe_ei_encode_string.c +++ /dev/null @@ -1,48 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_string(CORBA_Environment *ev, const char *p) { - int size = ev->_iout; - - ei_encode_string(0,&size,p); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; - } - - return ei_encode_string(ev->_outbuf,&ev->_iout,p); -} - - diff --git a/lib/ic/c_src/oe_ei_encode_term.c b/lib/ic/c_src/oe_ei_encode_term.c deleted file mode 100644 index c36edbf493..0000000000 --- a/lib/ic/c_src/oe_ei_encode_term.c +++ /dev/null @@ -1,49 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_term(CORBA_Environment *ev, void *t) { - int size = ev->_iout; - - ei_encode_term(NULL, &size, t); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; - } - - return ei_encode_term(ev->_outbuf, &ev->_iout, t); -} - - - diff --git a/lib/ic/c_src/oe_ei_encode_tuple_header.c b/lib/ic/c_src/oe_ei_encode_tuple_header.c deleted file mode 100644 index 64f8b4b873..0000000000 --- a/lib/ic/c_src/oe_ei_encode_tuple_header.c +++ /dev/null @@ -1,45 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_tuple_header(CORBA_Environment *ev, int arity) { - int size = ev->_iout + __OE_TUPLEHDRSZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - return ei_encode_tuple_header(ev->_outbuf, &ev->_iout, arity); -} - - - diff --git a/lib/ic/c_src/oe_ei_encode_ulong.c b/lib/ic/c_src/oe_ei_encode_ulong.c deleted file mode 100644 index 249235935e..0000000000 --- a/lib/ic/c_src/oe_ei_encode_ulong.c +++ /dev/null @@ -1,44 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_ulong(CORBA_Environment *ev, unsigned long p) { - int size = ev->_iout + __OE_ULONGSZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - return ei_encode_ulong(ev->_outbuf, &ev->_iout, p); -} - - diff --git a/lib/ic/c_src/oe_ei_encode_ulonglong.c b/lib/ic/c_src/oe_ei_encode_ulonglong.c deleted file mode 100644 index 7997f4ea39..0000000000 --- a/lib/ic/c_src/oe_ei_encode_ulonglong.c +++ /dev/null @@ -1,45 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_ulonglong(CORBA_Environment *ev, CORBA_unsigned_long_long p) { - int size = ev->_iout + __OE_ULONGLONGSZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - /* CORBA_long_long = long because of erl_interface limitation */ - return ei_encode_ulong(ev->_outbuf, &ev->_iout, p); -} - - diff --git a/lib/ic/c_src/oe_ei_encode_version.c b/lib/ic/c_src/oe_ei_encode_version.c deleted file mode 100644 index 4bc6256c32..0000000000 --- a/lib/ic/c_src/oe_ei_encode_version.c +++ /dev/null @@ -1,43 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_version(CORBA_Environment *ev) { - int size = ev->_iout + __OE_VSNSZ__; - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - if ((buf = realloc(buf,bufsz)) != NULL) { - ev->_outbuf = buf; - ev->_outbufsz += ev->_memchunk; - } - else { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - } - - return ei_encode_version(ev->_outbuf, &ev->_iout); -} - diff --git a/lib/ic/c_src/oe_ei_encode_wchar.c b/lib/ic/c_src/oe_ei_encode_wchar.c deleted file mode 100644 index 0fd4027886..0000000000 --- a/lib/ic/c_src/oe_ei_encode_wchar.c +++ /dev/null @@ -1,28 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_wchar(CORBA_Environment *ev, CORBA_wchar p) { - return oe_ei_encode_ulong(ev, p); -} - - diff --git a/lib/ic/c_src/oe_ei_encode_wstring.c b/lib/ic/c_src/oe_ei_encode_wstring.c deleted file mode 100644 index a799d475e7..0000000000 --- a/lib/ic/c_src/oe_ei_encode_wstring.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -#include <ic.h> - - -int oe_ei_encode_wstring(CORBA_Environment *ev, CORBA_wchar *p) { - - int len,wchar,size,tmp,error_code; - - len = ic_wstrlen(p); - size = ev->_iout + __OE_LISTHDRSZ__ +(len * __OE_WCHARSZ__); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; - } - - /* Encode the wide string */ - error_code = 0; - - if ((error_code = oe_ei_encode_list_header(ev, len)) < 0) - return error_code; - - for(tmp = 0; tmp < len; tmp++) - if ((error_code = oe_ei_encode_wchar(ev, p[tmp])) < 0) - return error_code; - - if ((error_code = oe_ei_encode_empty_list(ev)) < 0) - return error_code; - - return 0; -} - - diff --git a/lib/ic/doc/html/.gitignore b/lib/ic/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ic/doc/html/.gitignore +++ /dev/null diff --git a/lib/ic/doc/man1/.gitignore b/lib/ic/doc/man1/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ic/doc/man1/.gitignore +++ /dev/null diff --git a/lib/ic/doc/man3/.gitignore b/lib/ic/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ic/doc/man3/.gitignore +++ /dev/null diff --git a/lib/ic/doc/pdf/.gitignore b/lib/ic/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ic/doc/pdf/.gitignore +++ /dev/null diff --git a/lib/ic/doc/src/CORBA_Environment_alloc.xml b/lib/ic/doc/src/CORBA_Environment_alloc.xml deleted file mode 100644 index 357d9c2e8a..0000000000 --- a/lib/ic/doc/src/CORBA_Environment_alloc.xml +++ /dev/null @@ -1,143 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>CORBA_Environment_alloc</title> - <prepared></prepared> - <docno></docno> - <checked></checked> - <date>1998-12-01</date> - <rev>A</rev> - </header> - <lib>CORBA_Environment_alloc</lib> - <libsummary>Allocation function for the CORBA_Environement struct</libsummary> - <description> - <p>The <em>CORBA_Environment_alloc()</em> function is the - function used to allocate and initiate the <em>CORBA_Environment</em> - structure.</p> - </description> - <funcs> - <func> - <name><ret>CORBA_Environment *</ret><nametext>CORBA_Environment_alloc(inbufsz, outbufsz)</nametext></name> - <fsummary>Initialize communication</fsummary> - <type> - <v>int inbufsz;</v> - <v>int outbufsz;</v> - </type> - <desc> - <p>This function is used to create and initiate the <c>CORBA_Environment</c> - structure. In particular, it is used to dynamically allocate a CORBA_Environment - structure and set the default values for the structure's fields. </p> - <p><em>inbufsize</em> is the wished size of input buffer.</p> - <p><em>outbufsize</em> is the wished size of output buffer.</p> - <p><em>CORBA_Environment</em> is the CORBA 2.0 state structure used by the - generated stub.</p> - <p>This function will set all needed default values and allocate buffers equal - to the values passed, but will not allocate space for the _to_pid and _from_pid fields.</p> - <p>To free the space allocated by CORBA_Environment_alloc/2 :</p> - <list type="bulleted"> - <item> - <p>First call CORBA_free for the input and output buffers.</p> - </item> - <item> - <p>After freeing the buffer space, call CORBA_free for the CORBA_Environment space. </p> - </item> - </list> - </desc> - </func> - </funcs> - - <section> - <title>The CORBA_Environment structure</title> - <p>Here is the complete definition of the CORBA_Environment structure, - defined in file <em>ic.h</em> : </p> - <code type="none"> -/* Environment definition */ -typedef struct { - - /*----- CORBA compatibility part ------------------------*/ - /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/ - CORBA_exception_type _major; - - /*----- External Implementation part - initiated by the user ---*/ - /* File descriptor */ - int _fd; - /* Size of input buffer */ - int _inbufsz; - /* Pointer to always dynamically allocated buffer for input */ - char *_inbuf; - /* Size of output buffer */ - int _outbufsz; - /* Pointer to always dynamically allocated buffer for output */ - char *_outbuf; - /* Size of memory chunks in bytes, used for increasing the output - buffer, set to >= 32, should be around >= 1024 for performance - reasons */ - int _memchunk; - /* Pointer for registered name */ - char _regname[256]; - /* Process identity for caller */ - erlang_pid *_to_pid; - /* Process identity for callee */ - erlang_pid *_from_pid; - - /*- Internal Implementation part - used by the server/client ---*/ - /* Index for input buffer */ - int _iin; - /* Index for output buffer */ - int _iout; - /* Pointer for operation name */ - char _operation[256]; - /* Used to count parameters */ - int _received; - /* Used to identify the caller */ - erlang_pid _caller; - /* Used to identify the call */ - erlang_ref _unique; - /* Exception id field */ - CORBA_char *_exc_id; - /* Exception value field */ - void *_exc_value; - - -} CORBA_Environment; - </code> - <note> - <p>Remember to set the field values <em>_fd </em>, <em>_regname </em>, <em>*_to_pid </em> and/or - <em>*_from_pid </em> to the appropriate application values. These are not automatically - set by the stubs.</p> - </note> - <warning> - <p>Never assign static buffers to the buffer pointers, never set the <em>_memchunk</em> field to - a value less than <em>32</em>.</p> - </warning> - </section> - - <section> - <title>SEE ALSO</title> - <p>ic(3)</p> - </section> - -</cref> - - diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile deleted file mode 100644 index 118f42b605..0000000000 --- a/lib/ic/doc/src/Makefile +++ /dev/null @@ -1,227 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-2017. 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% -# -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(IC_VSN) -APPLICATION=ic - -# ---------------------------------------------------- -# Java specific -# ---------------------------------------------------- -JAVADOC=javadoc -JAVA_INCL_ROOT = $(ERL_TOP)/lib/jinterface/priv/ -JAVA_SRC_ROOT = $(ERL_TOP)/lib/ic/java_src/ -JAVA_CLASS_SUBDIR = com/ericsson/otp/ic/ - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = ic.xml \ - ic_clib.xml \ - ic_c_protocol.xml - -XML_PART_FILES = part.xml - -XML_CHAPTER_FILES = \ - ch_introduction.xml \ - ch_basic_idl.xml \ - ch_ic_protocol.xml \ - ch_erl_plain.xml \ - ch_erl_genserv.xml \ - ch_c_mapping.xml \ - ch_c_client.xml \ - ch_c_server.xml \ - ch_c_corba_env.xml \ - ch_java.xml \ - notes.xml - -BOOK_FILES = book.xml - -XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ - $(XML_PART_FILES) $(XML_CHAPTER_FILES) - -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info -EXTRA_FILES = \ - $(DEFAULT_GIF_FILES) \ - $(DEFAULT_HTML_FILES) \ - $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -JAVA_SOURCE_FILES = \ - Holder.java \ - BooleanHolder.java \ - ByteHolder.java \ - CharHolder.java \ - DoubleHolder.java \ - FloatHolder.java \ - IntHolder.java \ - LongHolder.java \ - ShortHolder.java \ - StringHolder.java \ - Environment.java \ - Any.java \ - AnyHelper.java \ - AnyHolder.java \ - TypeCode.java \ - TCKind.java \ - Pid.java \ - PidHolder.java \ - PidHelper.java \ - Ref.java \ - RefHolder.java \ - RefHelper.java \ - Port.java \ - PortHolder.java \ - PortHelper.java \ - Term.java \ - TermHolder.java \ - TermHelper.java - - -JD_INDEX_HTML_FILES = \ - allclasses-frame.html \ - allclasses-noframe.html \ - deprecated-list.html \ - index-all.html \ - overview-tree.html \ - stylesheet.css \ - help-doc.html \ - index.html \ - package-list \ - serialized-form.html \ - constant-values.html - -JD_GIF_FILES = \ - ../html/java/resources/inherit.gif - - -PACK_DIR = com/ericsson/otp/ic -JAVA_SOURCE_DIR = ../../java_src/$(PACK_DIR) -JAVA_OUT_DIR = ../html/java - -JD_PACK_HTML_FILES = \ - package-frame.html \ - package-summary.html \ - package-tree.html - -JAVADOC_PACK_HTML_FILES = \ - $(JAVA_SOURCE_FILES:%.java=$(JAVA_OUT_DIR)/$(PACK_DIR)/%.html) \ - $(JD_PACK_HTML_FILES:%=$(JAVA_OUT_DIR)/$(PACK_DIR)/%) - -JAVADOC_INDEX_HTML_FILES = $(JD_INDEX_HTML_FILES:%=$(JAVA_OUT_DIR)/%) - -JAVADOC_GENERATED_FILES = $(JAVADOC_PACK_HTML_FILES) $(JAVADOC_INDEX_HTML_FILES) - - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -CLASSPATH = $(JAVA_SRC_ROOT):$(JAVA_INCL_ROOT) - -XML_FLAGS += -DVIPS_FLAGS += -JAVADOCFLAGS = \ - -classpath $(CLASSPATH) \ - -d ../doc/html/java \ - -windowtitle "Package com.ericsson.otp.ic version $(IC_VSN)" \ - -public \ - -footer "<CENTER><FONT SIZE=-1>Copyright © 1991-2007 Ericsson AB<BR> </FONT> </CENTER>" - - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -ifneq (,$(JAVA)) -docs: pdf html man $(JAVADOC_GENERATED_FILES) -else -docs: pdf html man -endif - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -$(JAVADOC_GENERATED_FILES): JAVADOC-GENERATED - -JAVADOC-GENERATED: $(JAVA_SOURCE_FILES:%=$(JAVA_SOURCE_DIR)/%) - @(cd ../../java_src; $(JAVADOC) $(JAVADOCFLAGS) com.ericsson.otp.ic) - >JAVADOC-GENERATED - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -$(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -debug opt: - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - ($(CP) -rf $(HTMLDIR) "$(RELSYSDIR)/doc") - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3_FILES) "$(RELEASE_PATH)/man/man3" - -release_spec: diff --git a/lib/ic/doc/src/book.xml b/lib/ic/doc/src/book.xml deleted file mode 100644 index f6ef824f63..0000000000 --- a/lib/ic/doc/src/book.xml +++ /dev/null @@ -1,50 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE book SYSTEM "book.dtd"> - -<book xmlns:xi="http://www.w3.org/2001/XInclude"> - <header titlestyle="normal"> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>ic</title> - <prepared></prepared> - <docno></docno> - <date>1998-09-29</date> - <rev>4.0.4</rev> - <file>book.sgml</file> - </header> - <insidecover> - </insidecover> - <pagetext>ic</pagetext> - <preamble> - <contents level="2"></contents> - </preamble> - <parts lift="no"> - <xi:include href="part.xml"/> - </parts> - <applications> - <xi:include href="ref_man.xml"/> - </applications> - <releasenotes> - <xi:include href="notes.xml"/> - </releasenotes> - <listofterms></listofterms> - <index></index> -</book> - diff --git a/lib/ic/doc/src/c-part.xml b/lib/ic/doc/src/c-part.xml deleted file mode 100644 index 968dd3135f..0000000000 --- a/lib/ic/doc/src/c-part.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2002</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IDL to C language Mapping</title> - <prepared></prepared> - <docno></docno> - <date>2002-06-25</date> - <rev>A</rev> - </header> - <description> - <p>IDL to C</p> - </description> - <include file="ch_c_mapping"></include> - <include file="ch_c_client"></include> - <include file="ch_c_server"></include> - <include file="ch_c_corba_env"></include> -</part> - diff --git a/lib/ic/doc/src/ch_basic_idl.xml b/lib/ic/doc/src/ch_basic_idl.xml deleted file mode 100644 index 485a0c44e5..0000000000 --- a/lib/ic/doc/src/ch_basic_idl.xml +++ /dev/null @@ -1,164 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2002</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>OMG IDL</title> - <prepared></prepared> - <docno></docno> - <date>2002-07-15</date> - <rev></rev> - <file>ch_basic_idl.xml</file> - </header> - - <section> - <title>OMG IDL - Overview</title> - <p>The purpose of OMG IDL, <em>Interface Definition Language</em>, mapping - is to act as translator between platforms and languages. An IDL - specification is supposed to describe data types, object types etc.</p> - <p>Since the <c>C</c> and <c>Java</c> IC backends only supports a subset of the - IDL types supported by the other backends, the mapping is divided into - different parts. For more information about IDL to Erlang mapping, - i.e., <c>CORBA</c>, plain Erlang and generic Erlang Server, see the Orber - User's Guide. How to use the plain Erlang and generic Erlang Server is - found in this User's Guide.</p> - - <section> - <title>Reserved Compiler Names and Keywords</title> - <p>The use of some names is strongly discouraged due to - ambiguities. However, the use of some names is prohibited - when using the Erlang mapping , as they are strictly reserved for IC.</p> - <p>IC reserves all identifiers starting with <c>OE_</c> and <c>oe_</c> - for internal use.</p> - <p>Note also, that an identifier in IDL can contain alphabetic, - digits and underscore characters, but the first character - <em>must</em> be alphabetic. - </p> - <p>Using underscores in IDL names can lead to ambiguities - due to the name mapping described above. It is advisable to - avoid the use of underscores in identifiers.</p> - <p>The OMG defines a set of reserved words, shown below, for use as keywords. - These may <em>not</em> be used as, for example, identifiers.</p> - <table> - <row> - <cell align="left" valign="middle">abstract</cell> - <cell align="left" valign="middle">double</cell> - <cell align="left" valign="middle">local</cell> - <cell align="left" valign="middle">raises</cell> - <cell align="left" valign="middle">typedef</cell> - </row> - <row> - <cell align="left" valign="middle">any</cell> - <cell align="left" valign="middle">exception</cell> - <cell align="left" valign="middle">long</cell> - <cell align="left" valign="middle">readonly</cell> - <cell align="left" valign="middle">unsigned</cell> - </row> - <row> - <cell align="left" valign="middle">attribute</cell> - <cell align="left" valign="middle">enum</cell> - <cell align="left" valign="middle">module</cell> - <cell align="left" valign="middle">sequence</cell> - <cell align="left" valign="middle">union</cell> - </row> - <row> - <cell align="left" valign="middle">boolean</cell> - <cell align="left" valign="middle">factory</cell> - <cell align="left" valign="middle">native</cell> - <cell align="left" valign="middle">short</cell> - <cell align="left" valign="middle">ValueBase</cell> - </row> - <row> - <cell align="left" valign="middle">case</cell> - <cell align="left" valign="middle">FALSE</cell> - <cell align="left" valign="middle">Object</cell> - <cell align="left" valign="middle">string</cell> - <cell align="left" valign="middle">valuetype</cell> - </row> - <row> - <cell align="left" valign="middle">char</cell> - <cell align="left" valign="middle">fixed</cell> - <cell align="left" valign="middle">octet</cell> - <cell align="left" valign="middle">struct</cell> - <cell align="left" valign="middle">void</cell> - </row> - <row> - <cell align="left" valign="middle">const</cell> - <cell align="left" valign="middle">float</cell> - <cell align="left" valign="middle">oneway</cell> - <cell align="left" valign="middle">supports</cell> - <cell align="left" valign="middle">wchar</cell> - </row> - <row> - <cell align="left" valign="middle">context</cell> - <cell align="left" valign="middle">in</cell> - <cell align="left" valign="middle">out</cell> - <cell align="left" valign="middle">switch</cell> - <cell align="left" valign="middle">wstring</cell> - </row> - <row> - <cell align="left" valign="middle">custom</cell> - <cell align="left" valign="middle">inout</cell> - <cell align="left" valign="middle">private</cell> - <cell align="left" valign="middle">TRUE</cell> - <cell align="left" valign="middle"></cell> - </row> - <row> - <cell align="left" valign="middle">default</cell> - <cell align="left" valign="middle">interface</cell> - <cell align="left" valign="middle">public</cell> - <cell align="left" valign="middle">truncatable</cell> - <cell align="left" valign="middle"></cell> - </row> - <tcaption>OMG IDL keywords</tcaption> - </table> - <p>The keywords listed above must be written exactly as shown. Any usage - of identifiers that collide with a keyword is illegal. For example, - <em>long</em> is a valid keyword; <em>Long</em> and <em>LONG</em> are - illegal as keywords and identifiers. But, since the OMG must be able - to expand the IDL grammar, it is possible to use <em>Escaped Identifiers</em>. For example, it is not unlikely that <c>native</c> - have been used in IDL-specifications as identifiers. One option is to - change all occurrences to <c>myNative</c>. Usually, it is necessary - to change programming language code that depends upon that IDL as well. - Since Escaped Identifiers just disable type checking (i.e. if it is a reserved - word or not) and leaves everything else unchanged, it is only necessary to - update the IDL-specification. To escape an identifier, simply prefix it - with <c>_</c>. The following IDL-code is illegal:</p> - <code type="none"> -typedef string native; -interface i { - void foo(in native Arg); - }; -}; - </code> - <p>With Escaped Identifiers the code will look like:</p> - <code type="none"> -typedef string _native; -interface i { - void foo(in _native Arg); - }; -}; - </code> - </section> - </section> -</chapter> - diff --git a/lib/ic/doc/src/ch_c_client.xml b/lib/ic/doc/src/ch_c_client.xml deleted file mode 100644 index e304c8acf4..0000000000 --- a/lib/ic/doc/src/ch_c_client.xml +++ /dev/null @@ -1,150 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>The C Client Back-end</title> - <prepared></prepared> - <docno></docno> - <date>2004-01-14</date> - <rev>C</rev> - <file>ch_c_client.xml</file> - </header> - - <section> - <title>Introduction</title> - <p>With the option <c>{be, c_client}</c> the IDL Compiler generates - C client stubs according to the IDL to C mapping, on top of the - Erlang distribution and gen_server protocols.</p> - <p>The developer has to write additional code, that together with - the generated C client stubs, form a hidden Erlang node. That - additional code uses <c>erl_interface</c> functions for defining - the hidden node, and for establishing connections to other - Erlang nodes.</p> - </section> - - <section> - <title>Generated Stub Files</title> - <p>The generated stub files are:</p> - <list type="bulleted"> - <item> - <p>For each IDL interface, a C source file, the name of which - is <c><![CDATA[<Scoped Interface Name>.c]]></c>. Each operation of the - IDL interface is mapped to a C function (with scoped name) - in that file;</p> - </item> - <item> - <p>C source files that contain functions for type conversion, - memory allocation, and data encoding/decoding;</p> - </item> - <item> - <p>C header files that contain function prototypes and type - definitions.</p> - </item> - </list> - <p>All C functions are exported (i.e. not declared static).</p> - </section> - - <section> - <title>C Interface Functions</title> - <p>For each IDL operation a C interface function is - generated, the prototype of which is:</p> - <p><c><![CDATA[<Return Value> <Scoped Function Name>(<Interface Object> oe_obj, <Parameters>, CORBA_Environment *oe_env);]]></c></p> - <p>where</p> - <list type="bulleted"> - <item> - <p><c><![CDATA[<Return Value>]]></c> is the value to be returned as defined - by the IDL specification;</p> - </item> - <item> - <p><c><![CDATA[<Interface Object> oe_obj]]></c> is the client interface - object;</p> - </item> - <item> - <p><c><![CDATA[<Parameters>]]></c> is a list of parameters of the - operation, defined in the same order as defined by the IDL - specification;</p> - </item> - <item> - <p><c>CORBA_Environment *oe_env</c> is a pointer to the current - client environment. It contains the current file descriptor, - the current input and output buffers, etc. For details see - <seealso marker="ch_c_corba_env#corbaenv">CORBA_Environment C Structure</seealso>.</p> - </item> - </list> - </section> - - <section> - <title>Generating, Compiling and Linking</title> - <p>To generate the C client stubs type the following in an - appropriate shell:</p> - <p><c><![CDATA[erlc -I ICROOT/include "+{be, c_client}" File.idl]]></c>,</p> - <p>where <c>ICROOT</c> is the root of the IC application. The - <c>-I ICROOT/include</c> is only needed if <c>File.idl</c> - refers to <c>erlang.idl</c>.</p> - <p>When compiling a generated C stub file, the directories - <c>ICROOT/include</c> and <c>EICROOT/include</c>, have to be - specified as include directories, where <c>EIROOT</c> is the - root directory of the Erl_interface application.</p> - <p>When linking object files the <c>EIROOT/lib</c> and - <c>ICROOT/priv/lib</c> directories have to be specified. </p> - </section> - - <section> - <title>An Example</title> - <p>In this example the IDL specification file "random.idl" is used - for generating C client stubs (the file is contained in the IC - <c>/examples/c-client</c> directory):</p> - <code type="none"><![CDATA[ -module rmod { - - interface random { - - double produce(); - - oneway void init(in long seed1, in long seed2, in long seed3); - - }; - -}; ]]></code> - <p>Generate the C client stubs:</p> - - <code type="none"><![CDATA[ -erlc '+{be, c_client}' random.idl -Erlang IDL compiler version X.Y.Z ]]></code> - - <p>Six files are generated. </p> - <p>Compile the C client stubs:</p> - <p>Please read the <c>ReadMe</c> file att the - <c>examples/c-client</c> directory</p> - <p>In the same - directory you can find all the code for this example.</p> - <p>In particular you will find the <c>client.c</c> file that contains - all the additional code that must be written to obtain a complete - client. </p> - <p>In the <c>examples/c-client</c> directory you will also find - source code for an Erlang server, which can be used for testing - the C client.</p> - </section> -</chapter> - - diff --git a/lib/ic/doc/src/ch_c_corba_env.xml b/lib/ic/doc/src/ch_c_corba_env.xml deleted file mode 100644 index 1bd829307e..0000000000 --- a/lib/ic/doc/src/ch_c_corba_env.xml +++ /dev/null @@ -1,386 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>CORBA_Environment C Structure</title> - <prepared></prepared> - <docno></docno> - <date>2003-12-15</date> - <rev>PC1</rev> - <file>ch_c_corba_env.xml</file> - </header> - <marker id="corbaenv"></marker> - <p>This chapter describes the CORBA_Environment C structure.</p> - - <section> - <title>C Structure</title> - <p>Here is the complete definition of the CORBA_Environment - C structure, defined in file "ic.h" : </p> - <code type="none"> -/* Environment definition */ -typedef struct { - - /*----- CORBA compatibility part ------------------------*/ - /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/ - CORBA_exception_type _major; - - /*----- External Implementation part - initiated by the user ---*/ - /* File descriptor */ - int _fd; - /* Size of input buffer */ - int _inbufsz; - /* Pointer to always dynamically allocated buffer for input */ - char *_inbuf; - /* Size of output buffer */ - int _outbufsz; - /* Pointer to always dynamically allocated buffer for output */ - char *_outbuf; - /* Size of memory chunks in bytes, used for increasing the output - buffer, set to >= 32, should be around >= 1024 for performance - reasons */ - int _memchunk; - /* Pointer for registered name */ - char _regname[256]; - /* Process identity for caller */ - erlang_pid *_to_pid; - /* Process identity for callee */ - erlang_pid *_from_pid; - - /*- Internal Implementation part - used by the server/client ---*/ - /* Index for input buffer */ - int _iin; - /* Index for output buffer */ - int _iout; - /* Pointer for operation name */ - char _operation[256]; - /* Used to count parameters */ - int _received; - /* Used to identify the caller */ - erlang_pid _caller; - /* Used to identify the call */ - erlang_ref _unique; - /* Exception id field */ - CORBA_char *_exc_id; - /* Exception value field */ - void *_exc_value; - - -} CORBA_Environment; - </code> - <p>The structure is divided into three parts:</p> - <list type="bulleted"> - <item> - <p>The CORBA Compatibility part, demanded by the standard OMG - IDL mapping v2.0.</p> - </item> - <item> - <p>The external implementation part used for generated - client/server code.</p> - </item> - <item> - <p>The internal part useful for those who wish to define their - own functions.</p> - </item> - </list> - </section> - - <section> - <title>The CORBA Compatibility Part</title> - <p>Contains only one field <c>_major</c> defined as a - CORBA_Exception_type. The CORBA_Exception type is an integer - which can be one of:</p> - <list type="bulleted"> - <item> - <p><em>CORBA_NO_EXCEPTION</em>, by default equal to 0, can be - set by the application programmer to another value.</p> - </item> - <item> - <p><em>CORBA_SYSTEM_EXCEPTION</em>, by default equal to -1, can - be set by the application programmer to another value.</p> - </item> - </list> - <p>The current definition of these values are:</p> - <code type="none"> - #define CORBA_NO_EXCEPTION 0 - #define CORBA_SYSTEM_EXCEPTION -1 - </code> - </section> - - <section> - <title>The External Part</title> - <p>This part contains the following fields:</p> - <list type="bulleted"> - <item> - <p>int <em>_fd</em> - a file descriptor returned from - erl_connect. Used for connection setting.</p> - </item> - <item> - <p>char* <em>_inbuf</em> - pointer to a buffer used for - input. Buffer size checks are done under runtime that - prevent buffer overflows. This is done by expanding the - buffer to fit the input message. In order to allow buffer - reallocation, the output buffer must always be dynamically - allocated. The pointer value can change under runtime in - case of buffer reallocation.</p> - </item> - <item> - <p>int <em>_inbufsz</em> - start size of input buffer. Used - for setting the input buffer size under initialization of - the Erl_Interface function ei_receive_encoded/5. The value - of this field can change under runtime in case of input - buffer expansion to fit larger messages</p> - </item> - <item> - <p>int <em>_outbufsz</em> - start size of output buffer. The - value of this field can change under runtime in case of - input buffer expansion to fit larger messages</p> - </item> - <item> - <p>char* <em>_outbuf</em> - pointer to a buffer used for - output. Buffer size checks prevent buffer overflows under - runtime, by expanding the buffer to fit the output message - in cases of lack of space in buffer. In order to allow - buffer reallocation, the output buffer must always be - dynamically allocated. The pointer value can change under - runtime in case of buffer reallocation.</p> - </item> - <item> - <p>int <em>_memchunk</em> - expansion unit size for the output - buffer. This is the size of memory chunks in bytes used for - increasing the output in case of buffer expansion. The value - of this field must be always set to >= 32, should be at - least 1024 for performance reasons.</p> - </item> - <item> - <p>char <em>regname[256]</em> - a registered name for a process. </p> - </item> - <item> - <p>erlang_pid* <em>_to_pid</em> - an Erlang process identifier, - is only used if the registered_name parameter is the empty - string.</p> - </item> - <item> - <p>erlang_pid* <em>_from_pid</em> - your own process id so the - answer can be returned.</p> - </item> - </list> - </section> - - <section> - <title>The Internal Part</title> - <p>This part contains the following fields:</p> - <list type="bulleted"> - <item> - <p>int <em>_iin</em> - Index for input buffer. Initially set - to zero. Updated to agree with the length of the received - encoded message.</p> - </item> - <item> - <p>int <em>_iout</em> - Index for output buffer Initially set - to zero. Updated to agree with the length of the message - encoded to the communication counterpart.</p> - </item> - <item> - <p>char <em>_operation[256]</em> - Pointer for operation name. - Set to the operation to be called.</p> - </item> - <item> - <p>int <em>_received</em> - Used to count parameters. - Initially set to zero.</p> - </item> - <item> - <p>erlang_pid <em>_caller</em> - Used to identify the caller. - Initiated to a value that identifies the caller.</p> - </item> - <item> - <p>erlang_ref <em>_unique</em> - Used to identify the call. - Set to a default value in the case of generated functions.</p> - </item> - <item> - <p>CORBA_char* <em>_exc_id</em> - Exception id field. - Initially set to NULL to agree with the initial value of - _major (CORBA_NO_EXCEPTION).</p> - </item> - <item> - <p>void* <em>_exc_value</em> - Exception value field Initially - set to <em>NULL</em> to agree with the initial value of - _major (CORBA_NO_EXCEPTION).</p> - </item> - </list> - <p>The advanced user who defines his own functions has to - update/support these values in a way similar to how they are - updated in the generated code.</p> - </section> - - <section> - <title>Creating and Initiating the CORBA_Environment Structure</title> - <p>There are two ways to set the CORBA_Environment structure:</p> - <list type="bulleted"> - <item> - <p>Manually</p> - <p>The following default values must be set to the - CORBA_Environment *<em>ev</em> fields, when buffers for - input/output should have the size <em>inbufsz</em>/ - <em>outbufsz</em>:</p> - <list type="bulleted"> - <item> - <p><em>ev->_inbufsz</em> = <em>inbufsz</em>;</p> - <p>The value for this field can be between 0 and maximum - size of a signed integer.</p> - </item> - <item> - <p><em>ev->_inbuf</em> = malloc(<em>inbufsz</em>);</p> - <p>The size of the allocated buffer must be equal to the - value of its corresponding index, _inbufsz.</p> - </item> - <item> - <p><em>ev->_outbufsz</em> = <em>outbufsz</em>;</p> - <p>The value for this field can be between 0 and maximum - size of a signed integer.</p> - </item> - <item> - <p><em>ev->_outbuf</em> = malloc(<em>outbufsz</em>);</p> - <p>The size of the allocated buffer must be equal to the - value of its corresponding index, _outbufsz.</p> - </item> - <item> - <p><em>ev->_memchunk</em> = <em>__OE_MEMCHUNK__</em>;</p> - <p>Please note that __OE_MEMCHUNK__ is equal to - <em>1024</em>, you can set this value to a value bigger - than 32 yourself.</p> - </item> - <item> - <p><em>ev->_to_pid</em> = <em>NULL</em>;</p> - </item> - <item> - <p><em>ev->_from_pid</em> = <em>NULL</em>;</p> - </item> - </list> - <p></p> - </item> - <item> - <p>By using the <em>CORBA_Environment_alloc</em>/2 function. </p> - <p>The CORBA_Environment_alloc function is defined as:</p> - <code type="none"> - CORBA_Environment *CORBA_Environment_alloc(int inbufsz, - int outbufsz); - </code> - <p>where:</p> - <list type="bulleted"> - <item> - <p><em>inbufsz</em> is the desired size of input buffer</p> - </item> - <item> - <p><em>outbufsz</em> is the desired size of output - buffer</p> - </item> - <item> - <p>return value is a <em>pointer</em> to an allocated and - initialized <em>CORBA_Environment</em> structure.</p> - <p></p> - </item> - </list> - <p>This function will set all needed default values and - allocate buffers equal to the values passed, but will not - allocate space for the _to_pid and _from_pid fields.</p> - <p>To free the space allocated by CORBA_Environment_alloc/2:</p> - <list type="bulleted"> - <item> - <p>First call CORBA_free for the input and output buffers.</p> - </item> - <item> - <p>After freeing the buffer space, call CORBA_free for - the CORBA_Environment space.</p> - </item> - </list> - </item> - </list> - <note> - <p>Remember to set the fields <em>_fd</em>, <em>_regname</em>, - <em>*_to_pid</em> and/or <em>*_from_pid</em> to the - appropriate application values. These are not automatically - set by the stubs.</p> - </note> - <warning> - <p>Never assign static buffers to the buffer pointers. Never set - the <em>_memchunk</em> field to a value less than - <em>32</em>.</p> - </warning> - </section> - - <section> - <title>Setting System Exceptions</title> - <p>If the user wishes to set own system exceptions at critical - positions on the code, it is strongly recommended to use one of - the current values:</p> - <list type="bulleted"> - <item> - <p>CORBA_NO_EXCEPTION upon success. The value of the _exc_id - field should be then set to NULL. The value of the - _exc_value field should be then set to NULL.</p> - </item> - <item> - <p>CORBA_SYSTEM_EXCEPTION upon system failure. The value of - the _exc_id field should be then set to one of the values - defined in "ic.h" :</p> - <code type="none"> - #define UNKNOWN "UNKNOWN" - #define BAD_PARAM "BAD_PARAM" - #define NO_MEMORY "NO_MEMORY" - #define IMPL_LIMIT "IMP_LIMIT" - #define COMM_FAILURE "COMM_FAILURE" - #define INV_OBJREF "INV_OBJREF" - #define NO_PERMISSION "NO_PERMISSION" - #define INTERNAL "INTERNAL" - #define MARSHAL "MARSHAL" - #define INITIALIZE "INITIALIZE" - #define NO_IMPLEMENT "NO_IMPLEMENT" - #define BAD_TYPECODE "BAD_TYPECODE" - #define BAD_OPERATION "BAD_OPERATION" - #define NO_RESOURCES "NO_RESOURCES" - #define NO_RESPONSE "NO_RESPONSE" - #define PERSIST_STORE "PERSIST_STORE" - #define BAD_INV_ORDER "BAD_INV_ORDER" - #define TRANSIENT "TRANSIENT" - #define FREE_MEM "FREE_MEM" - #define INV_IDENT "INV_IDENT" - #define INV_FLAG "INV_FLAG" - #define INTF_REPOS "INTF_REPOS" - #define BAD_CONTEXT "BAD_CONTEXT" - #define OBJ_ADAPTER "OBJ_ADAPTER" - #define DATA_CONVERSION "DATA_CONVERSION" - #define OBJ_NOT_EXIST "OBJECT_NOT_EXIST" - </code> - </item> - </list> - <p>The value of the _exc_value field should be then set to a string - that explains the problem in an informative way. The user - should use the functions CORBA_exc_set/4 and - CORBA_exception_free/1 to free the exception. - The user has to use CORBA_exception_id/1 and - CORBA_exception_value/1 to access exception information. - Prototypes for these functions are declared in "ic.h"</p> - </section> -</chapter> - - diff --git a/lib/ic/doc/src/ch_c_mapping.xml b/lib/ic/doc/src/ch_c_mapping.xml deleted file mode 100644 index 1ea0ace91f..0000000000 --- a/lib/ic/doc/src/ch_c_mapping.xml +++ /dev/null @@ -1,893 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IDL to C mapping</title> - <prepared></prepared> - <docno></docno> - <date>2002-08-06</date> - <rev>PB1</rev> - <file>ch_c_mapping.xml</file> - </header> - - <section> - <title>Introduction</title> - <p>The IC C mapping (used by the C client and C server back-ends) follows - the <em>OMG C Language Mapping Specification</em>. </p> - <p>The C mapping supports the following:</p> - <list type="bulleted"> - <item> - <p>All OMG IDL basic types except <c>long double</c> and <c>any</c>.</p> - </item> - <item> - <p>All OMG IDL constructed types.</p> - </item> - <item> - <p>OMG IDL constants.</p> - </item> - <item> - <p>Operations with passing of parameters and receiving of - results. <c>inout</c> parameters are not supported.</p> - </item> - </list> - <p>The following is not supported: - </p> - <list type="bulleted"> - <item> - <p>Access to attributes.</p> - </item> - <item> - <p>User defined exceptions.</p> - <p></p> - </item> - <item> - <p>User defined objects.</p> - <p></p> - </item> - </list> - </section> - - <section> - <title>C Mapping Characteristics</title> - - <section> - <title>Reserved Names</title> - <p>The IDL compiler reserves all identifiers starting with - <c>OE_</c> and <c>oe_</c> for internal use.</p> - </section> - - <section> - <title>Scoped Names</title> - <p>The C programmer must always use the global name for a type, - constant or operation. The C global name corresponding to an - OMG IDL global name is derived by converting occurrences of - "::" to underscore, and eliminating the leading "::". So, for - example, an operation <c>op1</c> defined in interface - <c>I1</c> which is defined in module <c>M1</c> would be - written as <c>M1::I1::op1</c> in IDL and as <c>M1_I1_op1</c> - in C.</p> - <warning> - <p>If underscores are used in IDL names it can lead to - ambiguities due to the name mapping described above, - therefore it is advisable to avoid underscores in - identifiers.</p> - </warning> - </section> - - <section> - <title>Generated Files</title> - <p>Two files will be generated for each scope. One set of files - will be generated for each module and each interface scope. - An extra set is generated for those definitions at top - level scope. One of the files is a header file(<c>.h</c>), and the - other file is a C source code file (<c>.c</c>). In addition to these - files a number of C source files will be generated for type encodings, - they are named according to the following template: - <c><![CDATA[oe_code_<type>.c]]></c>.</p> - <p>For example:</p> - <code type="none"><![CDATA[ -// IDL, in the file "spec.idl" -module m1 { - - typedef sequence<long> lseq; - - interface i1 { - ... - }; - ... -}; - ]]></code> - <p>XXX This is C client specific. - Will produce the files <c>oe_spec.h</c> and - <c>oe_spec.c</c> for the top scope level. Then the files - <c>m1.h</c> and <c>m1.c</c> for the module <c>m1</c> and - files <c>m1_i1.h</c> and <c>m1_i1.c</c> for the interface - <c>i1</c>. The typedef will produce <c>oe_code_m1_lseq.c</c>.</p> - <p>The header file contains type definitions for all - <c>struct</c> types and sequences and constants in the IDL file. The - c file contains all operation stubs if the the scope is an interface.</p> - <p>In addition to the scope-related files a C source file will - be generated for encoding operations of all <c>struct</c> and - sequence types.</p> - </section> - </section> - - <section> - <title>Basic OMG IDL Types</title> - <p>The mapping of basic types is as follows.</p> - <table> - <row> - <cell align="left" valign="middle"><em>OMG IDL type</em></cell> - <cell align="left" valign="middle"><em>C type</em></cell> - <cell align="left" valign="middle"><em>Mapped to C type</em></cell> - </row> - <row> - <cell align="left" valign="middle">float</cell> - <cell align="left" valign="middle">CORBA_float</cell> - <cell align="left" valign="middle">float</cell> - </row> - <row> - <cell align="left" valign="middle">double</cell> - <cell align="left" valign="middle">CORBA_double</cell> - <cell align="left" valign="middle">double</cell> - </row> - <row> - <cell align="left" valign="middle">short</cell> - <cell align="left" valign="middle">CORBA_short</cell> - <cell align="left" valign="middle">short</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned short</cell> - <cell align="left" valign="middle">CORBA_unsigned_short</cell> - <cell align="left" valign="middle">unsigned short</cell> - </row> - <row> - <cell align="left" valign="middle">long</cell> - <cell align="left" valign="middle">CORBA_long</cell> - <cell align="left" valign="middle">long</cell> - </row> - <row> - <cell align="left" valign="middle">long long</cell> - <cell align="left" valign="middle">CORBA_long_long</cell> - <cell align="left" valign="middle">long</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned long</cell> - <cell align="left" valign="middle">CORBA_unsigned_long</cell> - <cell align="left" valign="middle">unsigned long</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned long long</cell> - <cell align="left" valign="middle">CORBA_unsigned_long_long</cell> - <cell align="left" valign="middle">unsigned long</cell> - </row> - <row> - <cell align="left" valign="middle">char</cell> - <cell align="left" valign="middle">CORBA_char</cell> - <cell align="left" valign="middle">char</cell> - </row> - <row> - <cell align="left" valign="middle">wchar</cell> - <cell align="left" valign="middle">CORBA_wchar</cell> - <cell align="left" valign="middle">unsigned long</cell> - </row> - <row> - <cell align="left" valign="middle">boolean</cell> - <cell align="left" valign="middle">CORBA_boolean</cell> - <cell align="left" valign="middle">unsigned char</cell> - </row> - <row> - <cell align="left" valign="middle">octet</cell> - <cell align="left" valign="middle">CORBA_octet</cell> - <cell align="left" valign="middle">char</cell> - </row> - <row> - <cell align="left" valign="middle">any</cell> - <cell align="left" valign="middle">Not supported</cell> - <cell align="left" valign="middle"></cell> - </row> - <row> - <cell align="left" valign="middle">long double</cell> - <cell align="left" valign="middle">Not supported</cell> - <cell align="left" valign="middle"></cell> - </row> - <row> - <cell align="left" valign="middle">Object</cell> - <cell align="left" valign="middle">Not supported</cell> - <cell align="left" valign="middle"></cell> - </row> - <row> - <cell align="left" valign="middle">void</cell> - <cell align="left" valign="middle">void</cell> - <cell align="left" valign="middle">void</cell> - </row> - <tcaption>OMG IDL Basic Types</tcaption> - </table> - <p>XXX Note that several mappings are not according to OMG C Language - mapping.</p> - </section> - - <section> - <title>Constructed OMG IDL Types</title> - <p>Constructed types have mappings as shown in the following table.</p> - <table> - <row> - <cell align="left" valign="middle">OMG IDL type</cell> - <cell align="left" valign="middle">Mapped to C type</cell> - </row> - <row> - <cell align="left" valign="middle">string</cell> - <cell align="left" valign="middle">CORBA_char*</cell> - </row> - <row> - <cell align="left" valign="middle">wstring</cell> - <cell align="left" valign="middle">CORBA_wchar*</cell> - </row> - <row> - <cell align="left" valign="middle">struct</cell> - <cell align="left" valign="middle">struct</cell> - </row> - <row> - <cell align="left" valign="middle">union</cell> - <cell align="left" valign="middle">union</cell> - </row> - <row> - <cell align="left" valign="middle">enum</cell> - <cell align="left" valign="middle">enum</cell> - </row> - <row> - <cell align="left" valign="middle">sequence</cell> - <cell align="left" valign="middle">struct (see below)</cell> - </row> - <row> - <cell align="left" valign="middle">array</cell> - <cell align="left" valign="middle">array</cell> - </row> - <tcaption>OMG IDL Constructed Types</tcaption> - </table> - <p>An OMG IDL sequence (an array of variable length), </p> - <code type="none"><![CDATA[ -// IDL -typedef sequence <IDL_TYPE> NAME; - ]]></code> - <p>is mapped to a C struct as follows:</p> - <code type="none"> -/* C */ -typedef struct { - CORBA_unsigned_long _maximum; - CORBA_unsigned_long _length; - C_TYPE* _buffer; -} C_NAME; - </code> - <p>where <c>C_TYPE</c> is the mapping of <c>IDL_TYPE</c>, and where - <c>C_NAME</c> is the scoped name of <c>NAME</c>.</p> - </section> - - <section> - <title>OMG IDL Constants</title> - <p>An IDL constant is mapped to a C constant through a C - <c>#define</c> macro, where the name of the macro is scoped. - Example:</p> - <code type="none"> -// IDL -module M1 { - const long c1 = 99; -}; - </code> - <p>results in the following:</p> - <code type="none"> -/* C */ -#define M1_c1 99 - </code> - </section> - - <section> - <title>OMG IDL Operations</title> - <p>An OMG IDL operation is mapped to C function. Each C operation - function has two mandatory parameters: a first parameter of - <em>interface object</em> type, and a last parameter of - <em>environment</em> type.</p> - <p></p> - <p>In a C operation function the the <c>in</c> and <c>out</c> - parameters are located between the first and last parameters - described above, and they appear in the same order as in the IDL - operation declaration.</p> - <p>Notice that <c>inout</c> parameters are not supported. </p> - <p></p> - <p>The return value of an OMG IDL operation is mapped to a - corresponding return value of the C operation function.</p> - <p>Mandatory C operation function parameters:</p> - <list type="bulleted"> - <item><c>CORBA_Object oe_obj</c> - the first parameter of a C - operation function. This parameter is required by the <em>OMG C Language Mapping Specification</em>, but in the current - implementation there is no particular use for it.</item> - <item> - <p><c>CORBA_Environment* oe_env</c> - the last parameter of a C - operation function. The parameter is defined in the C header - file <c>ic.h</c> and has the following public fields:</p> - <list type="bulleted"> - <item> - <p><c>CORBA_Exception_type _major</c> - indicates if an - operation invocation was successful which will be one of - the following:</p> - <list type="bulleted"> - <item>CORBA_NO_EXCEPTION</item> - <item>CORBA_SYSTEM_EXCEPTION</item> - </list> - </item> - <item>int <em>_fd</em> - a file descriptor returned from - <em>erl_connect</em> function.</item> - <item>int <em>_inbufsz</em> - size of input buffer.</item> - <item>char* <em>_inbuf</em> - pointer to a buffer used for - input.</item> - <item>int <em>_outbufsz</em> - size of output buffer.</item> - <item>char* <em>_outbuf</em> - pointer to a buffer used for - output.</item> - <item> - <p>int <em>_memchunk</em> - expansion unit size for the - output buffer. This is the size of memory chunks in - bytes used for increasing the output in case of buffer - expansion. The value of this field must be always set - to >= 32, should be at least 1024 for performance - reasons.</p> - </item> - <item>char <em>regname[256]</em> - a registered name for a - process.</item> - <item>erlang_pid* <em>_to_pid</em> - an Erlang process - identifier, is only used if the registered_name parameter - is the empty string.</item> - <item>erlang_pid* <em>_from_pid</em> - your own process id so - the answer can be returned</item> - </list> - <p>Beside the public fields, other private fields - are internally used but are not mentioned here. </p> - </item> - </list> - <p>Example:</p> - <code type="none"> -// IDL -interface i1 { - long op1(in long a); - long op2(in string s, out long count); -}; - </code> - <p>Is mapped to the following C functions</p> - <code type="none"> -/* C */ -CORBA_long i1_op1(i1 oe_obj, CORBA_long a, CORBA_Environment* oe_env) -{ - ... -} -CORBA_long i1_op2(i1 oe_obj, CORBA_char* s, CORBA_long *count, -CORBA_Environment* oe_env) -{ - ... -} - </code> - <marker id="op_impl"></marker> - - <section> - <title>Operation Implementation</title> - <p>There is no standard CORBA mapping for the C-server side, - as it is implementation-dependent but built in a similar way. - The current server side mapping is different from the client - side mapping in several ways:</p> - <list type="bulleted"> - <item>Argument mappings</item> - <item>Result values</item> - <item>Structure</item> - <item>Usage</item> - <item>Exception handling</item> - </list> - </section> - </section> - - <section> - <title>Exceptions</title> - <p>Although exception mapping is not implemented, the stubs will - generate CORBA system exceptions in case of operation failure. - Thus, the only exceptions propagated by the system are built in - system exceptions.</p> - </section> - - <section> - <title>Access to Attributes</title> - <p>Not Supported</p> - </section> - - <section> - <title>Summary of Argument/Result Passing for the C-client</title> - <p>The user-defined parameters can only be <c>in</c> or <c>out</c> - parameters, as - <c>inout</c> parameters are not supported.</p> - <p>This table summarize the types a client passes as arguments to - a stub, and receives as a result.</p> - <table> - <row> - <cell align="left" valign="middle">OMG IDL type</cell> - <cell align="left" valign="middle">In</cell> - <cell align="left" valign="middle">Out</cell> - <cell align="left" valign="middle">Return</cell> - </row> - <row> - <cell align="left" valign="middle">short</cell> - <cell align="left" valign="middle">CORBA_short</cell> - <cell align="left" valign="middle">CORBA_short*</cell> - <cell align="left" valign="middle">CORBA_short</cell> - </row> - <row> - <cell align="left" valign="middle">long</cell> - <cell align="left" valign="middle">CORBA_long</cell> - <cell align="left" valign="middle">CORBA_long*</cell> - <cell align="left" valign="middle">CORBA_long</cell> - </row> - <row> - <cell align="left" valign="middle">long long</cell> - <cell align="left" valign="middle">CORBA_long_long</cell> - <cell align="left" valign="middle">CORBA_long_long*</cell> - <cell align="left" valign="middle">CORBA_long_long</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned short</cell> - <cell align="left" valign="middle">CORBA_unsigned_short</cell> - <cell align="left" valign="middle">CORBA_unsigned_short*</cell> - <cell align="left" valign="middle">CORBA_unsigned_short</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned long</cell> - <cell align="left" valign="middle">CORBA_unsigned_long</cell> - <cell align="left" valign="middle">CORBA_unsigned_long*</cell> - <cell align="left" valign="middle">CORBA_unsigned_long</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned long long</cell> - <cell align="left" valign="middle">CORBA_unsigned_long_long</cell> - <cell align="left" valign="middle">CORBA_unsigned_long_long*</cell> - <cell align="left" valign="middle">CORBA_unsigned_long_long</cell> - </row> - <row> - <cell align="left" valign="middle">float</cell> - <cell align="left" valign="middle">CORBA_float</cell> - <cell align="left" valign="middle">CORBA_float*</cell> - <cell align="left" valign="middle">CORBA_float</cell> - </row> - <row> - <cell align="left" valign="middle">double</cell> - <cell align="left" valign="middle">CORBA_double</cell> - <cell align="left" valign="middle">CORBA_double*</cell> - <cell align="left" valign="middle">CORBA_double</cell> - </row> - <row> - <cell align="left" valign="middle">boolean</cell> - <cell align="left" valign="middle">CORBA_boolean</cell> - <cell align="left" valign="middle">CORBA_boolean*</cell> - <cell align="left" valign="middle">CORBA_boolean</cell> - </row> - <row> - <cell align="left" valign="middle">char</cell> - <cell align="left" valign="middle">CORBA_char</cell> - <cell align="left" valign="middle">CORBA_char*</cell> - <cell align="left" valign="middle">CORBA_char</cell> - </row> - <row> - <cell align="left" valign="middle">wchar</cell> - <cell align="left" valign="middle">CORBA_wchar</cell> - <cell align="left" valign="middle">CORBA_wchar*</cell> - <cell align="left" valign="middle">CORBA_wchar</cell> - </row> - <row> - <cell align="left" valign="middle">octet</cell> - <cell align="left" valign="middle">CORBA_octet</cell> - <cell align="left" valign="middle">CORBA_octet*</cell> - <cell align="left" valign="middle">CORBA_octet</cell> - </row> - <row> - <cell align="left" valign="middle">enum</cell> - <cell align="left" valign="middle">CORBA_enum</cell> - <cell align="left" valign="middle">CORBA_enum*</cell> - <cell align="left" valign="middle">CORBA_enum</cell> - </row> - <row> - <cell align="left" valign="middle">struct, fixed</cell> - <cell align="left" valign="middle">struct*</cell> - <cell align="left" valign="middle">struct*</cell> - <cell align="left" valign="middle">struct</cell> - </row> - <row> - <cell align="left" valign="middle">struct, variable</cell> - <cell align="left" valign="middle">struct*</cell> - <cell align="left" valign="middle">struct**</cell> - <cell align="left" valign="middle">struct*</cell> - </row> - <row> - <cell align="left" valign="middle">union, fixed</cell> - <cell align="left" valign="middle">union*</cell> - <cell align="left" valign="middle">union*</cell> - <cell align="left" valign="middle">union</cell> - </row> - <row> - <cell align="left" valign="middle">union, variable</cell> - <cell align="left" valign="middle">union*</cell> - <cell align="left" valign="middle">union**</cell> - <cell align="left" valign="middle">union*</cell> - </row> - <row> - <cell align="left" valign="middle">string</cell> - <cell align="left" valign="middle">CORBA_char*</cell> - <cell align="left" valign="middle">CORBA_char**</cell> - <cell align="left" valign="middle">CORBA_char*</cell> - </row> - <row> - <cell align="left" valign="middle">wstring</cell> - <cell align="left" valign="middle">CORBA_wchar*</cell> - <cell align="left" valign="middle">CORBA_wchar**</cell> - <cell align="left" valign="middle">CORBA_wchar*</cell> - </row> - <row> - <cell align="left" valign="middle">sequence</cell> - <cell align="left" valign="middle">sequence*</cell> - <cell align="left" valign="middle">sequence**</cell> - <cell align="left" valign="middle">sequence*</cell> - </row> - <row> - <cell align="left" valign="middle">array, fixed</cell> - <cell align="left" valign="middle">array</cell> - <cell align="left" valign="middle">array</cell> - <cell align="left" valign="middle">array_slice*</cell> - </row> - <row> - <cell align="left" valign="middle">array, variable</cell> - <cell align="left" valign="middle">array</cell> - <cell align="left" valign="middle">array_slice**</cell> - <cell align="left" valign="middle">array_slice*</cell> - </row> - <tcaption>Basic Argument and Result passing</tcaption> - </table> - <p>A client is responsible for providing storage of all arguments passed - as <em>in</em> arguments.</p> - <table> - <row> - <cell align="left" valign="middle">OMG IDL type</cell> - <cell align="left" valign="middle">Out</cell> - <cell align="left" valign="middle">Return</cell> - </row> - <row> - <cell align="left" valign="middle">short</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">long</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">long long</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned short</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned long</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned long long</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">float</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">double</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">boolean</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">char</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">wchar</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">octet</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">enum</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">struct, fixed</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">1</cell> - </row> - <row> - <cell align="left" valign="middle">struct, variable</cell> - <cell align="left" valign="middle">2</cell> - <cell align="left" valign="middle">2</cell> - </row> - <row> - <cell align="left" valign="middle">string</cell> - <cell align="left" valign="middle">2</cell> - <cell align="left" valign="middle">2</cell> - </row> - <row> - <cell align="left" valign="middle">wstring</cell> - <cell align="left" valign="middle">2</cell> - <cell align="left" valign="middle">2</cell> - </row> - <row> - <cell align="left" valign="middle">sequence</cell> - <cell align="left" valign="middle">2</cell> - <cell align="left" valign="middle">2</cell> - </row> - <row> - <cell align="left" valign="middle">array, fixed</cell> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">3</cell> - </row> - <row> - <cell align="left" valign="middle">array, variable</cell> - <cell align="left" valign="middle">3</cell> - <cell align="left" valign="middle">3</cell> - </row> - <tcaption>Client argument storage responsibility</tcaption> - </table> - <table> - <row> - <cell align="left" valign="middle">Case</cell> - <cell align="left" valign="middle">Description</cell> - </row> - <row> - <cell align="left" valign="middle">1</cell> - <cell align="left" valign="middle">Caller allocates all necessary storage, except that which may be encapsulated and managed within the parameter itself.</cell> - </row> - <row> - <cell align="left" valign="middle">2</cell> - <cell align="left" valign="middle">The caller allocates a pointer and passes it by reference to the callee. The callee sets the pointer to point to a valid instance of the parameter's type. The caller is responsible for releasing the returned storage. Following completion of a request, the caller is not allowed to modify any values in the returned storage. To do so the caller must first copy the returned instance into a new instance, then modify the new instance. </cell> - </row> - <row> - <cell align="left" valign="middle">3</cell> - <cell align="left" valign="middle">The caller allocates a pointer to an array slice which has all the same dimensions of the original array except the first, and passes it by reference to the callee. The callee sets the pointer to point to a valid instance of the array. The caller is responsible for releasing the returned storage. Following completion of a request, the caller is not allowed to modify any values in the returned storage. To do so the caller must first copy the returned instance into a new instance, then modify the new instance. </cell> - </row> - <tcaption>Argument passing cases</tcaption> - </table> - <p>The returned storage in case 2 and 3 is allocated as one block of memory - so it is possible to deallocate it with one call of CORBA_free.</p> - </section> - - <section> - <title>Supported Memory Allocation Functions</title> - <list type="bulleted"> - <item> - <p><em>CORBA_Environment</em> can be allocated from the user by calling - <em>CORBA_Environment_alloc()</em>.</p> - <p>The interface for this function is </p> - <p><c>CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz);</c></p> - <p>where :</p> - <list type="bulleted"> - <item> - <p><em>inbufsz</em> is the desired size of input buffer</p> - </item> - <item> - <p><em>outbufsz</em> is the desired size of output buffer</p> - </item> - <item> - <p>return value is a <em>pointer</em> to an allocated and initialized - <em>CORBA_Environment</em> structure</p> - <p></p> - </item> - </list> - </item> - <item> - <p>Strings can be allocated from the user by calling <em>CORBA_string_alloc()</em>.</p> - <p>The interface for this function is </p> - <p><c>CORBA_char *CORBA_string_alloc(CORBA_unsigned_long len);</c></p> - <p>where :</p> - <list type="bulleted"> - <item> - <p><em>len</em> is the length of the string to be allocated.</p> - </item> - </list> - </item> - </list> - <p>Thus far, no other type allocation function is supported.</p> - </section> - - <section> - <title>Special Memory Deallocation Functions</title> - <list type="bulleted"> - <item> - <p><c>void CORBA_free(void *storage)</c></p> - <p>This function will free storage allocated by the stub.</p> - </item> - <item> - <p><c>void CORBA_exception_free(CORBA_environment *ev)</c></p> - <p>This function will free storage allocated under exception propagation. </p> - </item> - </list> - </section> - - <section> - <title>Exception Access Functions</title> - <list type="bulleted"> - <item> - <p><c>CORBA_char *CORBA_exception_id(CORBA_Environment *ev)</c></p> - <p>This function will return raised exception identity.</p> - </item> - <item> - <p><c>void *CORBA_exception_value(CORBA_Environment *ev)</c></p> - <p>This function will return the value of a raised exception. </p> - </item> - </list> - </section> - - <section> - <title>Special Types</title> - <list type="bulleted"> - <item> - <p>The erlang binary type has some special features.</p> - <p></p> - <p>While the <c>erlang::binary</c> idl type has the same C-definition as - a generated sequence of octets :</p> - <code type="none"><![CDATA[ - module erlang - { - - .... - - // an erlang binary - typedef sequence<octet> binary; - - }; - ]]></code> - <p>it provides a way on sending trasparent data between C and Erlang.</p> - <p>The C-definition (ic.h) for an erlang binary is :</p> - <code type="none"> - typedef struct { - CORBA_unsigned_long _maximum; - CORBA_unsigned_long _length; - CORBA_octet* _buffer; - } erlang_binary; /* ERLANG BINARY */ - </code> - <p>The differences (between <c>erlang::binary</c> and <c><![CDATA[sequence< octet >]]></c>) are :</p> - <list type="bulleted"> - <item> - <p>on the erlang side the user is sending/receiving typical - built in erlang binaries, using <c>term_to_binary() / binary_to_term()</c> - to create / extract binary structures.</p> - </item> - <item> - <p>no encoding/decoding functions are generated</p> - </item> - <item> - <p>the underlying protocol is more efficient than usual sequences of - octets</p> - </item> - </list> - <p>The erlang binary IDL type is defined in <c>erlang.idl</c>, while its - C definition is located in the <c>ic.h</c> header file, both in the - <c><![CDATA[IC-< vsn >/include]]></c> directory. - The user will have to include the file <c>erlang.idl</c> in order to use the - <c>erlang::binary</c> type.</p> - </item> - </list> - </section> - - <section> - <title>A Mapping Example</title> - <p> <marker id="stack_idl"></marker> - - This is a small example of a simple stack. There are two - operations on the stack, push and pop. The example shows all - generated files as well as conceptual usage of the stack.</p> - <code type="none"> -// The source IDL file: stack.idl - -struct s { - long l; - string s; -}; - -interface stack { - void push(in s val); - s pop(); -}; - </code> - <p>When this file is compiled it produces four files, two for the - top scope and two for the stack interface scope. The important parts - of the generated C code for the stack API is shown below. <marker id="stack_serv"></marker> -</p> - <p>stack.c</p> - <code type="none"> - -void push(stack oe_obj, s val, CORBA_Environment* oe_env) { - ... -} - - -s* pop(stack oe_obj, CORBA_Environment* oe_env) { - ... -} - </code> - <p>oe_stack.h</p> - <code type="none"> -#ifndef OE_STACK_H -#define OE_STACK_H - - -/*------------------------------------------------------------ - * Struct definition: s - */ -typedef struct { - long l; - char *s; -} s; - - - -#endif - </code> - <p>stack.h just contains an include statement of <c>oe_stack.h</c>.</p> - <p>oe_code_s.c</p> - <code type="none"> - -int oe_sizecalc_s(CORBA_Environment - *oe_env, int* oe_size_count_index, int* oe_size) { - ... -} - -int oe_encode_s(CORBA_Environment *oe_env, s* oe_rec) { - ... -} - -int oe_decode_s(CORBA_Environment *oe_env, char *oe_first, - int* oe_outindex, s *oe_out) { - ... -} - </code> - <p>The only files that are really important are the <c>.h</c> - files and the stack.c file.</p> - </section> -</chapter> - diff --git a/lib/ic/doc/src/ch_c_server.xml b/lib/ic/doc/src/ch_c_server.xml deleted file mode 100644 index df25927c90..0000000000 --- a/lib/ic/doc/src/ch_c_server.xml +++ /dev/null @@ -1,149 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>The C Server Back-end</title> - <prepared></prepared> - <docno></docno> - <date>2004-01-14</date> - <rev>C</rev> - <file>ch_c_server.xml</file> - </header> - - <section> - <title>Introduction</title> - <p>With the option <c>{be, c_server}</c> the IDL Compiler generates - C server skeletons according to the IDL to C mapping, on top of - the Erlang distribution and gen_server protocols.</p> - <p>The developer has to write additional code, that together with - the generated C server skeletons, form a hidden Erlang - node. That additional code contains implementations of call-back - functions that implement the true server functionality, and also - code uses <c>erl_interface</c> functions for defining the hidden - node and for establishing connections to other Erlang nodes.</p> - </section> - - <section> - <title>Generated Stub Files</title> - <p>The generated stub files are:</p> - <list type="bulleted"> - <item> - <p>For each IDL interface, a C source file, the name of which - is <c><![CDATA[<Scoped Interface Name>__s.c]]></c>. Each operation of the - IDL interface is mapped to a C function (with scoped name) - in that file;</p> - </item> - <item> - <p>C source files that contain functions for type conversion, - memory allocation, and data encoding/decoding;</p> - </item> - <item> - <p>C header files that contain function prototypes and type - definitions.</p> - </item> - </list> - <p>All C functions are exported (i.e. not declared static).</p> - </section> - - <section> - <title>C Skeleton Functions</title> - <p>For each IDL operation a C skeleton function is generated, the - prototype of which is <c><![CDATA[int <Scoped Function Name>__exec(<Interface Object> oe_obj, CORBA_Environment *oe_env)]]></c>, where <c><![CDATA[<Interface Object>]]></c>, and - <c>CORBA_Environment</c> are of the same type as for the - generated C client stubs code.</p> - <p>Each <c><![CDATA[<Scoped Function Name>__exec()]]></c> function calls the - call-back function</p> - <p><c><![CDATA[<Scoped Function Name>_rs* <Scoped Function Name>__cb(<Interface Object> oe_obj, <Parameters>, CORBA_Environment *oe_env)]]></c></p> - <p>where the arguments are of the same type as those generated for - C client stubs. </p> - <p>The return value <c><![CDATA[<Scoped Function Name>_rs* ]]></c> is a pointer - to a function with the same signature as the call-back function - <c><![CDATA[<Scoped Function Name>_cb]]></c>, and is called after the call-back - function has been evaluated (provided that the pointer is not equal - to <c>NULL</c>). </p> - </section> - - <section> - <title>The Server Loop</title> - <p>The developer has to implement code for establishing connections - with other Erlang nodes, code for call-back functions and restore - functions. </p> - <p></p> - <p>In addition, the developer also has to implement code for a - server loop, that receives messages and calls the relevant - <c>__exec</c> function. For that purpose the IC library function - <c>oe_server_receive()</c> function can be used.</p> - </section> - - <section> - <title>Generating, Compiling and Linking</title> - <p>To generate the C server skeletons type the following in an - appropriate shell:</p> - <p><c>erlc -I ICROOT/include "+{be, c_server}" File.idl</c>,</p> - <p>where <c>ICROOT</c> is the root of the IC application. The - <c>-I ICROOT/include</c> is only needed if <c>File.idl</c> - refers to <c>erlang.idl</c>.</p> - <p>When compiling a generated C skeleton file, the directories - <c>ICROOT/include</c> and <c>EICROOT/include</c>, have to be - specified as include directories, where <c>EIROOT</c> is the - root directory of the Erl_interface application.</p> - <p>When linking object files the <c>EIROOT/lib</c> and - <c>ICROOT/priv/lib</c> directories have to be specified. </p> - </section> - - <section> - <title>An Example</title> - <p>In this example the IDL specification file "random.idl" is used - for generating C server skeletons (the file is contained in the IC - <c>/examples/c-server</c> directory):</p> - <code type="none"> -module rmod { - - interface random { - - double produce(); - - oneway void init(in long seed1, in long seed2, in long seed3); - - }; - -}; </code> - <p>Generate the C server skeletons:</p> - <code type="none"> -erlc '+{be, c_server}' random.idl -Erlang IDL compiler version X.Y.Z </code> - <p>Six files are generated. </p> - <p>Compile the C server skeletons:</p> - <p>Please read the <c>ReadMe</c> file in the - <c>examples/c-server</c> directory.</p> - <p>In the same directory you can find all the code for this - example. In particular you will find the <c>server.c</c> file - that contains all the additional code that must be written to - obtain a complete server.</p> - <p>In the <c>examples/c-server</c> directory you will also find - source code for an Erlang client, which can be used for testing - the C server.</p> - </section> -</chapter> - - diff --git a/lib/ic/doc/src/ch_erl_genserv.xml b/lib/ic/doc/src/ch_erl_genserv.xml deleted file mode 100644 index aa162b3652..0000000000 --- a/lib/ic/doc/src/ch_erl_genserv.xml +++ /dev/null @@ -1,206 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>Using the Erlang Generic Server Back-end</title> - <prepared></prepared> - <docno></docno> - <date>98-08-06</date> - <rev>B</rev> - <file>ch_erl_genserver.xml</file> - </header> - - <section> - <title>Introduction</title> - <p>The mapping of OMG IDL to the Erlang programming language when Erlang - generic server is the back-end of choice is similar to the one used in - the chapter 'OMG IDL Mapping'. - The only difference is in the generated code, a client stub and - server skeleton to an Erlang <c>gen_server</c>. Orber's User's Guide - contain a more detailed description of IDL to Erlang mapping.</p> - </section> - - <section> - <title>Compiling the Code</title> - <p>The <c>ic:gen/2</c> function can be called from the command - line as follows:</p> - <p></p> - <code type="none"> -shell> erlc "+{be, erl_genserv}" MyFile.idl - </code> - </section> - - <section> - <title>Writing the Implementation File</title> - <p>For each IDL interface <c><![CDATA[<interface name>]]></c> defined in the IDL file :</p> - <list type="bulleted"> - <item>Create the corresponding Erlang file that will hold the - Erlang implementation of the IDL definitions. </item> - <item>Call the implementation file after the scope of the IDL interface, - followed by the suffix <c>_impl</c>.</item> - <item>Export the implementation functions.</item> - </list> - <p>For each function defined in the IDL interface :</p> - <list type="bulleted"> - <item>Implement an Erlang function that uses as arguments in the same - order, as the input arguments described in the IDL file, and returns - the value described in the interface.</item> - <item>When using the function, follow the mapping described in chapter 2.</item> - </list> - </section> - - <section> - <title>An Example</title> - <p>In this example, a file <c>random.idl</c> generates code for the Erlang - gen_server back-end:</p> - <code type="none"> -// Filename random.idl -module rmod { - - interface random { - // Generate a new random number - double produce(); - // Initialize random generator - oneway void init(in long seed1, in long seed2, in long seed3); - - }; -}; - </code> - <p>When the file "random.idl" is compiled (e.g., <c>shell> erlc "+{be, erl_genserv}" random.idl</c>) - five files are produced; two for the top scope, two for the interface scope, - and one for the module scope. The header files for top scope and interface - are empty and not shown here. In this case, the stub/skeleton file - <c>rmod_random.erl</c> is the most important. This module exports two kinds of - operations:</p> - <list type="bulleted"> - <item><em>Administrative</em> - used when, for example, creating and - terminating the server.</item> - <item><em>IDL dependent</em> - operations defined in the IDL - specification. In this case, <c>produce</c> and <c>init</c>.</item> - </list> - - <section> - <title>Administrative Operations</title> - <p>To create a new server instance, one of the following functions should - be used:</p> - <list type="bulleted"> - <item><em>oe_create/0/1/2</em> - create a new instance of the object. - Accepts <c>Env</c> and <c>RegName</c>, in that order, as parameters. - The former is passed uninterpreted to the initialization operation - of the call-back module, while the latter must be as the - <c>gen_server</c> parameter <c>ServerName</c>. If <c>Env</c> is - left out, an empty list will be passed.</item> - <item><em>oe_create_link/0/1/2</em> - similar to <c>oe_create/0/1/2</c>, - but create a linked server.</item> - <item><em>typeID/0</em> - returns the scooped id compliant with the - OMG standard. In this case the string - <c>"IDL:rmod/random:1.0"</c>.</item> - <item><em>stop/1</em> - asynchronously terminate the server. The required - argument is the return value from any of the start functions.</item> - </list> - </section> - - <section> - <title>IDL Dependent Operations</title> - <p>Operations can either be synchronous or asynchronous - (i.e., <c>oneway</c>). These are, respectively, mapped to - <c>gen_server:call/2/3</c> and <c>gen_server:cast/2</c>. - Consult the <c>gen_server</c> documentation for valid return values.</p> - <p>The IDL dependent operations in this example are listed below. - The first argument must be the whatever the create operation returned.</p> - <list type="bulleted"> - <item><em>init(ServerReference, Seed1, Seed2, Seed3)</em> - initialize - the random number generator.</item> - <item><em>produce(ServerReference)</em> - generate a new random number.</item> - </list> - </section> - <p>If the compile option <c>timeout</c> is used a timeout must be added - (e.g., <c>produce(ServerReference, 5000)</c>). For more information, see - the <c>gen_server</c> documentation.</p> - - <section> - <title>Implementation Module</title> - <p>The implementation module shall, unless the compile option - <c>impl</c> is used, be named <c>rmod_random_impl.erl</c>. - and could look like this:</p> - <code type="none"> --module('rmod_random_impl'). -%% Mandatory gen_server operations --export([init/1, terminate/2, code_change/3]). -%% Add if 'handle_info' compile option used --export([handle_info/2]). -%% API defined in IDL specification --export([produce/1,init/4]). - -%% Mandatory operations -init(Env) -> - {ok, []}. - -terminate(From, Reason) -> - ok. - -code_change(OldVsn, State, Extra) -> - {ok, State}. - -%% Optional -handle_info(Info, State) -> - {noreply, NewState}. - -%% IDL specification -produce(State) -> - case catch random:uniform() of - {'EXIT',_} -> - {stop, normal, "random:uniform/0 - EXIT", State}; - RUnif -> - {reply, RUnif, State} - end. - - -init(State, S1, S2, S3) -> - case catch random:seed(S1, S2, S3) of - {'EXIT',_} -> - {stop, normal, State}; - _ -> - {noreply, State} - end. - </code> - <p>Compile the code and run the example:</p> - <code type="none"><![CDATA[ -1> make:all(). -Recompile: rmod_random -Recompile: oe_random -Recompile: rmod_random_impl -up_to_date -2> {ok,R} = rmod_random:oe_create(). -{ok,<0.30.0>} -3> rmod_random:init(R, 1, 2, 3). -ok -4> rmod_random:produce(R). -1.97963e-4 -5> - ]]></code> - </section> - </section> -</chapter> - - diff --git a/lib/ic/doc/src/ch_erl_plain.xml b/lib/ic/doc/src/ch_erl_plain.xml deleted file mode 100644 index 27387d1624..0000000000 --- a/lib/ic/doc/src/ch_erl_plain.xml +++ /dev/null @@ -1,176 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>Using the Plain Erlang Back-end</title> - <prepared></prepared> - <docno></docno> - <date>98-05-06</date> - <rev>B</rev> - <file>ch_erl_plain.xml</file> - </header> - - <section> - <title>Introduction</title> - <p>The mapping of OMG IDL to the Erlang programming language when - Plain Erlang - is the back-end of choice is similar to the one used in pure Erlang IDL - mapping. The only difference is on the generated code and the extended - use of pragmas for code generation: IDL functions are translated - to Erlang - module function calls.</p> - </section> - - <section> - <title>Compiling the Code</title> - <p>In the Erlang shell type :</p> - <p>ic:gen(<c><![CDATA[<filename>, [{be, erl_plain}])]]></c>.</p> - </section> - - <section> - <title>Writing the Implementation File</title> - <p>For each IDL interface <c><![CDATA[<interface name>]]></c> defined in the IDL file:</p> - <list type="bulleted"> - <item>Create the corresponding Erlang file that will hold the - Erlang implementation of the IDL definitions. </item> - <item>Call the implementation file after the scope of the IDL interface, - followed by the suffix <c>_impl</c>.</item> - <item>Export the implementation functions.</item> - </list> - <p>For each function defined in the IDL interface :</p> - <list type="bulleted"> - <item>Implement an Erlang function that uses as arguments in the same - order, as the input arguments described in the IDL file, and returns - the value described in the interface.</item> - <item>When using the function, follow the mapping described in chapter 2.</item> - </list> - </section> - - <section> - <title>An Example</title> - <p> <marker id="plain_idl"></marker> - - In this example, a file "random.idl" is generates code for the plain Erlang - back-end :</p> - <list type="bulleted"> - <item> - <p>Main file : "plain.idl"</p> - <code type="none"> - -module rmod { - - interface random { - - double produce(); - - oneway void init(in long seed1, in long seed2, in long seed3); - - }; - -}; - </code> - </item> - </list> - <p>Compile the file :</p> - <code type="none"> - Erlang (BEAM) emulator version 4.9 - - Eshell V4.9 (abort with ^G) - 1> ic:gen(random,[{be, erl_plain}]). - Erlang IDL compiler version 2.5.1 - ok - 2> - </code> - <p></p> - <p>When the file "random.idl" is compiled it produces five files: two for - the top scope, two for the interface scope, and one for the module - scope. The header files for top scope and interface - are empty and not shown here. In this case only the file for the interface - <c>rmod_random.erl</c> is important :. - <marker id="generated files"></marker> -</p> - <list type="bulleted"> - <item> - <p>Erlang file for interface : "rmod_random.erl"</p> - <code type="none"> - --module(rmod_random). - - - -%% Interface functions --export([produce/0, init/3]). - -%%------------------------------------------------------------ -%% Operation: produce -%% -%% Returns: RetVal -%% -produce() -> - rmod_random_impl:produce(). - -%%------------------------------------------------------------ -%% Operation: init -%% -%% Returns: RetVal -%% -init(Seed1, Seed2, Seed3) -> - rmod_random_impl:init(Seed1, Seed2, Seed3). - </code> - </item> - </list> - <p>The implementation file should be called <c>rmod_random_impl.erl</c> - and could look like this:</p> - <code type="none"> - -module('rmod_random_impl'). - - -export([produce/0,init/3]). - - - produce() -> - random:uniform(). - - - init(S1,S2,S3) -> - random:seed(S1,S2,S3). - </code> - <p>Compiling the code : </p> - <code type="none"> -2> make:all(). -Recompile: rmod_random -Recompile: oe_random -Recompile: rmod_random_impl -up_to_date - </code> - <p></p> - <p>Running the example : </p> - <code type="none"> -3> rmod_random:init(1,2,3). -ok -4> rmod_random:produce(). -1.97963e-4 -5> - </code> - </section> -</chapter> - diff --git a/lib/ic/doc/src/ch_ic_protocol.xml b/lib/ic/doc/src/ch_ic_protocol.xml deleted file mode 100644 index cb64500f6e..0000000000 --- a/lib/ic/doc/src/ch_ic_protocol.xml +++ /dev/null @@ -1,234 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2003</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IC Protocol</title> - <prepared></prepared> - <docno></docno> - <date>2003-12-11</date> - <rev>PA1</rev> - <file>ch_ic_protocol.xml</file> - </header> - <p>The purpose of this chapter is to explain the bits and bytes of the - IC protocol, which is a composition of the Erlang distribution protocol - and the Erlang/OTP gen_server protocol. If you do not intend to replace - the Erlang distribution protocol, or replace the gen_server protocol, - skip over this chapter. - </p> - - <section> - <title>Introduction</title> - <p>The IDL Compiler (IC) transforms Interface Definition Language - (IDL) specifications files to interface code for Erlang, C, and - Java. The Erlang language mapping is described in the Orber - documentation, while the other mappings are described in the IC - documentation (they are of course in accordance with the CORBA C - and Java language mapping specifications, with some restrictions). - </p> - <p>The most important parts of an IDL specification are the operation - declarations. An operation defines what information a client - provides to a server, and what information (if any) the client - gets back from the server. We consider IDL operations and language - mappings in section 2. - </p> - <p>What we here call the IC protocol, is the description of messages - exchanged between IC end-points (client and servers). It is valid - for all IC back-ends, except the 'erl_plain' and 'erl_corba' - back-ends. - The IC protocol is in turn embedded into the Erlang gen_server - protocol, which is described below. - Finally, the gen_server protocol is embedded in the Erlang - distribution protocol. Pertinent parts of that protocol is - described further below. - </p> - </section> - - <section> - <title>Language mappings and IDL operations</title> - - <section> - <title>IDL Operations</title> - <p>An IDL operation is declared as follows:</p> - <code type="none"> - [oneway] RetType Op(in IType1 I1, in IType2 I2, ..., in ITypeN IN, - out OType1 O1, out OType2 O2, ..., out OTypeM OM) - N, M = 0, 1, 2, ... (2.1.1) - </code> - <p>`Op' is the operation name, RetType is the return type, and ITypei, - i = 1, 2, ..., N, and OTypej, j = 1, 2, ..., M, are the `in' types - and `out' types, respectively. The values I1, I2, ..., IN are - provided by the caller, and the value of RetType, and the values - O1, O2, ..., OM, are provided as results to the caller. - </p> - <p>The types can be any basic types or derived types declared in the - IDL specification of which the operation declaration is a part. - </p> - <p>If the RetType has the special name `void' there is no return - value (but there might still be result values O1, 02, ..., OM). - </p> - <p>The `in' and `out' parameters can be declared in any order, but - for clarity we have listed all `in' parameters before the `out' - parameters in the declaration above. - </p> - <p>If the keyword `oneway' is present, the operation is a cast, i.e. - there is no confirmation of the operation, and consequently there - must be no result values: RetType must be equal to `void', and M = - 0 must hold. - </p> - <p>Otherwise the operation is a call, i.e. it is confirmed (or else - an exception is raised). - </p> - <p>Note carefully that an operation declared without `oneway' is - always a call, even if RetType is `void' and M = 0. - </p> - </section> - - <section> - <title>Language Mappings</title> - <p>There are several CORBA Language Mapping specifications. These are - about mapping interfaces to various programming languages. IC - supports the CORBA C and Java mapping specifications, and the - Erlang language mapping specified in the Orber documentation. - </p> - <p>Excerpt from "6.4 Basic OMG IDL Types" in the Orber User's Guide: - </p> - <list type="bulleted"> - <item> - <p>Functions with return type void will return the atom ok.</p> - </item> - </list> - <p>Excerpt from "6.13 Invocations of Operations" in the Orber User's - Guide: - </p> - <list type="bulleted"> - <item> - <p>A function call will invoke an operation. The first parameter - of the function should be the object reference and then all in - and inout parameters follow in the same order as specified in - the IDL specification. The result will be a return value - unless the function has inout or out parameters specified; in - which case, a tuple of the return value, followed by the - parameters will be returned.</p> - </item> - </list> - <p>Hence the function that is mapped from an IDL operation to Erlang - always have a return value (an Erlang function always has). That - fact has influenced the IC protocol, in that there is always a - return value (which is 'ok' if the return type was declared 'void'). </p> - </section> - </section> - - <section> - <title>IC Protocol</title> - <p>Given the operation declaration (2.1.1) the IC protocol maps to - messages as follows, defined in terms of Erlang terms. - </p> - - <section> - <title>Call (Request/Reply, i.e. not oneway)</title> - <code type="none"> - request: Op atom() N = 0 - {Op, I1, I2, ..., IN} tuple() N > 0 - (3.1.1) - - reply: Ret M = 0 - {Ret, O1, O2, ..., OM} M > 0 - (3.1.2)</code> - <p><em>Notice:</em> Even if the RetType of the operation Op is - declared to be 'void', a return value 'ok' is returned in - the reply message. That - return value is of no significance, and is therefore ignored (note - however that a C server back-end returns the atom 'void' instead - of 'ok'). - </p> - </section> - - <section> - <title>Cast (oneway)</title> - <code type="none"> - - notification: Op atom() N = 0 - {Op, I1, I2, ..., IN} tuple() N > 0 - (3.2.1)</code> - <p>(There is of course no return message). - </p> - </section> - </section> - - <section> - <title>Gen_server Protocol</title> - <p>Most of the IC generated code deals with encoding and decoding the - gen_server protocol. - </p> - - <section> - <title>Call</title> - <code type="none"> - - request: {'$gen_call', {self(), Ref}, Request} (4.1.1) - - reply: {Ref, Reply} (4.1.2)</code> - <p>where Request and Reply are the messages defined in the previous - chapter. - </p> - </section> - - <section> - <title>Cast</title> - <code type="none"> - notification: {'$gen_cast', Notification} (4.2.1) </code> - <p>where Notification is the message defined in the previous chapter. - </p> - </section> - </section> - - <section> - <title>Erlang Distribution Protocol</title> - <p>Messages (of interest here) between Erlang nodes are of the form: </p> - <code type="none"> - Len(4), Type(1), CtrlBin(N), MsgBin(M) (5.1) </code> - <p>Type is equal to 112 = PASS_THROUGH. - </p> - <p>CtrlBin and MsgBin are Erlang terms in binary form (as if created - by term_to_binary/1), whence for each of them the first byte is - equal to 131 = VERSION_MAGIC. - </p> - <p>CtrlBin (of interest here) contains the SEND and REG_SEND control - messages, which are binary forms of the Erlang terms</p> - <code type="none"> - {2, Cookie, ToPid} , (5.2) </code> - <p>and</p> - <code type="none"> - {6, FromPid, Cookie, ToName} , (5.3) </code> - <p>respectively. - </p> - <p>The CtrlBin(N) message is read and written by erl_interface code - (C), j_interface code (Java), or the Erlang distribution - implementation, which are invoked from IC generated code. - </p> - <p>The MsgBin(N) is the "real" message, i.e. of the form described - in the previous section. - </p> - </section> -</chapter> - diff --git a/lib/ic/doc/src/ch_introduction.xml b/lib/ic/doc/src/ch_introduction.xml deleted file mode 100644 index 9ac2f96a95..0000000000 --- a/lib/ic/doc/src/ch_introduction.xml +++ /dev/null @@ -1,149 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>Using the IC Compiler</title> - <prepared></prepared> - <docno></docno> - <date>2002-08-02</date> - <rev>PB1</rev> - <file>ch_introduction.xml</file> - </header> - - <section> - <title>Introduction</title> - <p>The IC application is an IDL compiler implemented in Erlang. - The IDL compiler generates client stubs and server skeletons. - Several back-ends are supported, and they fall into three main - groups.</p> - <p>The first group consists of a CORBA back-end:</p> - <taglist> - <tag>IDL to Erlang CORBA</tag> - <item> - <p>This back-end is for CORBA communication and implementation, - and the generated code uses the CORBA specific protocol for - communication between clients and servers. See the - <em>Orber</em> application User's Guide and manuals for - further details.</p> - </item> - </taglist> - <p>The second group consists of a simple Erlang back-end:</p> - <taglist> - <tag>IDL to plain Erlang</tag> - <item> - <p>This back-end provides a very simple Erlang client - interface. It can only be used within an Erlang node, - and the communication between client and "server" is - therefore in terms of ordinary function calls. </p> - <p>This back-end can be considered a short-circuit version of - the IDL to Erlang gen_server back-end (see further below).</p> - </item> - </taglist> - <p>The third group consists of backends for Erlang, C, and - Java. The communication between clients and servers is by the - Erlang distribution protocol, facilitated by - <em>erl_interface</em> and <em>jinterface</em> for C and Java, - respectively.</p> - <p>All back-ends of the third group generate code compatible with - the Erlang gen_server behavior protocol. Thus generated client - code corresponds to <c>call()</c> or <c>cast()</c> of an Erlang - <c>gen_server</c>. Similarly, generated server code corresponds - to <c>handle_call()</c> or <c>handle_cast()</c> of an Erlang - <c>gen_server</c>.</p> - <p>The back-ends of the third group are: - </p> - <taglist> - <tag>IDL to Erlang gen_server</tag> - <item> - <p>Client stubs and server skeletons are generated. Data types - are mapped according to the IDL to Erlang mapping described - in the <em>Orber User's Guide</em>.</p> - <p></p> - </item> - <tag>IDL to C client</tag> - <item> - <p>Client stubs are generated. The mapping of data types is - described further on in the C client part of this guide.</p> - </item> - <tag>IDL to C server</tag> - <item> - <p>Server skeletons are generated. The mapping of data types is - described further on in the C server part of this guide.</p> - </item> - <tag>IDL to Java</tag> - <item> - <p>Client stubs and server skeletons are generated. The mapping - of data types is described further on in the Java part of - this guide.</p> - </item> - </taglist> - </section> - - <section> - <title>Compilation of IDL Files</title> - <p>The IC compiler is invoked by executing the generic <c>erlc</c> - compiler from a shell:</p> - <code type="none"> -%> erlc +'{be,BackEnd}' File.idl - </code> - <p>where <c>BackEnd</c> is according to the table below, and - <c>File.idl</c> is the IDL file to be compiled.</p> - <table> - <row> - <cell align="left" valign="middle"><em>Back-end</em></cell> - <cell align="left" valign="middle"><c>BackEnd</c>option</cell> - </row> - <row> - <cell align="left" valign="middle">IDL to CORBA</cell> - <cell align="left" valign="middle"><c>erl_corba</c></cell> - </row> - <row> - <cell align="left" valign="middle">IDL to CORBA template</cell> - <cell align="left" valign="middle"><c>erl_template</c></cell> - </row> - <row> - <cell align="left" valign="middle">IDL to plain Erlang</cell> - <cell align="left" valign="middle"><c>erl_plain</c></cell> - </row> - <row> - <cell align="left" valign="middle">IDL to Erlang gen_server</cell> - <cell align="left" valign="middle"><c>erl_genserv</c></cell> - </row> - <row> - <cell align="left" valign="middle">IDL to C client</cell> - <cell align="left" valign="middle"><c>c_client</c></cell> - </row> - <row> - <cell align="left" valign="middle">IDL to C server</cell> - <cell align="left" valign="middle"><c>c_server</c></cell> - </row> - <row> - <cell align="left" valign="middle">IDL to Java</cell> - <cell align="left" valign="middle"><c>java</c></cell> - </row> - <tcaption>Compiler back-ends and options</tcaption> - </table> - <p>For more details on IC compiler options consult the ic(3) manual page.</p> - </section> -</chapter> - diff --git a/lib/ic/doc/src/ch_java.xml b/lib/ic/doc/src/ch_java.xml deleted file mode 100644 index a733adaf65..0000000000 --- a/lib/ic/doc/src/ch_java.xml +++ /dev/null @@ -1,738 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1999</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IDL to Java language Mapping</title> - <prepared></prepared> - <docno></docno> - <date>98-09-24</date> - <rev>A</rev> - <file>ch_java.xml</file> - </header> - - <section> - <title>Introduction</title> - <p>This chapter describes the mapping of OMG IDL constructs to the Java - programming language for the generation of native Java - Erlang - communication. </p> - <p>This language mapping defines the following:</p> - <list type="bulleted"> - <item> - <p>All OMG IDL basic types</p> - </item> - <item> - <p>All OMG IDL constructed types</p> - </item> - <item> - <p>References to constants defined in OMG IDL</p> - </item> - <item> - <p>Invocations of operations, including passing of - parameters and receiving of result</p> - </item> - <item> - <p>Access to attributes</p> - </item> - </list> - </section> - - <section> - <title>Specialties in the Mapping</title> - - <section> - <title>Names Reserved by the Compiler</title> - <p>The IDL compiler reserves all identifiers starting with - <c>OE_</c> and <c>oe_</c> for internal use.</p> - </section> - </section> - - <section> - <title>Basic OMG IDL Types</title> - <p>The mapping of basic types are according to the standard. All basic types have - a special Holder class.</p> - <table> - <row> - <cell align="left" valign="middle">OMG IDL type</cell> - <cell align="left" valign="middle">Java type</cell> - </row> - <row> - <cell align="left" valign="middle">float</cell> - <cell align="left" valign="middle">float</cell> - </row> - <row> - <cell align="left" valign="middle">double</cell> - <cell align="left" valign="middle">double</cell> - </row> - <row> - <cell align="left" valign="middle">short</cell> - <cell align="left" valign="middle">short</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned short</cell> - <cell align="left" valign="middle">short</cell> - </row> - <row> - <cell align="left" valign="middle">long</cell> - <cell align="left" valign="middle">int</cell> - </row> - <row> - <cell align="left" valign="middle">long long</cell> - <cell align="left" valign="middle">long</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned long</cell> - <cell align="left" valign="middle">long</cell> - </row> - <row> - <cell align="left" valign="middle">unsigned long long</cell> - <cell align="left" valign="middle">long</cell> - </row> - <row> - <cell align="left" valign="middle">char</cell> - <cell align="left" valign="middle">char</cell> - </row> - <row> - <cell align="left" valign="middle">wchar</cell> - <cell align="left" valign="middle">char</cell> - </row> - <row> - <cell align="left" valign="middle">boolean</cell> - <cell align="left" valign="middle">boolean</cell> - </row> - <row> - <cell align="left" valign="middle">octet</cell> - <cell align="left" valign="middle">octet</cell> - </row> - <row> - <cell align="left" valign="middle">string</cell> - <cell align="left" valign="middle">java.lang.String</cell> - </row> - <row> - <cell align="left" valign="middle">wstring</cell> - <cell align="left" valign="middle">java.lang.String</cell> - </row> - <row> - <cell align="left" valign="middle">any</cell> - <cell align="left" valign="middle">Any</cell> - </row> - <row> - <cell align="left" valign="middle">long double</cell> - <cell align="left" valign="middle">Not supported</cell> - </row> - <row> - <cell align="left" valign="middle">Object</cell> - <cell align="left" valign="middle">Not supported</cell> - </row> - <row> - <cell align="left" valign="middle">void</cell> - <cell align="left" valign="middle">void</cell> - </row> - <tcaption>OMG IDL basic types</tcaption> - </table> - </section> - - <section> - <title>Constructed OMG IDL Types</title> - <p>All constructed types are according to the standard with three (3) major exceptions.</p> - <p></p> - <list type="bulleted"> - <item> - <p>The IDL Exceptions are not implemented in this Java mapping.</p> - <p></p> - </item> - <item> - <p>The functions used for read/write to streams, defined in <c>Helper</c> functions - are named unmarshal (instead for read) and marshal (instead for write). </p> - <p></p> - </item> - <item> - <p>The streams used in <c>Helper</c> functions are <c>OtpInputStream</c> for - input and <c>OtpOutputStream</c> for output.</p> - <p></p> - </item> - </list> - </section> - - <section> - <title>Mapping for Constants</title> - <p>Constants are mapped according to the standard.</p> - </section> - - <section> - <title>Invocations of Operations</title> - <p>Operation invocation is implemented according to the standard. - The implementation is in the class <c><![CDATA[_<nterfacename>Stub.java]]></c> which implements - the interface in <c><![CDATA[<nterfacename>.java]]></c>.</p> - <code type="none"> -test._iStub client; - -client.op(10); - </code> - - <section> - <title>Operation Implementation</title> - <p>The server is implemented through extension of the class - <c><![CDATA[_<nterfacename>ImplBase.java]]></c> and implementation of all the methods in the - interface.</p> - <code type="none"> -public class server extends test._iImplBase { - - public void op(int i) throws java.lang.Exception { - System.out.println("Received call op()"); - o.value = i; - return i; - } - -} - </code> - </section> - </section> - - <section> - <title>Exceptions</title> - <p>While exception mapping is not implemented, the stubs will - generate some Java exceptions in case of operation failure. - No exceptions are propagated through the communication.</p> - </section> - - <section> - <title>Access to Attributes</title> - <p>Attributes are supported according to the standard.</p> - </section> - - <section> - <title>Summary of Argument/Result Passing for Java</title> - <p>All types (<c>in</c>, <c>out</c> or <c>inout</c>) of user defined parameters are supported - in the Java mapping. This is also the case in the Erlang mappings but <em>not</em> in the C - mapping. <c>inout</c> parameters are not supported in the C mapping so if you are going to - do calls to or from a C program <c>inout</c> cannot be used in the IDL specifications.</p> - <p><c>out</c> and <c>inout</c> parameters must be of Holder types. There is a jar file ( <c>ic.jar</c>) - with Holder classes for the basic types in the <c>ic</c> application. This library is in the directory - <c><![CDATA[$OTPROOT/lib/ic_<version number>/priv]]></c>.</p> - </section> - - <section> - <title>Communication Toolbox</title> - <p>The generated client and server stubs use the classes - defined in the <c>jinterface</c> package to communicate - with other nodes. - The most important classes are :</p> - <list type="bulleted"> - <item> - <p><c>OtpInputStream</c> which is the stream class used for incoming message storage</p> - <p></p> - </item> - <item> - <p><c>OtpOutputStream</c> which is the stream class used for outgoing message storage</p> - <p></p> - </item> - <item> - <p><c>OtpErlangPid</c> which is the process identification class used to identify processes inside - a java node.</p> - <p>The recommended constructor function for the OtpErlangPid is - <c>OtpErlangPid(String node, int id, int serial, int creation)</c> where :</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>String node</c>, is the name of the node where this process runs.</p> - <p></p> - </item> - <item> - <p><c>int id</c>, is the identification number for this identity.</p> - <p></p> - </item> - <item> - <p><c>int serial</c>, internal information, must be an 18-bit integer.</p> - <p></p> - </item> - <item> - <p><c>int creation</c>, internal information, must have value in range 0..3.</p> - <p></p> - </item> - </list> - </item> - <item> - <p><c>OtpConnection</c> which is used to define a connection between nodes.</p> - <p>While the connection object is stub side constructed in client stubs, it is - returned after calling the <c>accept</c> function from an OtpErlangServer object - in server stubs. - The following methods used for node connection :</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>OtpInputStream receiveBuf()</c>, which returns the incoming streams that - contain the message arrived.</p> - <p></p> - </item> - <item> - <p><c>void sendBuf(OtpErlangPid client, OtpOutputStream reply)</c>, which sends - a reply message (in an OtpOutputStream form) to the client node.</p> - <p></p> - </item> - <item> - <p><c>void close()</c>, which closes a connection.</p> - <p></p> - </item> - </list> - </item> - <item> - <p><c>OtpServer</c> which is used to define a server node.</p> - <p>The recommended constructor function for the OtpServer is :</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>OtpServer(String node, String cookie)</c>. where :</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>node</c> is the requested name for the new java node, - represented as a String object.</p> - <p></p> - </item> - <item> - <p><c>cookie</c> is the requested cookie name for the new java node, - represented as a String object.</p> - <p></p> - </item> - </list> - </item> - </list> - <p>The following methods used for node registration and connection acceptance :</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>boolean publishPort()</c>, which registers the server node to <c>epmd</c> daemon.</p> - <p></p> - </item> - <item> - <p><c>OtpConnection accept()</c>, which waits for a connection and returns the - OtpConnection object which is unique for each client node.</p> - <p></p> - </item> - </list> - </item> - </list> - </section> - - <section> - <title>The Package com.ericsson.otp.ic</title> - <p>The package <seealso marker="java/com/ericsson/otp/ic/package-summary">com.ericsson.otp.ic</seealso> - contains a number of java classes specially designed for the IC generated java-back-ends :</p> - <list type="bulleted"> - <item> - <p>Standard java classes defined through OMG-IDL java mapping :</p> - <list type="bulleted"> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/BooleanHolder">BooleanHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/ByteHolder">ByteHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/CharHolder">CharHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/ShortHolder">ShortHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/IntHolder">IntHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/LongHolder">LongHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/FloatHolder">FloatHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/DoubleHolder">DoubleHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/StringHolder">StringHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/Any">Any</seealso>, - <seealso marker="java/com/ericsson/otp/ic/AnyHelper">AnyHelper</seealso>, - <seealso marker="java/com/ericsson/otp/ic/AnyHolder">AnyHolder</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/TypeCode">TypeCode</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/TCKind">TCKind</seealso></p> - <p></p> - </item> - </list> - </item> - <item> - <p>Implementation-dependant classes :</p> - <list type="bulleted"> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/Environment">Environment</seealso></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/Holder">Holder</seealso></p> - <p></p> - </item> - </list> - </item> - <item> - <p>Erlang compatibility classes :</p> - <list type="bulleted"> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/Pid">Pid</seealso>, - <seealso marker="java/com/ericsson/otp/ic/PidHelper">PidHelper</seealso>, - <seealso marker="java/com/ericsson/otp/ic/PidHolder">PidHolder</seealso></p> - <p>The Pid class originates from <c>OtpErlangPid</c> and is used to - represent the Erlang built-in <c>pid</c> type, a process's identity. - PidHelper and PidHolder are helper respectively holder classes for Pid.</p> - <p></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/Ref">Ref</seealso>, - <seealso marker="java/com/ericsson/otp/ic/RefHelper">RefHelper</seealso>, - <seealso marker="java/com/ericsson/otp/ic/RefHolder">RefHolder</seealso></p> - <p>The Ref class originates from <c>OtpErlangRef</c> and is used to - represent the Erlang built-in <c>ref</c> type, an Erlang reference. - RefHelper and RefHolder are helper respectively holder classes for Ref.</p> - <p></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/Port">Port</seealso>, - <seealso marker="java/com/ericsson/otp/ic/PortHelper">PortHelper</seealso>, - <seealso marker="java/com/ericsson/otp/ic/PortHolder">PortHolder</seealso></p> - <p>The Port class originates from <c>OtpErlangPort</c> and is used to - represent the Erlang built-in <c>port</c> type, an Erlang port. - PortHelper and PortHolder are helper respectively holder classes for Port.</p> - <p></p> - </item> - <item> - <p><seealso marker="java/com/ericsson/otp/ic/Term">Term</seealso>, - <seealso marker="java/com/ericsson/otp/ic/TermHelper">TermHelper</seealso>, - <seealso marker="java/com/ericsson/otp/ic/TermHolder">TermHolder</seealso></p> - <p>The Term class originates from <c>Any</c> and is used to - represent the Erlang built-in <c>term</c> type, an Erlang term. - TermHelper and TermHolder are helper respectively holder classes for Term.</p> - <p></p> - </item> - </list> - <p>To use the Erlang build-in classes, you will have to include the file <c>erlang.idl</c> - located under <c>$OTPROOT/lib/ic/include</c>.</p> - </item> - </list> - </section> - - <section> - <title>The Term Class</title> - <p>The <c>Term</c> class is intended to represent the Erlang term generic type. - It extends the <c>Any</c> class and it is basically used in the same way as - in the Any type.</p> - <p>The big difference between Term and Any is the use of <c>guard</c> methods - instead of <c>TypeCode</c> to determine the data included in the Term. - This is especially true when the Term's value class cannot be - determined at compilation time. The guard methods found in Term :</p> - <list type="bulleted"> - <item> - <p><c>boolean isAtom()</c> returns <c>true</c> if the Term is an OtpErlangAtom, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isConstant()</c> returns <c>true</c> if the Term is neither an OtpErlangList nor an OtpErlangTuple, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isFloat()</c> returns <c>true</c> if the Term is an OtpErlangFloat, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isInteger()</c> returns <c>true</c> if the Term is an OtpErlangInt, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isList()</c> returns <c>true</c> if the Term is an OtpErlangList, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isString()</c> returns <c>true</c> if the Term is an OtpErlangString, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isNumber()</c> returns <c>true</c> if the Term is an OtpErlangInteger or an OtpErlangFloat, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isPid()</c> returns <c>true</c> if the Term is an OtpErlangPid or Pid, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isPort()</c> returns <c>true</c> if the Term is an OtpErlangPort or Port, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isReference()</c> returns <c>true</c> if the Term is an OtpErlangRef, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isTuple()</c> returns <c>true</c> if the Term is an OtpErlangTuple, <c>false</c> otherwise</p> - <p></p> - </item> - <item> - <p><c>boolean isBinary()</c> returns <c>true</c> if the Term is an OtpErlangBinary, <c>false</c> otherwise</p> - <p></p> - </item> - </list> - </section> - - <section> - <title>Stub File Types</title> - <p>For each interface, three (3) stub/skeleton files are generated :</p> - <list type="bulleted"> - <item> - <p>A java interface file, named after the idl interface.</p> - <p></p> - </item> - <item> - <p>A client stub file, named after the convention <c><![CDATA[_< interface name >Stub]]></c> - which implements the java interface. Example : <c>_stackStub</c>.java</p> - <p></p> - </item> - <item> - <p>A server stub file, named after the convention <c><![CDATA[_< interface name >ImplBase]]></c> - which implements the java interface. Example : <c>_stackImplBase</c>.java</p> - <p></p> - </item> - </list> - </section> - - <section> - <title>Client Stub Initialization, Methods Exported</title> - <p>The recommended constructor function for client stubs accepts four (4) parameters :</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>String selfNode</c>, the node identification name to be used in the new - client node.</p> - <p></p> - </item> - <item> - <p><c>String peerNode</c>, the node identification name where the client process is running.</p> - <p></p> - </item> - <item> - <p><c>String cookie</c>, the cookie to be used.</p> - <p></p> - </item> - <item> - <p><c>Object server</c>, where the java Object can be one of:</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>OtpErlangPid</c>, the server's process identity under the node where the server - process is running.</p> - <p></p> - </item> - <item> - <p><c>String</c>, the server's registered name under the node where the server - process is running.</p> - <p></p> - </item> - </list> - </item> - </list> - <p>The methods exported from the generated client stub are :</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>void __disconnect()</c>, which disconnects the server connection.</p> - <p></p> - </item> - <item> - <p><c>void __reconnect()</c>, which disconnects the server connection if open, - and then connects to the same peer.</p> - <p></p> - </item> - <item> - <p><c>void __stop()</c>, which sends the standard stop termination call. - When connected to an Erlang server, the server will be terminated. - When connected to a java server, this will set a stop flag that - denotes that the server must be terminated.</p> - <p></p> - </item> - <item> - <p><c>com.ericsson.otp.erlang.OtpErlangRef __getRef()</c>, will return the message reference - received from a server that denotes which call it is referring to. - This is useful when building asynchronous clients.</p> - <p></p> - </item> - <item> - <p><c>java.lang.Object __server()</c>, which returns the server for the current connection.</p> - <p></p> - </item> - </list> - </section> - - <section> - <title>Server Skeleton Initialization, Server Stub Implementation, Methods Exported</title> - <p>The constructor function for server skeleton accepts no parameters.</p> - <p>The server skeleton file contains a server <c>switch</c> which - decodes messages from the input stream and calls implementation - (<c>callback</c>) functions. - As the server skeleton is declared <c>abstract</c>, the application - programmer will have to create a stub class that <c>extends</c> the - skeleton file. In this class, all operations defined in the interface - class, generated under compiling the idl file, are implemented.</p> - <p>The server skeleton file exports the following methods:</p> - <p></p> - <list type="bulleted"> - <item> - <p><c>OtpOutputStrem invoke(OtpInputStream request)</c>, where the input - stream <c>request</c> is unmarshalled, the implementation function is called - and a reply stream is marshalled.</p> - <p></p> - </item> - <item> - <p><c>boolean __isStopped()</c>, which returns true if a stop message is received. - The implementation of the stub should always check if such a message is received - and terminate if so.</p> - <p></p> - </item> - <item> - <p><c>boolean __isStopped(com.ericsson.otp.ic.Environment)</c>, which returns true if - a stop message is received for a certain Environment and Connection. - The implementation of the stub should always check if such a message is received - and terminate if so.</p> - <p></p> - </item> - <item> - <p><c>OtpErlangPid __getCallerPid()</c>, which returns the caller identity for the latest call.</p> - <p></p> - </item> - <item> - <p><c>OtpErlangPid __getCallerPid(com.ericsson.otp.ic.Environment)</c>, which returns the caller - identity for the latest call on a certain Environment.</p> - <p></p> - </item> - <item> - <p><c>java.util.Dictionary __operations()</c>, which returns the operation dictionary which - holds all operations supported by the server skeleton.</p> - <p></p> - </item> - </list> - </section> - - <section> - <title>A Mapping Example</title> - <p> <marker id="stack_idl"></marker> - - This is a small example of a simple stack. There are two - operations on the stack, push and pop. The example shows some of the - generated files.</p> - <code type="none"> -// The source IDL file: stack.idl - -struct s { - long l; - string s; -}; - -interface stack { - void push(in s val); - s pop(); -}; - </code> - <p>When this file is compiled it produces eight files. Three important files - are shown below. <marker id="stack_serv"></marker> -</p> - <p>The public interface is in <em>stack.java</em>.</p> - <code type="none"> - -public interface stack { - -/**** - * Operation "stack::push" interface functions - * - */ - - void push(s val) throws java.lang.Exception; - -/**** - * Operation "stack::pop" interface functions - * - */ - - s pop() throws java.lang.Exception; - -} - </code> - <p>For the IDL struct s three files are generated, a public class in <em>s.java</em>.</p> - <code type="none"> - -final public class s { - // instance variables - public int l; - public java.lang.String s; - - // constructors - public s() {}; - public s(int _l, java.lang.String _s) { - l = _l; - s = _s; - }; - -}; - </code> - <p>A holder class in <em>sHolder.java</em> and a helper class in <em>sHelper.java</em>. - The helper class is used for marshalling.</p> - <code type="none"> - -public class sHelper { - - // constructors - private sHelper() {}; - - // methods - public static s unmarshal(OtpInputStream in) - throws java.lang.Exception { - : - : - }; - - public static void marshal(OtpOutputStream out, s value) - throws java.lang.Exception { - : - : - }; - -}; - </code> - </section> - - <section> - <title>Running the Compiled Code</title> - <p>When using the generated java code you must have added - <c><![CDATA[$OTPROOT/lib/ic_<version number>/priv]]></c> and - <c><![CDATA[$OTPROOT/lib/jinterface_<version number>/priv]]></c> to your - <c>CLASSPATH</c> variable to get - basic Holder types and the communication classes.</p> - </section> -</chapter> - diff --git a/lib/ic/doc/src/erl-part.xml b/lib/ic/doc/src/erl-part.xml deleted file mode 100644 index 9c9cb6a574..0000000000 --- a/lib/ic/doc/src/erl-part.xml +++ /dev/null @@ -1,37 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2002</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IDL to Erlang language Mapping</title> - <prepared></prepared> - <docno></docno> - <date>2002-06-25</date> - <rev>A</rev> - </header> - <description> - <p>Tjosan Erlang</p> - </description> - <include file="ch_erl_plain"></include> - <include file="ch_erl_genserv"></include> -</part> - diff --git a/lib/ic/doc/src/ic.xml b/lib/ic/doc/src/ic.xml deleted file mode 100644 index 98e8414a4e..0000000000 --- a/lib/ic/doc/src/ic.xml +++ /dev/null @@ -1,468 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1997</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>ic</title> - <prepared></prepared> - <docno></docno> - <checked></checked> - <date>2004-01-08</date> - <rev>B</rev> - </header> - <module>ic</module> - <modulesummary>The Erlang IDL Compiler</modulesummary> - <description> - <p>The ic module is an Erlang implementation of an OMG IDL - compiler. Depending on the choice of back-end the code will map - to Erlang, C, or Java. The compiler generates client stubs and - server skeletons.</p> - <p>Two kinds of files are generated for each scope: Ordinary code - files and header files. The latter are used for defining record - definitions, while the ordinary files contain the object - interface functions.</p> - </description> - <funcs> - <func> - <name>ic:gen(FileName) -> Result</name> - <name>ic:gen(FileName, [Option]) -> Result</name> - <fsummary>Generate stub and server code according to the OMG CORBA standard.</fsummary> - <type> - <v>Result = ok | error | {ok, [Warning]} | {error, [Warning], [Error]}</v> - <v></v> - <v>Option = [ GeneralOption | CodeOption | WarningOption | BackendOption]</v> - <v></v> - <v>GeneralOption = </v> - <v>{outdir, String()} | {cfgfile, String()} | {use_preproc, bool()} |</v> - <v>{preproc_cmd, String()} | {preproc_flags, String()}</v> - <v></v> - <v>CodeOption =</v> - <v>{gen_hrl, bool()} | {serv_last_call, exception | exit} | {{impl, String()}, String()} | {light_ifr, bool()}</v> - <v>this | {this, String()} | {{this, String()}, bool()} |</v> - <v>from | {from, String()} | {{from, String()}, bool()} |</v> - <v>handle_info | {handle_info, String()} | {{handle_info, String()}, bool()} |</v> - <v>timeout | {timeout, String()} | {{timeout, String()}, bool()} |</v> - <v>{scoped_op_calls, bool()} | {scl, bool()} |</v> - <v>{user_protocol, Prefix} |</v> - <v>{c_timeout, {SendTimeout, RecvTimeout}} |</v> - <v>{c_report, bool()} |</v> - <v>{precond, {atom(), atom()}} | {{precond, String()} {atom(), atom()}} |</v> - <v>{postcond, {atom(), atom()}} | {{postcond, String()} {atom(), atom()}}</v> - <v></v> - <v>WarningOption =</v> - <v>{'Wall', bool()} | {maxerrs, int() | infinity} |</v> - <v>{maxwarns, int() | infinity} | {nowarn, bool()} |</v> - <v>{warn_name_shadow, bool()} | {pedantic, bool()} |</v> - <v>{silent, bool()}</v> - <v></v> - <v>BackendOption = {be, Backend}</v> - <v></v> - <v>Backend = erl_corba | erl_template | erl_plain | erl_genserv | c_client | c_server | java</v> - <v></v> - <v>DirNAme = string() | atom()</v> - <v>FileName = string() | atom()</v> - </type> - <desc> - <p>The tuple <c>{Option, true}</c> can be replaced by - <c>Option</c> for boolean values.</p> - <p>The <c>ic:gen/2</c> function can be called from the command - line as follows:</p> - <p><c>erlc "+Option" ... File.idl</c></p> - <p>Example:</p> - <p><c>erlc "+{be,c_client}" '+{outdir, "../out"}' File.idl</c></p> - </desc> - </func> - </funcs> - - <section> - <title>General options</title> - <taglist> - <tag><em>outdir</em></tag> - <item> - <p>Places all output files in the directory given by the option. - The directory will be created if it does not already exist.</p> - <p>Example option: <c>{outdir, "output/generated"}</c>.</p> - </item> - <tag><em>cfgfile</em></tag> - <item> - <p>Uses <em>FileName</em> as configuration file. Options will - override compiler defaults but can be overridden by command line - options. Default value is <c>".ic_config"</c>.</p> - <p>Example option: <c>{cfgfile, "special.cfg"}</c>.</p> - </item> - <tag><em>use_preproc</em></tag> - <item> - <p>Uses a preprocessor. Default value is true.</p> - </item> - <tag><em>preproc_cmd</em></tag> - <item> - <p>Command string to invoke the preprocessor. The actual - command will be built as - <c>preproc_cmd++preproc_flags++FileName</c></p> - <p>Example option: <c>{preproc_cmd, "erl"})</c>.</p> - <p>Example option: <c>{preproc_cmd, "gcc -x c++ -E"}</c>.</p> - </item> - <tag><em>preproc_flags</em></tag> - <item> - <p>Flags given to the preprocessor.</p> - <p>Example option: <c>{preproc_flags, "-I../include"}</c>.</p> - </item> - </taglist> - </section> - - <section> - <title>Code options</title> - <taglist> - <tag><em>light_ifr</em></tag> - <item> - <p>Currently, the default setting is <c>false</c>. To be able to - use this option Orber must be configured to use Light IFR (see - Orber's User's Guide). When this options is used, the size of the - generated files used to register the API in the IFR DB are minimized.</p> - <p>Example option: <c>{light_ifr, true}</c>.</p> - </item> - <tag><em>gen_hrl</em></tag> - <item> - <p>Generate header files. Default is true.</p> - </item> - <tag><em>serv_last_call</em></tag> - <item> - <p>Makes the last <c>gen_server handle_call</c> either raise a - CORBA exception or just exit plainly. Default is the exception. - </p> - </item> - <tag><em>{{impl, IntfName}, ModName}</em></tag> - <item> - <p>Assumes that the interface with name <em>IntfName</em> is - implemented by the module with name <em>ModName</em> and - will generate calls to the <em>ModName</em> module in the - server behavior. Note that the <em>IntfName</em> must be a - fully scoped name as in <c>"M1::I1"</c>.</p> - <p></p> - </item> - <tag><em>this</em></tag> - <item> - <p>Adds the object reference as the first parameter to the - object implementation functions. This makes the - implementation aware of its own object reference. - <br></br> -The option - comes in three varieties: <c>this</c> which activates the - parameter for all interfaces in the source file, <c>{this, IntfName}</c> which activates the parameter for a specified - interface and <c>{{this, IntfName}, false}</c> which - deactivates the parameter for a specified - interface.</p> - <p>Example option: <c>this)</c> activates the parameter for - all interfaces.</p> - <p>Example option: <c>{this, "M1::I1"}</c> activates the - parameter for all functions of <c>M1::I1</c>.</p> - <p>Example options: <c>[this, {{this, "M1::I2"}, false}]</c> - activates the parameter for all interfaces except - <c>M1::I2</c>.</p> - </item> - <tag><em>from</em></tag> - <item> - <p>Adds the invokers reference as the first parameter to the - object implementation two-way functions. If both - <c>from</c> and <c>this</c> options are used the invokers - reference parameter will be passed as the second - parameter. This makes it possible for the implementation to - respond to a request and continue executing - afterwards. Consult the <c>gen_server</c> and <c>Orber</c> - documentation how this option may be used. <br></br> -The option - comes in three varieties: <c>from</c> which activates the - parameter for all interfaces in the source file, <c>{from, IntfName}</c> which activates the parameter for a specified - interface and <c>{{from, IntfName}, false}</c> which - deactivates the parameter for a specified interface.</p> - <p>Example option: <c>from)</c> activates the parameter for - all interfaces.</p> - <p>Example options: <c>[{from, "M1::I1"}]</c> activates the - parameter for all functions of <c>M1::I1</c>.</p> - <p>Example options: <c>[from, {{from, "M1::I2"}, false}]</c> - activates the parameter for all interfaces except - <c>M1::I2</c>.</p> - </item> - <tag><em>handle_info</em></tag> - <item> - <p>Makes the object server call a function <c>handle_info</c> - in the object implementation module on all unexpected - messages. Useful if the object implementation need to trap - exits.</p> - <p>Example option: <c>handle_info</c> will activates module - implementation <c>handle_info</c> for all interfaces in the - source file.</p> - <p>Example option: <c>{{handle_info, "M1::I1"}, true}</c> - will activates module implementation <c>handle_info</c> for - the specified interface.</p> - <p>Example options: <c>[handle_info, {{handle_info, "M1::I1"}, false}]</c> will generate the <c>handle_info</c> - call for all interfaces except <c>M1::I1</c>.</p> - </item> - <tag><em>timeout</em></tag> - <item> - <p>Used to allow a server response time limit to be set by the user. - This should be a string that represents the scope for the interface - which should have an extra variable for wait time initialization.</p> - <p>Example option: <c>{timeout,"M::I"})</c> produces server - stub which will has an extra timeout parameter in the initialization - function for that interface.</p> - <p>Example option: <c>timeout</c> produces server - stub which will has an extra timeout parameter in the initialization - function for all interfaces in the source file.</p> - <p>Example options: <c>[timeout, {{timeout,"M::I"}, false}]</c> - produces server stub which will has an extra timeout - parameter in the initialization function for all interfaces - except <c>M1::I1</c>.</p> - </item> - <tag><em>scoped_op_calls</em></tag> - <item> - <p>Used to produce more refined request calls to server. When - this option is set to true, the operation name which was - mentioned in the call is scoped. This is essential to avoid - name clashes when communicating with c-servers. This option - is available for the c-client, c-server and the Erlang - gen_server back ends. <c>All</c> of the parts generated by ic - have to agree in the use of this option. Default is - <c>false</c>. </p> - <p>Example options: - <c>[{be,c_genserv},{scoped_op_calls,true}])</c> produces - client stubs which sends "scoped" requests to a gen_server - or a c-server.</p> - </item> - <tag><em>user_protocol</em></tag> - <item> - <p>Used to define a own protocol different from the default - Erlang distribution + gen_server protocol. Currently only - valid for C back-ends. For further details see <seealso marker="ic_c_protocol">IC C protocol</seealso>.</p> - <p>Example options: - <c>[{be,c_client},{user_protocol, "my_special"}])</c> produces - client stubs which use C protocol functions with the prefix - "my_special".</p> - </item> - <tag><em>c_timeout</em></tag> - <item> - <p>Makes sends and receives to have timeouts (C back-ends only). These - timeouts are specified in milliseconds. </p> - <p>Example options: - <c>[{be,c_client},{c_timeout, {10000, 20000}}])</c> produces - client stubs which use a 10 seconds send timeout, and a - 20 seconds receive timeout.</p> - </item> - <tag><em>c_report</em></tag> - <item> - <p>Generates code for writing encode/decode errors to <c>stderr</c> (C back-ends only). - timeouts are specified in milliseconds. </p> - <p>Example options: - <c>[{be,c_client}, c_report])</c>.</p> - </item> - <tag><em>scl</em></tag> - <item> - <p>Used for compatibility with previous compiler versions up - to <c>3.3</c>. Due to better semantic checks on enumerants, - the compiler discovers name clashes between user defined - types and enumerant values in the same name space. By - enabling this option the compiler turns off the extended - semantic check on enumerant values. Default is - <c>false</c>. </p> - <p>Example option: <c>{scl,true}</c></p> - </item> - <tag><em>precond</em></tag> - <item> - <p>Adds a precondition call before the call to the operation - implementation on the server side.</p> - <p>The option comes in three varieties: <c>{precond, {M, F}}</c> which activates the call for operations in all - interfaces in the source file, <c>{{precond, IntfName}, {M, F}}</c> which activates the call for all operations in a - specific interface and <c>{{precond, OpName}, {M, F}}</c> - which activates the call for a specific operation.</p> - <p>The precondition function has the following signature - <c>m:f(Module, Function, Args)</c>.</p> - <p>Example option: <c>{precond, {mod, fun}}</c> adds the call - of m:f for all operations in the idl file.</p> - <p>Example options: <c>[{{precond, "M1::I"}, {mod, fun}}]</c> - adds the call of <c>m:f</c> for all operations in the - interface <c>M1::I1</c>.</p> - <p>Example options: <c>[{{precond, "M1::I::Op"}, {mod, fun}}]</c> adds the call of <c>m:f</c> for the operation - <c>M1::I::Op</c>.</p> - </item> - <tag><em>postcond</em></tag> - <item> - <p>Adds a postcondition call after the call to the operation - implementation on the server side. </p> - <p>The option comes in three varieties: <c>{postcond, {M, F}}</c> which activates the call for operations in all - interfaces in the source file, <c>{{postcond, IntfName}, {M, F}}</c> which activates the call for all operations in a - specific interface and <c>{{postcond, OpName}, {M, F}}</c> - which activates the call for a specific operation.</p> - <p>The postcondition function has the following signature - <c>m:f(Module, Function, Args, Result)</c>.</p> - <p>Example option: <c>{postcond, {mod, fun}}</c> adds the call - of m:f for all operations in the idl file.</p> - <p>Example options: <c>[{{postcond, "M1::I"}, {mod, fun}}]</c> - adds the call of <c>m:f</c> for all operations in the - interface <c>M1::I1</c>.</p> - <p>Example options: <c>[{{postcond, "M1::I::Op"}, {mod, fun}}]</c> adds the call of <c>m:f</c> for the operation - <c>M1::I::Op</c>.</p> - </item> - </taglist> - </section> - - <section> - <title>Warning options</title> - <taglist> - <tag><em>'Wall'</em></tag> - <item> - <p>The option activates all reasonable warning messages in - analogy with the gcc -Wall option. Default value is true.</p> - </item> - <tag><em>maxerrs</em></tag> - <item> - <p>The maximum numbers of errors that can be detected before - the compiler gives up. The option can either have an integer - value or the atom <c>infinity</c>. Default number is 10.</p> - </item> - <tag><em>maxwarns</em></tag> - <item> - <p>The maximum numbers of warnings that can be detected before - the compiler gives up. The option can either have an integer - value or the atom <c>infinity</c>. Default value is - infinity.</p> - </item> - <tag><em>nowarn</em></tag> - <item> - <p>Suppresses all warnings. Default value is false.</p> - </item> - <tag><em>warn_name_shadow</em></tag> - <item> - <p>Warning appears whenever names are shadowed due to - inheritance; for example, if a type name is redefined from a - base interface. Note that it is illegal to overload - operation and attribute names as this causes an error to be - produced. Default value is true. </p> - </item> - <tag><em>pedantic</em></tag> - <item> - <p>Activates all warning options. Default value is false.</p> - </item> - <tag><em>silent</em></tag> - <item> - <p>Suppresses compiler printed output. Default value is false.</p> - </item> - </taglist> - </section> - - <section> - <title>Back-End options</title> - <p>Which back-end IC will generate code for is determined by the supplied - <c>{be,atom()}</c> option. If left out, <c>erl_corba</c> is used. - Currently, IC support the following back-ends:</p> - <taglist> - <tag><em>erl_corba</em></tag> - <item> - <p>This option switches to the IDL generation for CORBA.</p> - </item> - <tag><em>erl_template</em></tag> - <item> - <p>Generate CORBA call-back module templates for each interface in the target - IDL file. Note, will overwrite existing files.</p> - </item> - <tag><em>erl_plain</em></tag> - <item> - <p>Will produce plain Erlang modules which contain functions that - map to the corresponding interface functions on the input file.</p> - </item> - <tag><em>erl_genserv</em></tag> - <item> - <p>This is an IDL to Erlang generic server generation option.</p> - </item> - <tag><em>c_client</em></tag> - <item> - <p>Will produce a C client to the generic Erlang server.</p> - </item> - <tag><em>c_server</em></tag> - <item> - <p>Will produce a C server switch with functionality of a - generic Erlang server.</p> - </item> - <tag><em>java</em></tag> - <item> - <p>Will produce Java client stubs and server skeletons with - functionality of a generic Erlang server.</p> - </item> - <tag><em>c_genserv</em></tag> - <item> - <p>Deprecated. Use <c>c_client</c> instead.</p> - </item> - </taglist> - </section> - - <section> - <title>Preprocessor</title> - <p>The IDL compiler allows several preprocessors to be used, the - <c>Erlang IDL preprocessor</c> or other standard <c>C</c> preprocessors. - Options can be used to provide extra flags such as include - directories to the preprocessor. The build in the Erlang IDL - preprocessor is used by default, but any standard C preprocessor - such as <c>gcc</c> is adequate.</p> - <p>The preprocessor command is formed by appending the prepoc_cmd - to the preproc_flags option and then appending the input IDL - file name.</p> - </section> - - <section> - <title>Configuration</title> - <p>The compiler can be configured in two ways:</p> - <list type="ordered"> - <item> - <p>Configuration file</p> - </item> - <item> - <p>Command line options</p> - </item> - </list> - <p>The configuration file is optional and overrides the compiler - defaults and is in turn overridden by the command line options. - The configuration file shall contain options in the form of - Erlang terms. The configuration file is read using - <c>file:consult</c>.</p> - <p>An example of a configuration file, note the "." after each - line.</p> - <code type="none"> -{outdir, gen_dir}. -{{impl, "M1::M2::object"}, "obj"}. - </code> - </section> - - <section> - <title>Output files</title> - <p>The compiler will produce output in several files depending on - scope declarations found in the IDL file. At most - three file types will be generated for each scope (including the top scope), - depending on the compiler back-end and the compiled interface. - Generally, the output per interface will be a header file (<c>.hrl</c>/ - <c>.h</c>) and one or more Erlang/C files (<c>.erl</c>/<c>.c</c>). - Please look at the language mapping for each back-end for details.</p> - <p>There will be at least one set of files for an IDL file, for the - file level scope. Modules and interfaces also have their own set - of generated files.</p> - </section> - -</erlref> - diff --git a/lib/ic/doc/src/ic_c_protocol.xml b/lib/ic/doc/src/ic_c_protocol.xml deleted file mode 100644 index ed4f21d661..0000000000 --- a/lib/ic/doc/src/ic_c_protocol.xml +++ /dev/null @@ -1,157 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>2004</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IC C Protocol Functions</title> - <prepared></prepared> - <docno></docno> - <date>2004-04-06</date> - <rev>A</rev> - </header> - <lib>ic_c_protocol</lib> - <libsummary>IC C Protocol Functions</libsummary> - <description> - <p>This manual page lists some of the functions of the IC C runtime - library that are used internally for the IC protocol. - </p> - <p>The listed functions are used internally by generated C client - and server code. They are documented here for <em>the advanced user</em> that want to replace the default protocol (Erlang - distribution + gen_server) by his own protocol, For each set of - client or sever functions below with prefix <c>oe</c>, the user - has to implement his own set of functions, the names of which - are obtained by replacing the <c>oe</c> prefix by <c>Prefix</c>. - The <c>Prefix</c> has to be set with the option - <c>{user_protocol, Prefix}</c> at compile time.</p> - <p>The following terminology is used (reflected in names of - functions): a <em>notification</em> is a message send from - client to server, without any reply back (i.e. a - <em>oneway</em> operation); a <em>request</em> is a message sent - from client to server, and where a <em>reply</em> message is - sent back from the server to the client.</p> - <p>In order to understand how the functions work and what they do - the user <em>must</em> study their implementation in the IC C - library (source file is <c>ic.c</c>), and also consider how they - are used in the C code of ordinary generated client stubs or - server skeletons.</p> - <p></p> - </description> - - <section> - <title>Client Protocol Functions</title> - <p>The following functions are used internally by generated C - client code.</p> - </section> - <funcs> - <func> - <name><ret>int</ret><nametext>oe_prepare_notification_encoding(CORBA_Environment *env)</nametext></name> - <fsummary>Prepare client notification encoding.</fsummary> - <desc> - <p>The result of this function is the beginning of a binary of - in external format of the tuple <c>{'$gen_cast', X}</c> where - <c>X</c> is not yet filled in. </p> - <p>In generated client code this function is the first to be called - in the encoding function for each oneway operation.</p> - </desc> - </func> - <func> - <name><ret>int</ret><nametext>oe_send_notification(CORBA_Environment *env)</nametext></name> - <name><ret>int</ret><nametext>oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms)</nametext></name> - <fsummary>Send client notification.</fsummary> - <desc> - <p>Sends a client notification to a server according to the - Erlang distribution + gen_server protocol.</p> - <p>The <c>send_ms</c> parameter specified a timeout in milliseconds.</p> - </desc> - </func> - <func> - <name><ret>int</ret><nametext>oe_prepare_request_encoding(CORBA_Environment *env)</nametext></name> - <fsummary>Prepare client request encoding.</fsummary> - <desc> - <p>The result of this function is the beginning of a binary in - the external format of the tuple <c>{'$gen_call', {Pid, Ref}, X}</c> where <c>X</c> is not yet filled in.</p> - <p>In generated client code this function is the first to be called - in the encoding function for each twoway operation.</p> - </desc> - </func> - <func> - <name><ret>int</ret><nametext>oe_send_request_and_receive_reply(CORBA_Environment *env)</nametext></name> - <name><ret>int</ret><nametext>oe_send_request_and_receive_reply_tmo(CORBA_Environment *env, unsigned int send_ms, unsigned int recv_ms)</nametext></name> - <fsummary>Send client request and receive reply.</fsummary> - <desc> - <p>Sends a client request and receives the reply according to - the Erlang distribution + gen_server protocol. This function - calls the <c>oe_prepare_reply_decoding</c> function in order - to obtain the gen_server reply. - </p> - <p><c>send_ms</c> and <c>recv_ms</c> specify timeouts for send - and receive, respectively, in milliseconds.</p> - </desc> - </func> - <func> - <name><ret>int</ret><nametext>oe_prepare_reply_decoding(CORBA_Environment *env)</nametext></name> - <fsummary>Prepare client decoding of reply.</fsummary> - <desc> - <p>Decodes the binary version of the tuple <c>{Ref, X}</c>, - where <c>X</c> is to be decoded later by the specific client - decoding function.</p> - </desc> - </func> - </funcs> - - <section> - <title>Server Protocol Functions</title> - <p>The following functions are used internally by generated C - server code.</p> - </section> - <funcs> - <func> - <name><ret>int</ret><nametext>oe_prepare_request_decoding(CORBA_Environment *env)</nametext></name> - <fsummary>Prepare server decoding of request.</fsummary> - <desc> - <p>Decodes the binary version of the tuple <c>{'$gen_cast', Op}</c> (<c>Op</c> an atom), or the tuple <c>{'$gen_cast', {Op, X}}</c>, where <c>Op</c> is the operation name, and - where <c>X</c> is to be decoded later by the specific - operation decoding function; or</p> - <p>decodes the binary version of the tuple <c>{'$gen_call', {Pid, Ref}, Op}</c> (<c>Op</c> an atom), or the tuple - <c>{'$gen_call', {Pid, Ref}, {Op, X}}</c>, where <c>Op></c> - is the operation name, and <c>X</c> is to be decode later by - the specific operation decoding function.</p> - </desc> - </func> - <func> - <name><ret>int</ret><nametext>oe_prepare_reply_encoding(CORBA_Environment *env)</nametext></name> - <fsummary>Prepare server encoding of reply.</fsummary> - <desc> - <p>Encodes the beginning of the binary version of the tuple - <c>{{Ref,X}</c>, where <c>X</c> is to be filled in by the - specific server encoding function.</p> - </desc> - </func> - </funcs> - - <section> - <title>SEE ALSO</title> - <p>ic(3), ic_clib(3), <seealso marker="ch_ic_protocol">IC Protocol</seealso></p> - </section> - -</cref> - diff --git a/lib/ic/doc/src/ic_clib.xml b/lib/ic/doc/src/ic_clib.xml deleted file mode 100644 index 50b20d2ca8..0000000000 --- a/lib/ic/doc/src/ic_clib.xml +++ /dev/null @@ -1,247 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE cref SYSTEM "cref.dtd"> - -<cref> - <header> - <copyright> - <year>2003</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IC C Library Functions</title> - <prepared></prepared> - <docno></docno> - <date>2003-12-16</date> - <rev>PB1</rev> - </header> - <lib>ic_clib</lib> - <libsummary>IC C Library Functions</libsummary> - <description> - <p>This manual page lists some of the functions in the IC C runtime - library. </p> - </description> - - <section> - <title>Allocation and Deallocation Functions</title> - <p>The following functions are used for allocating and - deallocating a <em>CORBA_Environment</em> structure.</p> - </section> - <funcs> - <func> - <name><ret>CORBA_Environment *</ret><nametext>CORBA_Environment_alloc(int inbufsz, int outbufsz)</nametext></name> - <fsummary>Allocate environment data.</fsummary> - <desc> - <p>This function is used to allocate and initiate the - <c>CORBA_Environment</c> structure. In particular, it is used - to dynamically allocate a CORBA_Environment structure and set - the default values for the structure's fields.</p> - <p><em>inbufsize</em> is the initial size of the input - buffer.</p> - <p><em>outbufsize</em> is the initial size of the output - buffer.</p> - <p><em>CORBA_Environment</em> is the CORBA 2.0 state structure - used by the generated stub.</p> - <p>This function will set all needed default values and - allocate buffers the lengths of which are equal to the - values passed, but will not allocate space for the _to_pid - and _from_pid fields.</p> - <p>To free the space allocated by CORBA_Environment_alloc() do - as follows.</p> - <list type="bulleted"> - <item> - <p>First call CORBA_free for the input and output buffers.</p> - </item> - <item> - <p>After freeing the buffer space, call CORBA_free for the - CORBA_Environment space.</p> - </item> - </list> - </desc> - </func> - <func> - <name><ret>void</ret><nametext>CORBA_free(void *p)</nametext></name> - <fsummary>Free any allocated data.</fsummary> - <desc> - <p>Frees allocated space pointed to by <c>p</c>.</p> - </desc> - </func> - <func> - <name><ret>CORBA_char *</ret><nametext>CORBA_string_alloc(CORBA_unsigned_long len)</nametext></name> - <fsummary>Allocate a string.</fsummary> - <desc> - <p>Allocates a (simple) CORBA character string of length <c>len + 1</c>.</p> - </desc> - </func> - <func> - <name><ret>CORBA_wchar *</ret><nametext>CORBA_wstring_alloc(CORBA_unsigned_long len)</nametext></name> - <fsummary>Allocate a wide string.</fsummary> - <desc> - <p>Allocates a CORBA wide string of length <c>len + 1</c>.</p> - </desc> - </func> - </funcs> - - <section> - <title>Exception Functions</title> - <p>Functions for retrieving exception ids and values, and for setting - exceptions. </p> - </section> - <funcs> - <func> - <name><ret>CORBA_char *</ret><nametext>CORBA_exception_id(CORBA_Environment *env)</nametext></name> - <fsummary>Get exception identity.</fsummary> - <desc> - <p>Returns the exception identity if an exception is set, otherwise - it returns <c>NULL</c>.</p> - </desc> - </func> - <func> - <name><ret>void *</ret><nametext>CORBA_exception_value(CORBA_Environment *env)</nametext></name> - <fsummary>Get exception value.</fsummary> - <desc> - <p>Returns the exception value, if an exception is set, otherwise - it returns <c>NULL</c>.</p> - </desc> - </func> - <func> - <name><ret>void</ret><nametext>CORBA_exc_set(CORBA_Environment *env, CORBA_exception_type Major, CORBA_char *Id, CORBA_char *Value)</nametext></name> - <fsummary>Set exception.</fsummary> - <desc> - <p>Sets the exception type, exception identity, and exception value - in the environment pointed to by <c>env</c>.</p> - </desc> - </func> - </funcs> - - <section> - <title>Server Reception</title> - <p>The following function is provided for convenience. </p> - </section> - <funcs> - <func> - <name><ret>int</ret><nametext>oe_server_receive(CORBA_Environment *env, oe_map_t *map)</nametext></name> - <name><ret>int</ret><nametext>oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, unsigned int send_ms, unsigned int recv_ms)</nametext></name> - <fsummary>Server receive of notification or request, and sending of reply (in case of request).</fsummary> - <desc> - <p>Provides a loop that receives one message, executes the - operation in question, and in case of a two-way operation - sends a reply.</p> - <p><c>send_ms</c> and <c>recv_ms</c> specify timeout values - in milliseconds for send and receive, respectively.</p> - </desc> - </func> - </funcs> - - <section> - <title>Generic Execution Switch and Map Merging</title> - <p>Function for searching for server operation function, and for - calling it if found. Function for merging maps (see the include - file <c>ic.h</c> for definitions). </p> - </section> - <funcs> - <func> - <name><ret>int</ret><nametext>oe_exec_switch(CORBA_Object obj, CORBA_Environment *env, oe_map_t *map)</nametext></name> - <fsummary>Search for server operation and execute it.</fsummary> - <desc> - <p>Search for server operation and execute it.</p> - </desc> - </func> - <func> - <name><ret>oe_map_t *</ret><nametext>oe_merge_maps(oe_map_t *maps, int size)</nametext></name> - <fsummary>Merge an array of server maps to one single map.</fsummary> - <desc> - <p>Merge an array of server maps to one single map.</p> - </desc> - </func> - </funcs> - - <section> - <title>The CORBA_Environment structure</title> - <p>Here is the complete definition of the CORBA_Environment structure, - defined in file <em>ic.h</em>: </p> - <code type="none"> - /* Environment definition */ - typedef struct { - - /*----- CORBA compatibility part ------------------------*/ - /* Exception tag, initially set to CORBA_NO_EXCEPTION ---*/ - CORBA_exception_type _major; - - /*----- External Implementation part - initiated by the user ---*/ - /* File descriptor */ - int _fd; - /* Size of input buffer */ - int _inbufsz; - /* Pointer to always dynamically allocated buffer for input */ - char *_inbuf; - /* Size of output buffer */ - int _outbufsz; - /* Pointer to always dynamically allocated buffer for output */ - char *_outbuf; - /* Size of memory chunks in bytes, used for increasing the output - buffer, set to >= 32, should be around >= 1024 for performance - reasons */ - int _memchunk; - /* Pointer for registered name */ - char _regname[256]; - /* Process identity for caller */ - erlang_pid *_to_pid; - /* Process identity for callee */ - erlang_pid *_from_pid; - - /*- Internal Implementation part - used by the server/client ---*/ - /* Index for input buffer */ - int _iin; - /* Index for output buffer */ - int _iout; - /* Pointer for operation name */ - char _operation[256]; - /* Used to count parameters */ - int _received; - /* Used to identify the caller */ - erlang_pid _caller; - /* Used to identify the call */ - erlang_ref _unique; - /* Exception id field */ - CORBA_char *_exc_id; - /* Exception value field */ - void *_exc_value; - - - } CORBA_Environment; - </code> - <note> - <p>Always set the field values <em>_fd</em>, <em>_regname</em>, - <em>_to_pid</em> and/or <em>*_from_pid</em> to appropriate - application values. These are not automatically set by the - stubs.</p> - </note> - <warning> - <p>Never assign static buffers to the buffer pointers, and never - set the <em>_memchunk</em> field to a value less than - <em>32</em>.</p> - </warning> - </section> - - <section> - <title>SEE ALSO</title> - <p>ic(3), ic_c_protocol(3) - </p> - </section> - -</cref> - diff --git a/lib/ic/doc/src/java-part.xml b/lib/ic/doc/src/java-part.xml deleted file mode 100644 index 14b58a1df5..0000000000 --- a/lib/ic/doc/src/java-part.xml +++ /dev/null @@ -1,36 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part> - <header> - <copyright> - <year>2002</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IDL to Java language Mapping</title> - <prepared></prepared> - <docno></docno> - <date>2002-06-25</date> - <rev>A</rev> - </header> - <description> - <p></p> - </description> - <include file="ch_java"></include> -</part> - diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml deleted file mode 100644 index 38cc77ca98..0000000000 --- a/lib/ic/doc/src/notes.xml +++ /dev/null @@ -1,806 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IDL Compiler Release Notes</title> - <prepared></prepared> - <docno></docno> - <checked></checked> - <date>2004-04-06</date> - <rev>AC</rev> - <file>notes.xml</file> - </header> - - <section><title>IC 4.4.4</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Optimize encoding/decoding for pure 7-bit ascii atoms.</p> - <p> - Own Id: OTP-15023 Aux Id: ERIERL-150 </p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.4.3</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> Removed all old unused files in the documentation. - </p> - <p> - Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.4.2</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> Correct bugs when path to mib or idl spec files - contains UTF-8 characters. </p> - <p> - Own Id: OTP-13718 Aux Id: ERL-179 </p> - </item> - <item> - <p> - Update build scripts to not make assumtions about where - env, cp and perl are located.</p> - <p> - Own Id: OTP-13800</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.4.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Internal changes</p> - <p> - Own Id: OTP-13551</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.4</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Change license text from Erlang Public License to Apache - Public License v2</p> - <p> - Own Id: OTP-12845</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.3.6</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fix compiler warnings reported by LLVM</p> - <p> - Own Id: OTP-12138</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.3.5</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> Added Latin-1 code directive in the generated files - to keep old behaviour. Updated IC so it can handle - Unicode characters in the path. </p> - <p> - Own Id: OTP-11783</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.3.4</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fix two small silent rules omissions. Thanks to Anthony - Ramine.</p> - <p> - Own Id: OTP-11351</p> - </item> - <item> - <p> - Silence warnings (Thanks to Anthony Ramine)</p> - <p> - Own Id: OTP-11517</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.3.3</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Header and library files from ic and erl_interface are - now installed into usr/{include,lib}. Note that these - directories are unversioned, so the latest installed - version will be the one in the directory.</p> - <p> - Own Id: OTP-11284</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.3.2</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fixed some compilation warnings on miscellaneous - platforms. Thanks to Anthony Ramine.</p> - <p> - Own Id: OTP-11086</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.3.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Revert the structs <c>erlang_pid</c>, <c>erlang_port</c> - and <c>erlang_ref</c> as they were before R16A (without - <c>node_org_enc</c>) in order to be backward compatible - with user code that accesses the fields of these structs.</p> - <p> - Own Id: OTP-10885 Aux Id: seq12256 </p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.3</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Misc build updates</p> - <p> - Own Id: OTP-10784</p> - </item> - <item> - <p> - Adapt ic for changes in erl_interface and jinterface due - to utf8 atom support. This change makes ic dependent on - erl_interface-3.7.10 (R16) or later in order to build.</p> - <p> - Own Id: OTP-10785</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.2.31</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fix bug where the ic pre-processor would ignore - whitespace quoting.</p> - <p> - Own Id: OTP-10109</p> - </item> - <item> - <p> A bug regarding spaces in C function prototypes has - been fixed. (Thanks to Richard O'Keefe.) </p> - <p> - Own Id: OTP-10138</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.2.30</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Add generation of Erlang callback functions to generated - Erlang source code to avoid compiler warnings.</p> - <p> - Own Id: OTP-9998</p> - </item> - </list> - </section> - -</section> - -<section><title>IC 4.2.29</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p>Erlang/OTP can now be built using parallel make if you - limit the number of jobs, for instance using '<c>make - -j6</c>' or '<c>make -j10</c>'. '<c>make -j</c>' does not - work at the moment because of some missing - dependencies.</p> - <p> - Own Id: OTP-9451</p> - </item> - </list> - </section> - -</section> - -<section> - <title>IC 4.2.28</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p> - Incorrect use of ets:match changed to ets:match_object.</p> - <p> - Own Id: OTP-9630 </p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.27</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p> - Reduced compile overhead (Thanks to Haitao Li).</p> - <p> - Own Id: OTP-9460 </p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.26</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p> - Partial support for recursive structs and unions. Only available - for the erl_corba backend and requires that Light IFR is used. - I.e. the IC option {light_ifr, true} and that Orber is configured - in such a way that Light IFR is activated. Recursive TypeCode is - currently not supported.</p> - <p> - Own Id: OTP-8868 Aux Id: seq11633</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.25</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p> - The documentation can now be built and installed without Java.</p> - <p> - Own Id: OTP-8639 Aux Id:</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.24</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>Removed superfluous VT in the documentation.</p> - <p>Own id: OTP-8353 Aux Id:</p> - </item> - <item> - <p>The option c_timeout was not correctly documented.</p> - <p>Own id: OTP-8307 Aux Id: seq11390</p> - </item> - <item> - <p>Removed superfluous backslash in the documentation.</p> - <p>Own id: OTP-8354 Aux Id:</p> - </item> - <item> - <p>The documentation EIX file was not generated.</p> - <p>Own id: OTP-8355 Aux Id:</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.23</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p> - The documentation is now built with open source tools (xsltproc and fop) - that exists on most platforms. One visible change is that the frames are removed.</p> - <p> - Own Id: OTP-8201 Aux Id:</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.22</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>The 64-bit version of libic was not compiled with the -fPIC flag.</p> - <p>Own id: OTP-8088</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.21</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>The function print_erlang_binary (oe_ei_code_erlang_binary.c) - updated to avoid compiler warning.</p> - <p>Own id: OTP-7982</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.20</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Updated file headers.</p> - <p>Own id: OTP-7837</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.19</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Documentation source included in open source releases.</p> - <p>Own id: OTP-7595</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.18</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>Insufficient buffer allocated when passing wide strings - using the C backend on a 64-bit architecture.</p> - <p>Own Id: OTP-7313 Aux Id:</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.17</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Updated file headers.</p> - <p>Own id: OTP-7011</p> - </item> - <item> - <p>IC no longer use the obsolete function file:rawopen/2.</p> - <p>Own id: OTP-7182</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.16</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Added links to classes inherited from Jinterface in the - User's Guide.</p> - <p>Own Id: OTP-6965 Aux Id: </p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.15</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>If an inherited function name begun with a capital letter - the generated stub/skeleton oe_tc/1 function was incorrect.</p> - <p>Own Id: OTP-6855 Aux Id:</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.14</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>The documentation source has been converted from SGML to XML.</p> - <p>Own Id: OTP-6754 Aux Id: </p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.13</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Minor Makefile changes.</p> - <p>Own Id: OTP-6701 Aux Id: </p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.12</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Dead code was deleted from the following modules: - ic_cclient, ic_code, ic_cserver, ic_erlbe, ic_java_type, - ic_noc, ic_plainbe, ic_pp, ic_pragma, icscan, icstruct, - ictype, icunion.</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.11</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Changed code generation to avoid warnings such as unused - variables.</p> - <p>Own Id: OTP-5930 Aux Id: </p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.10</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>The FD_SETSIZE limit has been increased to 2048 for - VxWorks/PPC603.</p> - <p>Own Id: OTP-5395 Aux Id: seq9751</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.9</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>In C back-ends, the compiler crashed when generating C code - for error reports when a scoped name was used as a type - in a union.</p> - <p>Own Id: OTP-5375 Aux Id: seq9740 </p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.8</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>In C back-ends, when decoding a sequence of "small" - integers, which from Erlang is sent as a string (i.e. - each element between 0 and 255), each string element was - considered to be of signed character type. Each such - element is now correctly treated as an unsigned character - type.</p> - <p>Own Id: OTP-5205 Aux Id: seq9241 </p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.7</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>A new compiler option <c>c_report</c> has been introduced - for C back-ends (client and server). If that option is - set, encoding/decoding errors will be reported to - <c>stderr</c>.</p> - <p>Own Id: OTP-4977</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.6</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>The size of modules, used then registering data in the - IFR DB (e.g., oe_MyModule:oe_register()), can be minimized - if the compile option light_ifr is used and Orber is - configured to use Light IFR. Requires that orber-3.5.1, or - later, is used.</p> - <p>Own Id: OTP-5036</p> - </item> - </list> - </section> - - <section> - <title>Incompatibilities</title> - <list type="bulleted"> - <item> - <p>The compile option <c>multiple_be</c> is no longer supported.</p> - <p>Own Id: OTP-5049</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.5</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Send and receive functions with timeouts have been added - to the C back-ends for the standard protocol (i.e. Erlang - distribution + gen_server protocol).</p> - <p>Accordingly a new compiler option <c>{c_timeout, {SendTimeout, RecvTimeout}}</c> has been added. Timeouts - are specified in milliseconds.</p> - <p>A user that want to implement its own protocols with - function timeouts has to implement the following functions.</p> - <p>For C clients the functions <c>int PFX_send_notification(CORBA_Environment *env, unsigned int send_ms)</c>, and <c>int PFX_send_request_and_receive_reply(CORBA_Environment *env, unsigned int send_ms, unsigned int recv_ms)</c> - have to be additionally implemented, where PFX is the - user defined prefix.</p> - <p>For C servers no additional functions have to be - implemented, but a clone of the <c>int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, unsigned int send_ms, unsigned int recv_ms)</c> - might be handy.</p> - <p>Own Id: OTP-4972</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.4</title> - - <section> - <title>Improvements and new features</title> - <list type="bulleted"> - <item> - <p>The C back-ends has been opened up, so that a user can - define his own protocol, differing from the Erlang - distribution + gen_server protocol. <br></br> - - For C clients it means to replace the library functions - <c>int oe_prepare_notification_encoding(CORBA_Environment *env)</c>, <c>int oe_send_notification(CORBA_Environment *env)</c>, <c>int oe_prepare_request_encoding(CORBA_Environment *env)</c>, - <c>int oe_send_request_and_receive_reply(CORBA_Environment *env)</c>, and <c>int oe_prepare_reply_decoding(CORBA_Environment *env)</c>, - with functions of the same signature, but with the prefix - "oe" replaced by a user defined prefix. - For C servers the functions <c>int oe_prepare_request_decoding(CORBA_Environment *env)</c>, - and <c>int oe_prepare_reply_encoding(CORBA_Environment *env)</c>, are similarly replaced. <br></br> - - The new compiler option <c>{user_protocol, Prefix}</c> has - been added.</p> - <p>Own Id: OTP-4834</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.3</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>In generated code for the C server back-end, the naming scope - was in error for prototypes in C header files for interfaces - inheriting base interfaces.</p> - <p>Own Id: OTP-4881</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.2</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>IDL long long and unsigned long long could not - be used in a struct for the Java backend.</p> - <p>All unsigned integer types for the Java backend - had broken marshalling for large values.</p> - <p>Own Id: OTP-4763</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2.1</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>A scoping problem (IC could not find typedefs contained - inherited interfaces) in the C-backend solved.</p> - <p>Own Id: OTP-4758</p> - </item> - </list> - </section> - </section> - - <section> - <title>IC 4.2</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>The CORBA stub/skeleton-files generated by IC have been improved, - i.e., depending on the IDL-files, reduced the size of the - erl- and beam-files and decreased dependencies off Orber's - Interface Repository. It is necessary to re-compile all IDL-files - and use COS-applications, including Orber, compiled with - IC-4.2.</p> - <p>Own Id: OTP-4576</p> - </item> - </list> - </section> - </section> -</chapter> - diff --git a/lib/ic/doc/src/part.xml b/lib/ic/doc/src/part.xml deleted file mode 100644 index 0bb7858745..0000000000 --- a/lib/ic/doc/src/part.xml +++ /dev/null @@ -1,46 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IC User's Guide</title> - <prepared></prepared> - <docno></docno> - <date>1998-08-07</date> - <rev>2.1</rev> - </header> - <description> - <p>The <em>IC</em> application is an Erlang implementation of an IDL - compiler.</p> - </description> - <xi:include href="ch_introduction.xml"/> - <xi:include href="ch_basic_idl.xml"/> - <xi:include href="ch_ic_protocol.xml"/> - <xi:include href="ch_erl_plain.xml"/> - <xi:include href="ch_erl_genserv.xml"/> - <xi:include href="ch_c_mapping.xml"/> - <xi:include href="ch_c_client.xml"/> - <xi:include href="ch_c_server.xml"/> - <xi:include href="ch_c_corba_env.xml"/> - <xi:include href="ch_java.xml"/> -</part> - diff --git a/lib/ic/doc/src/ref_man.xml b/lib/ic/doc/src/ref_man.xml deleted file mode 100644 index a6a4f187b3..0000000000 --- a/lib/ic/doc/src/ref_man.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE application SYSTEM "application.dtd"> - -<application xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>1998</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - 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. - - </legalnotice> - - <title>IC Reference Manual</title> - <prepared></prepared> - <docno></docno> - <date>2003-12-16</date> - <rev>PB1</rev> - </header> - <description> - <p>The <em>IC</em> application is an Erlang implementation of an IDL - compiler.</p> - </description> - <xi:include href="ic.xml"/> - <xi:include href="ic_clib.xml"/> - <xi:include href="ic_c_protocol.xml"/> -</application> - diff --git a/lib/ic/ebin/.gitignore b/lib/ic/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ic/ebin/.gitignore +++ /dev/null diff --git a/lib/ic/examples/all-against-all/Makefile b/lib/ic/examples/all-against-all/Makefile deleted file mode 100644 index e772cab94e..0000000000 --- a/lib/ic/examples/all-against-all/Makefile +++ /dev/null @@ -1,118 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-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% -# -# -# Point this at your version of OTP -OTPROOT=/usr/local/otp/releases/otp_beam_sunos5_r7a - -# Type actual IC Version -ICVSN=4.0.4 - -# Type actual Erl Interface Vesrion -EIVSN=3.2.2 - -# Type actual Erl Interface Vesrion -JIVSN=1.2 - -# IDL file(s) -IDLS=random.idl - -# Own C-server files -CSRV=server callbacks - -# Own C-client files -CCL=client - -# Generated C-server files -GCSRVS=rmod_random__s - -# Generated C-server files -GCCLS=rmod_random - -# Includes -IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \ - -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include - -LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \ - -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib - -LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket - - -# Erlang compiler -ERLC=$(OTPROOT)/bin/erlc - -# Erlang compiler flags. -EFLAGS='+{scoped_op_calls,true}' - -# C compiler -CC=gcc - -# C compiler flags -CFLAGS=-ggdb -O2 -Wall $(IFLAGS) - -# Java compiler -JAVAC=javac - -CLASSPATH= "./:$(OTPROOT)/lib/ic-$(ICVSN)/priv/ic.jar:$(OTPROOT)/lib/jinterface-$(JIVSN)/priv/OtpErlang.jar" -JFLAGS=-classpath $(CLASSPATH) -O - -JGENJFILES = \ - ./rmod/_randomImplBase.java \ - ./rmod/random.java \ - ./rmod/randomHolder.java \ - ./rmod/_randomStub.java \ - ./rmod/randomHelper.java - - -all: server client eall jall - - -server: - $(ERLC) $(EFLAGS) '+{be,c_server}' $(IDLS) - $(CC) $(IFLAGS) -c $(CSRV:=.c) $(GCSRVS:=.c) - $(CC) $(CSRV:=.o) $(GCSRVS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) - -client: - $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS) - $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c) - $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) - -eall: - $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS) - $(ERLC) *.erl - -jall: - $(ERLC) $(EFLAGS) '+{be,java}' $(IDLS) - $(JAVAC) $(JFLAGS) */*.java *.java - - -clean: - /bin/rm -rf $(GCCLS:=.o) $(GCCLS:=.c) $(GCSRVS:=.o) $(GCSRVS:=.c) $(CCL:=.o) $(CSRV:=.o) rmod.erl rmod_random.erl *.jam *.beam oe* *.h *.hrl *~ core server client *.class - - - - - - - - - - - diff --git a/lib/ic/examples/all-against-all/Makefile.win32 b/lib/ic/examples/all-against-all/Makefile.win32 deleted file mode 100644 index a8e480fd1f..0000000000 --- a/lib/ic/examples/all-against-all/Makefile.win32 +++ /dev/null @@ -1,139 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2000-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% -# -# -# Point this at your version of OTP -OTPROOT=c:\Progra~1\erl5.0.1\ - -# Type actual IC Version -ICVSN=4.0.4 - -# Type actual Erl Interface Vesrion -EIVSN=3.2.2 - -# Type actual Erl Interface Vesrion -JIVSN=1.2 - -# IDL file(s) -IDLS=random.idl - -# Own C-server files -CSRV=server.c callbacks.c -CSRVO=server.obj callbacks.obj - -# Own C-client files -CCL=client.c -CCLO=client.obj - -# Generated C-server files -GCSRVS=rmod_random__s.c -GCSRVSO=rmod_random__s.obj - -# Generated C-client files -GCCLS=rmod_random.c -GCCLSO=rmod_random.obj - -# Includes -IFLAGS=-I"$(OTPROOT)\lib\ic-$(ICVSN)\include" \ - -I"$(OTPROOT)\lib\erl_interface-$(EIVSN)\include" - -LDFLAGS=/LIBPATH:"$(OTPROOT)\lib\ic-$(ICVSN)\priv\lib" \ - /LIBPATH:"$(OTPROOT)\lib\erl_interface-$(EIVSN)\lib" - -LDLIBS=ic.lib erl_interface.lib ei.lib ws2_32.lib - - -# Erlang compiler -ERLC=$(OTPROOT)\bin\erlc - -# Erlang compiler flags. -EFLAGS="+{scoped_op_calls,true}" - - -# C compiler -CC=cl - -# C compiler flags -CFLAGS=-MT -D__WIN32__ $(IFLAGS) - - -# Java compiler -JAVAC=c:\Progra~1\jdk1.3\bin\javac - -# Java -JAVA=c:\Progra~1\jdk1.3\bin\java - - -# Java compiler flags -CLASSPATH= ".;$(OTPROOT)\lib\ic-$(ICVSN)\priv\ic.jar;$(OTPROOT)\lib\jinterface-$(JIVSN)\priv\OtpErlang.jar" -JFLAGS=-classpath $(CLASSPATH) -O - - -all: server.exe client.exe client.beam client.class - - -server.exe: - $(ERLC) $(EFLAGS) "+{be,c_server}" $(IDLS) - $(CC) -c $(CFLAGS) $(CSRV) $(GCSRVS) - $(CC) -o server.exe $(CSRVO) $(GCSRVSO) -link $(LDFLAGS) $(LDLIBS) - - -client.exe: - $(ERLC) $(EFLAGS) "+{be,c_client}" $(IDLS) - $(CC) -c $(CFLAGS) $(CCL) $(GCCLS) - $(CC) -o client.exe $(CCLO) $(GCCLSO) -link $(LDFLAGS) $(LDLIBS) - -client.beam: - $(ERLC) $(EFLAGS) "+{be,erl_genserv}" $(IDLS) - $(ERLC) *.erl - -client.class: - $(ERLC) $(EFLAGS) "+{be,java}" $(IDLS) - $(JAVAC) $(JFLAGS) rmod/*.java - $(JAVAC) $(JFLAGS) *.java - -jclient.run: - $(JAVA) -classpath $(CLASSPATH) client - -jserver.run: - $(JAVA) -classpath $(CLASSPATH) server - - -clean: - -@del /f /q rmod - -@rmdir rmod - -@del *.jam - -@del *.beam - -@del oe* - -@del *.h - -@del *.hrl - -@del server.exe - -@del client.exe - -@del *.obj - -@del rmod_random*.c - -@del *~ - -@del *class - -@del rmod.erl - -@del rmod_random.erl - - - - - - diff --git a/lib/ic/examples/all-against-all/ReadMe b/lib/ic/examples/all-against-all/ReadMe deleted file mode 100644 index 7503291344..0000000000 --- a/lib/ic/examples/all-against-all/ReadMe +++ /dev/null @@ -1,122 +0,0 @@ -This is a short description on the use of Erlang,C or Java -client and servers against each other. -The base is a client that initiates and uses a random number -generator that lies on an server. - -There are two make files, one for Unix and one for Windows, -the Unix make file is just named "Makefile", while the Windows -is named "Makefile.win32". - -Instructions. - -1) On Makefile : - * Modify the OTPROOT variable on the Makefile to point - to the root for your erlang instalation. - * Modify IC and Erl_Interface versions to agree your - OTP version. - -2) Type "make" to build the example. - - -3) Start the empd deamon by using the command : - - epmd -daemon - - -4) Do this when you want to run : - - * an Erlang server. - - Start erlang with the options - - -setcookie <Some Cookie> -sname <SomeNodeName> - - In this example you should use : - - erl -setcookie flash -sname babbis - - * a C server. - - Just type : - - server - - * a Java server. - - Set and export the CLASSPATH variable to - point to the java classes located in java development kit, - the Otp's classes and the current directory. - Your classpath should look like this : - - .:<OTPROOT>/lib/ic-3.8.1/priv/ic.jar:<OTPROOT>/lib/jinterface_0.9.2/priv/OtpErlang.jar - - where : - - <OTPROOT> is the location there OTP is installed - - Then type : - - java server - - -5) Do this when you want to run : - - * an Erlang client. - - ** If you have no valid named erlang node, - start erlang with the options - - -setcookie <Some Cookie> -sname <SomeNodeName> - - In this example you should use : - - erl -setcookie flash -sname client - - On the erlang shell, type - - client:start(). - - ** If you have a valid named erlang node, started - whith the same "cookie", on the erlang shell, type - - client:start(). - - - * a C client, just type - - client - - - * a Java client. - - - Set and export the CLASSPATH variable to - point to the java classes located in java development kit, - the Otp's classes and the current directory. - Your classpath should look like this : - - .:<OTPROOT>/lib/ic-4.0/priv/ic.jar:<OTPROOT>/lib/jinterface_1.1/priv/OtpErlang.jar - - where : - - <OTPROOT> is the location there OTP is installed - - Then type : - - java client - - - -6) Please note that : - - * you must always have the same cookie in order to eastablish connection - between clients and servers. - - * you cannot start two servers with the same name. - In this example all servers share the same name in order to test - several constallations. Kill a server before starting another one. - - - - - diff --git a/lib/ic/examples/all-against-all/callbacks.c b/lib/ic/examples/all-against-all/callbacks.c deleted file mode 100644 index 4e6edeb5e0..0000000000 --- a/lib/ic/examples/all-against-all/callbacks.c +++ /dev/null @@ -1,46 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ - -#include <stdlib.h> -#include "rmod_random__s.h" - - -rmod_random_produce__rs* -rmod_random_produce__cb(rmod_random oe_obj, double *rs, CORBA_Environment *oe_env) - -{ - *rs = (double) rand(); - - return (rmod_random_produce__rs*) NULL; -} - - -rmod_random_init__rs* -rmod_random_init__cb(rmod_random oe_obj, long* seed1, long* seed2, long* seed3, CORBA_Environment *oe_env) - -{ - srand(*seed1 * *seed2 * *seed3); - - return (rmod_random_init__rs*) NULL; -} - - - diff --git a/lib/ic/examples/all-against-all/client.c b/lib/ic/examples/all-against-all/client.c deleted file mode 100644 index 4f2f7e3eff..0000000000 --- a/lib/ic/examples/all-against-all/client.c +++ /dev/null @@ -1,154 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ - -/* Just include the interface function */ -#include "rmod_random.h" - - -/* Assign your own node name here */ -#define CLNODENAME "c50" -#define SNODENAME "babbis" -#define SREGNAME "rmod_random_impl" -#define COOKIE "flash" -#define INBUFSZ 1024 -#define OUTBUFSZ 1024 -#define HOSTNAMESZ 256 - - - -/* Stopping node */ -void client_exit(CORBA_Environment *env) { - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - - erl_close_connection(env->_fd); - exit(1); -} - - -int main(){ - - double result=0; - int i=0; - int error = 0; - erlang_pid pid; - char host[HOSTNAMESZ]; - char server_node[HOSTNAMESZ]; - char client_node[HOSTNAMESZ]; - CORBA_Environment *env; - - /* Initiate names */ -#ifdef __WIN32__ - WORD wVersionRequested; - WSADATA wsaData; - - wVersionRequested = MAKEWORD(1, 1); - if ((error = WSAStartup(wVersionRequested, &wsaData))) { - fprintf(stderr,"Can't initialize windows sockets: %d",error); - return 0; - } -#endif - error = gethostname(host,HOSTNAMESZ); - if (error) { -#ifdef __WIN32__ - fprintf(stderr,"can't find own hostname (error = %ld) !\n",WSAGetLastError()); -#else /* not __WIN32__ */ - fprintf(stderr,"can't find own hostname !\n"); -#endif - } - sprintf(client_node,"%s@%s",CLNODENAME,host); - sprintf(server_node,"%s@%s",SNODENAME,host); - - /* Create and init CORBA_Environment */ - env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); - - /* Initiating the connection */ - erl_init(NULL,0); - erl_connect_init(50,COOKIE,0); - - /* Initiating pid*/ - strcpy(pid.node,client_node); - pid.num = 99; - pid.serial = 0; - pid.creation = 0; - - /* Fixing environment variable */ - env->_fd=erl_connect(server_node); - strcpy(env->_regname,SREGNAME); - env->_to_pid = NULL; - env->_from_pid = &pid; - - if (env->_fd < 0) { - fprintf(stderr,"Error : Cannot connect to Server\n"); - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - exit(1); - } - - /* Calling the init function */ - rmod_random_init(NULL, 1, 2, 3, env); - - switch(env->_major) { - case CORBA_NO_EXCEPTION: /* Success */ - printf("Init complete !\n"); - break; - case CORBA_SYSTEM_EXCEPTION: /* System exception */ - printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - client_exit(env); - default: /* Should not come here */ - client_exit(env); - } - - /* Calling the produce function */ - for(i=1; i<=10; i++) { - result = rmod_random_produce(NULL, env); - - switch(env->_major) { - case CORBA_NO_EXCEPTION: /* Success */ - break; - case CORBA_SYSTEM_EXCEPTION: /* System exception */ - printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - client_exit(env); - default: /* Should not come here */ - client_exit(env); - } - - printf("the random number nr%d is %f\n",i,result); - } - - /* Closing the connection */ - erl_close_connection(env->_fd); - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - - return 0; -} diff --git a/lib/ic/examples/all-against-all/client.erl b/lib/ic/examples/all-against-all/client.erl deleted file mode 100644 index 3c147037a0..0000000000 --- a/lib/ic/examples/all-against-all/client.erl +++ /dev/null @@ -1,54 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% -%%---------------------------------------------------------------------- -%% File : client.erl -%% Purpose : -%%---------------------------------------------------------------------- - --module(client). - --export([produce/0,init/3,call/0]). - --define(SERVER,{rmod_random_impl, - list_to_atom("babbis@"++hd(tl(string:tokens(atom_to_list(node()),"@"))))}). --define(CLIENTMOD,'rmod_random'). - -produce() -> - ?CLIENTMOD:produce(?SERVER). - - -init(Seed1, Seed2, Seed3) -> - io:format("Init..."), - ?CLIENTMOD:init(?SERVER,Seed1, Seed2, Seed3), - io:format("ok\n"). - - -call() -> - init(1,2,3), - produce(0). - - -produce(10) -> - ok; -produce(Ctr) -> - N = produce(), - io:format("Random~p = ~p\n",[Ctr,N]), - produce(Ctr+1). diff --git a/lib/ic/examples/all-against-all/client.java b/lib/ic/examples/all-against-all/client.java deleted file mode 100644 index 48b5bc4f60..0000000000 --- a/lib/ic/examples/all-against-all/client.java +++ /dev/null @@ -1,61 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -public class client { - - private static java.lang.String SNode = "client"; - private static java.lang.String PNode = "babbis"; - private static java.lang.String Cookie = "flash"; - private static java.lang.String Server = "rmod_random_impl"; - - private static rmod._randomStub stub; - - public static void main(String[] args) { - - try { - - stub = new rmod._randomStub(SNode,PNode,Cookie,Server); - int seed1 = 1; - int seed2 = 2; - int seed3 = 3; - double random = 0; - - System.out.print("\nClient initialization...."); - stub.init(seed1,seed2,seed3); - System.out.println("ok\n"); - - - for (int i = 0; i < 10; i++) { - random = stub.produce(); - System.out.println("Random" + i + " = " + random); - } - System.out.println("\nClient terminated.\n"); - - stub.__disconnect(); - - } catch( Exception e) { - System.out.println("Exception :"); - e.printStackTrace(); - } - - } - -} - diff --git a/lib/ic/examples/all-against-all/random.idl b/lib/ic/examples/all-against-all/random.idl deleted file mode 100644 index 3402dfee2c..0000000000 --- a/lib/ic/examples/all-against-all/random.idl +++ /dev/null @@ -1,51 +0,0 @@ -// ``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. -// -// The Initial Developer of the Original Code is Ericsson Utvecklings AB. -// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -// AB. All Rights Reserved.'' -// -// $Id$ -// - -#ifndef _RANDOM_IDL -#define _RANDOM_IDL - -module rmod { - - interface random { - - double produce(); - - oneway void init(in long seed1, in long seed2, in long seed3); - - }; - -}; - - -#endif - - - - - - - - - - - - - - - diff --git a/lib/ic/examples/all-against-all/rmod_random_impl.erl b/lib/ic/examples/all-against-all/rmod_random_impl.erl deleted file mode 100644 index 36b280c0b2..0000000000 --- a/lib/ic/examples/all-against-all/rmod_random_impl.erl +++ /dev/null @@ -1,49 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-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% -%% -%% --module(rmod_random_impl). --export([init/1, terminate/2]). --export([produce/1,init/4]). - - -init(Env) -> - {ok, []}. - -terminate(From, Reason) -> - ok. - - -produce(_Random) -> - case catch random:uniform() of - {'EXIT',_} -> - true; - RUnif -> - {reply,RUnif,[]} - end. - - -init(_Random,S1,S2,S3) -> - case catch random:seed(S1,S2,S3) of - {'EXIT',_} -> - true; - _ -> - {noreply,[]} - end. - diff --git a/lib/ic/examples/all-against-all/server.c b/lib/ic/examples/all-against-all/server.c deleted file mode 100644 index 6d46ea7673..0000000000 --- a/lib/ic/examples/all-against-all/server.c +++ /dev/null @@ -1,262 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ - -#include <stdio.h> -#include <stdlib.h> -#include <sys/types.h> -#include <string.h> -#ifdef __WIN32__ -#include <winsock2.h> -#include <direct.h> -#include <windows.h> -#include <winbase.h> -#else /* not __WIN32__ */ -#include <errno.h> -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <arpa/inet.h> -#include <netdb.h> -#endif -#include "rmod_random__s.h" - -/* Used functions */ -static int getport(int sockd); -static int getlisten(int port); -static int init(int *sd, int *portnr, int *epmd_fd); -void terminate(int *fd, int *sd, int *epmd_fd); -static void server_loop(int fd, int sd); - -/* change these, or even better, make command-line args to program... */ -#define COOKIE "flash" -#define SERVER "babbis" -#define NODENAMESZ 512 -#define HOSTNAMESZ 256 -#define INBUFSZ 1024 -#define OUTBUFSZ 1024 - - -int main(int argc, char **argv) -{ - int sd; - int portnr; - int epmd_fd; - - /* crate file descriptors */ - if (init(&sd, &portnr, &epmd_fd) < 0) - return -1; - - /* start server loop */ - server_loop(sd,epmd_fd); - - return 0; -} - - - -static void server_loop(int sd, int epmd_fd) -{ - ErlConnect conn; - erlang_msg msg; - int status=1; - CORBA_Environment *env; - - /* Create and init CORBA_Environment */ - env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); - - while (status >= 0) { - - status = 1; - - if ((env->_fd = erl_accept(sd,&conn)) < 0) { - /* error */ - fprintf(stderr,"Accept failed: %s\n",strerror(errno)); - } - else { - /* connection */ - fprintf(stderr,"Accepted connection from %s\n",conn.nodename); - - while (status >= 0) { - - /* write message to buffer */ - status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, &msg, &env->_iin); - switch(status) { - case ERL_SEND: - case ERL_REG_SEND : - /* do transaction with fd */ - rmod_random__switch(NULL,env); - - switch(env->_major) { - case CORBA_NO_EXCEPTION: /* Success */ - break; - case CORBA_SYSTEM_EXCEPTION: /* System exception */ - printf("Request failure, reason : %s\n",(char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - break; - default: /* Should not come here */ - CORBA_exception_free(env); - break; - } - - /* send outdata */ - if (env->_iout > 0) - ei_send_encoded(env->_fd,&env->_caller,env->_outbuf,env->_iout); - break; - - case ERL_TICK : - break; - default : /* < 0 */ - printf("Connection terminated\n"); - break; - } - } - } - status=0; /* restart */ - } - - /* close file descriptors */ - terminate(&env->_fd, &sd, &epmd_fd); - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); -} - - - -static int init(int *sd, int *portnr, int *epmd_fd) -{ - char host[HOSTNAMESZ]; - char servernode[NODENAMESZ]; - struct hostent *h; - int error = 0; - -#ifdef __WIN32__ - WORD wVersionRequested; - WSADATA wsaData; - - wVersionRequested = MAKEWORD(1, 1); - if ((error = WSAStartup(wVersionRequested, &wsaData))) { - fprintf(stderr,"Can't initialize windows sockets: %d",error); - } -#endif - /* get the host name */ - error = gethostname(host,HOSTNAMESZ); - if (error) { -#ifdef __WIN32__ - fprintf(stderr,"can't find own hostname (error = %ld) !\n",WSAGetLastError()); -#else /* not __WIN32__ */ - fprintf(stderr,"can't find own hostname !\n"); -#endif - } - else { - /* identify host */ - if (!(h = erl_gethostbyname(host))) - fprintf(stdout,"can't find own ip address\n"); - else { - - /* get a listen port. 0 means let system choose port number */ - *sd = getlisten(0); - - /* what port did we get? */ - /* this call not necessary if we specified port in call to getlisten() */ - *portnr = getport(*sd); - - /* make the nodename server@host */ - sprintf(servernode,"%s@%s",SERVER,host); - - /* initiate */ - erl_init(NULL,0); - - /* host, alive, alive@host, addr, cookie, creation */ - erl_connect_xinit(host,SERVER,servernode,(Erl_IpAddr)(h->h_addr_list[0]),COOKIE,0); - - /* let epmd know we are here */ - *epmd_fd = erl_publish(*portnr); - - return 0; - } - } - return -1; -} - - -void terminate(int *fd, int *sd, int *epmd_fd) { - - close(*fd); - - /* remove info from epnd */ - close(*epmd_fd); - - /* return socket */ - close(*sd); - -} - - - -/* tells you what port you are using on given socket */ -static int getport(int sockd) -{ - struct sockaddr_in addr; - int namelen = sizeof(addr); - int i; - - memset(&addr,0,sizeof(addr)); - - if ((i = getsockname(sockd,(struct sockaddr *)&addr,&namelen))<0) - return i; - - return ntohs(addr.sin_port); -} - - - -/* return a listen socket, bound to given port */ -/* specify port = 0 to let system assign port */ -static int getlisten(int port) -{ - int sockd; - struct sockaddr_in inaddr; - int opt = 1; - int i; - - /* get listen socket */ - if ((sockd = socket(AF_INET,SOCK_STREAM,0)) < 0) return sockd; - - if ((i=setsockopt(sockd,SOL_SOCKET,SO_REUSEADDR,(void *)&opt,sizeof(opt)))<0) - return i; - - /* bind to requested port */ - memset(&inaddr,0,sizeof(inaddr)); - inaddr.sin_family = AF_INET; - inaddr.sin_addr.s_addr = htonl(INADDR_ANY); - inaddr.sin_port = htons(port); - - if ((i = bind(sockd,(struct sockaddr*) &inaddr, sizeof(inaddr))) < 0) - return i; - - listen(sockd,5); - - return sockd; -} - diff --git a/lib/ic/examples/all-against-all/server.erl b/lib/ic/examples/all-against-all/server.erl deleted file mode 100644 index c5fa2589ae..0000000000 --- a/lib/ic/examples/all-against-all/server.erl +++ /dev/null @@ -1,41 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% --module(server). --export([start/0]). - - - -%% This starts up the random number server -start() -> - %% Start the gen server - {ok,Pid} = rmod_random:oe_create([],{local,'rmod_random_impl'}), - true. - - - - - - - - - - - diff --git a/lib/ic/examples/all-against-all/server.java b/lib/ic/examples/all-against-all/server.java deleted file mode 100644 index 79618ba8be..0000000000 --- a/lib/ic/examples/all-against-all/server.java +++ /dev/null @@ -1,83 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -public class server { - - private static java.lang.String SNode = "babbis"; - private static java.lang.String Cookie = "flash"; - private static java.lang.String RegName = "rmod_random_impl"; - - public static void main(String[] args) { - - - System.out.println("\nServer running.\n"); - boolean serverState = true; - boolean recState = true; - - try { - - com.ericsson.otp.erlang.OtpServer self = new com.ericsson.otp.erlang.OtpServer(SNode, Cookie); - self.publishPort(); - - /* Server loop */ - while(serverState == true) { - - com.ericsson.otp.erlang.OtpConnection connection = self.accept(); - serverImpl srv = new serverImpl(); - com.ericsson.otp.erlang.OtpInputStream request; - com.ericsson.otp.erlang.OtpOutputStream reply; - com.ericsson.otp.erlang.OtpErlangPid client; - - /* Server loop */ - while(recState == true) { - - if (connection.isConnected() == true) - try { - - request = connection.receiveBuf(); - - reply = srv.invoke(request); - - if (reply != null) { - client = srv.__getCallerPid(); - - connection.sendBuf(client,reply); - } - - } catch( Exception e) { - System.out.println("Server terminated.\n\n"); - recState = false; - serverState = false; - } - } - - connection.close(); - } - - } catch( Exception e) { - System.out.println("Initialization exception :"); - e.printStackTrace(); - } - } -} - - - - diff --git a/lib/ic/examples/all-against-all/serverImpl.java b/lib/ic/examples/all-against-all/serverImpl.java deleted file mode 100644 index 336bc7e327..0000000000 --- a/lib/ic/examples/all-against-all/serverImpl.java +++ /dev/null @@ -1,43 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -public class serverImpl extends rmod._randomImplBase { - - java.util.Random random = null; - - - public void init(int seed1, int seed2, int seed3) throws java.lang.Exception { - - random = new java.util.Random(seed1+seed2+seed3); - }; - - - public double produce() throws java.lang.Exception { - - return random.nextDouble(); - } - -} - - - - - - diff --git a/lib/ic/examples/c-client/Makefile b/lib/ic/examples/c-client/Makefile deleted file mode 100644 index 1bfaaed477..0000000000 --- a/lib/ic/examples/c-client/Makefile +++ /dev/null @@ -1,87 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-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% -# -# -# Point this at your version of OTP -OTPROOT=/usr/local/otp/daily_build/otp_beam_sunos5_r8a.latest - -# Type actual IC Version -ICVSN=4.1.1 - -# Type actual Erl Interface Vesrion -EIVSN=3.3.0 - -# IDL file(s) -IDLS=random.idl - -# Own C-client files -CCL=client - -# Generated C-server files -GCCLS=oe_code_seed rmod_random - -# Includes -IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \ - -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include - -LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \ - -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib - -LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket - - -# Erlang compiler -ERLC=$(OTPROOT)/bin/erlc - -# Erlang compiler flags. -EFLAGS='+{preproc_flags,"-I $(OTPROOT)/usr/include"}' '+{scoped_op_calls,true}' - - -# C compiler -CC=gcc - -# C compiler flags -CFLAGS=-ggdb -O2 -Wall $(IFLAGS) - - -all: server client - - -server: - $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS) - $(ERLC) *.erl - -client: - $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS) - $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c) - $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) - - - -clean: - /bin/rm -f $(GCCLS:=.o) $(GCCLS:=.c) $(CCL:=.o) *.jam *.beam oe* rmod_random.erl *.h *.hrl *~ core client - - - - - - - - - diff --git a/lib/ic/examples/c-client/ReadMe b/lib/ic/examples/c-client/ReadMe deleted file mode 100644 index 28372c3be2..0000000000 --- a/lib/ic/examples/c-client/ReadMe +++ /dev/null @@ -1,46 +0,0 @@ -This is a short description on the use of the c-client demo, -a client that initiates and uses a random number generator -that lies on an Erlang-genserver. - -Instructions. - -1) On Makefile : - * Modify the OTPROOT variable on the Makefile to point - to the root for your erlang instalation. - * Modify IC and Erl_Interface versions to agree your - OTP version. - -2) Type "make" to build the example. - - -3) Start erlang with the options - -setcookie <Some Cookie> -sname <SomeNodeName> - - In this example you should use : - - erl -setcookie flash -sname babbis - - -4) On the erlang shell type : - -------------------------- - - rmod_random:oe_create([],{local,rmod_random_impl}). ( initializes the server ) - - or - - test:start(). - - - Then start a new terminal window and type : - ------------------------------------------- - - client ( calls the client ) - - - - - - - - - diff --git a/lib/ic/examples/c-client/client.c b/lib/ic/examples/c-client/client.c deleted file mode 100644 index 652d8376fd..0000000000 --- a/lib/ic/examples/c-client/client.c +++ /dev/null @@ -1,131 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ - -/* Include the interface function and ei_connect */ -#include "rmod_random.h" -#include "ei_connect.h" - -/* Assign your own node name here */ -#define SNODE "babbis@balin" -#define SERVER "rmod_random_impl" -#define COOKIE "flash" -#define CLNODE "c47@balin" -#define INBUFSZ 1024 -#define OUTBUFSZ 1024 - -/* Stopping node */ -void client_exit(CORBA_Environment *env) { - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - - close(env->_fd); - exit(1); -} - -int main() -{ - double result=0; - int i=0; - erlang_pid pid; - CORBA_Environment *env; - seed idata; - ei_cnode ec; - - /* Create and init CORBA_Environment */ - env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); - - /* Initialize seed */ - idata.seed1 = 1; - idata.seed2 = 2; - idata.seed3 = 3; - - /* Initiating the connection */ - ei_connect_init(&ec, "c47", COOKIE, 0); - - /* Initiating pid*/ - strcpy(pid.node,CLNODE); - pid.num = 99; - pid.serial = 0; - pid.creation = 0; - - /* Fixing environment variable */ - env->_fd = ei_connect(&ec, SNODE); - strcpy(env->_regname, SERVER); - env->_to_pid = NULL; - env->_from_pid = &pid; - - if (env->_fd < 0) { - fprintf(stderr,"Error : Cannot connect to Server\n"); - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - exit(1); - } - - /* Calling the init function */ - rmod_random_init(NULL, &idata, env); - - switch(env->_major) { - case CORBA_NO_EXCEPTION: /* Success */ - printf("Init complete !\n"); - break; - case CORBA_SYSTEM_EXCEPTION: /* System exception */ - printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - client_exit(env); - default: /* Should not come here */ - client_exit(env); - } - - /* Calling the produce function */ - for(i=1; i<=10; i++) { - result = rmod_random_produce(NULL, env); - - switch(env->_major) { - case CORBA_NO_EXCEPTION: /* Success */ - break; - case CORBA_SYSTEM_EXCEPTION: /* System exception */ - printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - client_exit(env); - default: /* Should not come here */ - client_exit(env); - } - - printf("the random number nr%d is %f\n",i,result); - } - - /* Closing the connection */ - close(env->_fd); - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - - return 0; -} - diff --git a/lib/ic/examples/c-client/random.idl b/lib/ic/examples/c-client/random.idl deleted file mode 100644 index 8f54058e2b..0000000000 --- a/lib/ic/examples/c-client/random.idl +++ /dev/null @@ -1,52 +0,0 @@ -// ``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. -// -// The Initial Developer of the Original Code is Ericsson Utvecklings AB. -// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -// AB. All Rights Reserved.'' -// -// $Id$ -// -#ifndef _RANDOM_IDL -#define _RANDOM_IDL - -struct seed { - long seed1; - long seed2; - long seed3; -}; - -module rmod { - - interface random { - - double produce(); - - oneway void init(in seed idata); - - }; - -}; - -#endif - - - - - - - - - - - - diff --git a/lib/ic/examples/c-client/rmod_random_impl.erl b/lib/ic/examples/c-client/rmod_random_impl.erl deleted file mode 100644 index 2948115f8d..0000000000 --- a/lib/ic/examples/c-client/rmod_random_impl.erl +++ /dev/null @@ -1,53 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% --module('rmod_random_impl'). --include("oe_random.hrl"). --export([init/1, terminate/2]). --export([produce/1,init/2]). - - -init(Env) -> - {ok, []}. - -terminate(From, Reason) -> - ok. - - -produce(_Random) -> - case catch random:uniform() of - {'EXIT',_} -> - true; - RUnif -> - {reply,RUnif,[]} - end. - - -init(_Random,IData) -> - S1 = IData#seed.seed1, - S2 = IData#seed.seed2, - S3 = IData#seed.seed3, - case catch random:seed(S1,S2,S3) of - {'EXIT',_} -> - true; - _ -> - {noreply,[]} - end. - diff --git a/lib/ic/examples/c-client/test.erl b/lib/ic/examples/c-client/test.erl deleted file mode 100644 index d1fa40ff44..0000000000 --- a/lib/ic/examples/c-client/test.erl +++ /dev/null @@ -1,44 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% -% Start Erlang with : erl -sname <your name> -setcookie <your cookie> - --module(test). - --export([start/0,exec/0]). - - -start() -> - io:format("Starting server~n"), - rmod_random:oe_create([],{local,'rmod_random_impl'}). - -exec() -> - io:format("Running client~n"), - OutPut = os:cmd("client"), - io:format("~s",[OutPut]). - - - - - - - - - diff --git a/lib/ic/examples/c-server/Makefile b/lib/ic/examples/c-server/Makefile deleted file mode 100644 index be23d3ddf9..0000000000 --- a/lib/ic/examples/c-server/Makefile +++ /dev/null @@ -1,90 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-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% -# -# -# Point this at your version of OTP -OTPROOT=/usr/local/otp/daily_build/otp_beam_sunos5_r8a.latest - -# Type actual IC Version -ICVSN=4.1.1 - -# Type actual Erl Interface Vesrion -EIVSN=3.3.0 - -# IDL file(s) -IDLS=random.idl - -# Own C-server files -CSRV=server callbacks - -# Own C-client files -CCL=client - -# Generated C-server files -GCSRVS=rmod_random__s - -# Generated C-server files -GCCLS=rmod_random - -# Includes -IFLAGS=-I$(OTPROOT)/lib/ic-$(ICVSN)/include \ - -I$(OTPROOT)/lib/erl_interface-$(EIVSN)/include - -LDFLAGS=-L$(OTPROOT)/lib/ic-$(ICVSN)/priv/lib \ - -L$(OTPROOT)/lib/erl_interface-$(EIVSN)/lib - -LDLIBS=-lic -lerl_interface -lei -lnsl -lsocket - - -# Erlang compiler -ERLC=$(OTPROOT)/bin/erlc - -# Erlang compiler flags. -EFLAGS='+{preproc_flags,"-I $(OTPROOT)/usr/include"}' '+{scoped_op_calls,true}' - - -# C compiler -CC=gcc - -# C compiler flags -CFLAGS=-ggdb -O2 -Wall $(IFLAGS) - - -all: server client erlclient - - -server: - $(ERLC) $(EFLAGS) '+{be,c_server}' $(IDLS) - $(CC) $(IFLAGS) -c $(CSRV:=.c) $(GCSRVS:=.c) - $(CC) $(CSRV:=.o) $(GCSRVS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) - -client: - $(ERLC) $(EFLAGS) '+{be,c_client}' $(IDLS) - $(CC) $(IFLAGS) -c $(CCL:=.c) $(GCCLS:=.c) - $(CC) $(CCL:=.o) $(GCCLS:=.o) -o $@ $(LDFLAGS) $(LDLIBS) - -erlclient: - $(ERLC) $(EFLAGS) '+{be,erl_genserv}' $(IDLS) - $(ERLC) *.erl - - -clean: - /bin/rm -f $(GCCLS:=.o) $(GCCLS:=.c) $(GCSRVS:=.o) $(GCSRVS:=.c) $(CCL:=.o) $(CSRV:=.o) *.jam *.beam oe* *.h *.hrl *~ core server client - - diff --git a/lib/ic/examples/c-server/ReadMe b/lib/ic/examples/c-server/ReadMe deleted file mode 100644 index 69fce4cd07..0000000000 --- a/lib/ic/examples/c-server/ReadMe +++ /dev/null @@ -1,45 +0,0 @@ -This is a short description on the use of the client demo, -a client that initiates and uses a random number generator -that lies on a C-server. - -Instructions. - -1) Modify the OTPROOT variable on the Makefile to point - to the root for your erlang instalation. - Modify IC and Erl_Interface versions to agree your - OTP version. - -2) - Type : - ------ - - make ( generates and compiles all code ) - - server ( starts the c-server ) - - - To test the c-client against the c-server start a new terminal window and type : - -------------------------------------------------------------------------------- - - client ( calls the server ) - - - To test the erlang-client against the c-server start a new terminal window and type : - ------------------------------------------------------------------------------------- - - - erl -sname client -setcookie flash ( start erlang ) - - client:init(1,2,3). ( initiates the random generator ) - - client:produce(). ( calls the random generator ) - - - - - - - - - - diff --git a/lib/ic/examples/c-server/callbacks.c b/lib/ic/examples/c-server/callbacks.c deleted file mode 100644 index 2deca145f4..0000000000 --- a/lib/ic/examples/c-server/callbacks.c +++ /dev/null @@ -1,46 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ - -#include <stdlib.h> -#include "rmod_random__s.h" - - -rmod_random_produce__rs* -rmod_random_produce__cb(rmod_random oe_obj, double *rs, CORBA_Environment *oe_env) - -{ - *rs = (double) rand(); - - return (rmod_random_produce__rs*) NULL; -} - - -rmod_random_init__rs* -rmod_random_init__cb(rmod_random oe_obj, long* seed1, long* seed2, long* seed3, CORBA_Environment *oe_env) - -{ - srand(*seed1 * *seed2 * *seed3); - - return (rmod_random_init__rs*) NULL; -} - - - diff --git a/lib/ic/examples/c-server/client.c b/lib/ic/examples/c-server/client.c deleted file mode 100644 index c1d7a1c5a7..0000000000 --- a/lib/ic/examples/c-server/client.c +++ /dev/null @@ -1,125 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ - -/* Include the interface function, and ei_connect */ -#include "rmod_random.h" -#include "ei_connect.h" - -/* Assign your own node name here */ -#define SNODE "babbis@balin" -#define SERVER "rmod_random_impl" -#define COOKIE "flash" -#define CLNODE "c47@balin" -#define INBUFSZ 1024 -#define OUTBUFSZ 1024 - -/* Stopping node */ -void client_exit(CORBA_Environment *env) { - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - - close(env->_fd); - exit(1); -} - -int main() -{ - double result=0; - int i=0; - erlang_pid pid; - CORBA_Environment *env; - ei_cnode ec; - - /* Create and init CORBA_Environment */ - env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); - - /* Initiating the connection */ - ei_connect_init(&ec, "c47", COOKIE, 0); - - /* Initiating pid*/ - strcpy(pid.node, CLNODE); - pid.num = 99; - pid.serial = 0; - pid.creation = 0; - - /* Fixing environment variable */ - env->_fd = ei_connect(&ec, SNODE); - strcpy(env->_regname,SERVER); - env->_to_pid = NULL; - env->_from_pid = &pid; - - if (env->_fd < 0) { - fprintf(stderr,"Error : Cannot connect to Server\n"); - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - exit(1); - } - - /* Calling the init function */ - rmod_random_init(NULL, 1, 2, 3, env); - - switch(env->_major) { - case CORBA_NO_EXCEPTION: /* Success */ - printf("Init complete !\n"); - break; - case CORBA_SYSTEM_EXCEPTION: /* System exception */ - printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - client_exit(env); - default: /* Should not come here */ - client_exit(env); - } - - /* Calling the produce function */ - for(i=1; i<=10; i++) { - result = rmod_random_produce(NULL, env); - - switch(env->_major) { - case CORBA_NO_EXCEPTION: /* Success */ - break; - case CORBA_SYSTEM_EXCEPTION: /* System exception */ - printf("Init call failure, reason : %s\n",(char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - client_exit(env); - default: /* Should not come here */ - client_exit(env); - } - - printf("the random number nr%d is %f\n",i,result); - } - - /* Closing the connection */ - close(env->_fd); - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - - return 0; -} - diff --git a/lib/ic/examples/c-server/client.erl b/lib/ic/examples/c-server/client.erl deleted file mode 100644 index da28cd504b..0000000000 --- a/lib/ic/examples/c-server/client.erl +++ /dev/null @@ -1,45 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% -%%%---------------------------------------------------------------------- -%%% File : client.erl -%%% Author : Babbis Xagorarakis <babbis@balin> -%%% Purpose : -%%% Created : 22 Oct 1998 by Babbis Xagorarakis <babbis@balin> -%%%---------------------------------------------------------------------- - --module(client). --author('babbis@balin'). - --export([produce/0,init/3]). - --define(SERVER,{rmod_random_impl,'babbis@balin'}). --define(CLIENTMOD,'rmod_random'). - -produce() -> - ?CLIENTMOD:produce(?SERVER). - - -init(Seed1, Seed2, Seed3) -> - ?CLIENTMOD:init(?SERVER, Seed1, Seed2, Seed3). - - - - diff --git a/lib/ic/examples/c-server/random.idl b/lib/ic/examples/c-server/random.idl deleted file mode 100644 index 7ce302a2e7..0000000000 --- a/lib/ic/examples/c-server/random.idl +++ /dev/null @@ -1,50 +0,0 @@ -// ``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. -// -// The Initial Developer of the Original Code is Ericsson Utvecklings AB. -// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -// AB. All Rights Reserved.'' -// -// $Id$ -// - -#ifndef _RANDOM_IDL -#define _RANDOM_IDL - -module rmod { - - interface random { - - double produce(); - - oneway void init(in long seed1, in long seed2, in long seed3); - - }; - -}; - -#endif - - - - - - - - - - - - - - - diff --git a/lib/ic/examples/c-server/server.c b/lib/ic/examples/c-server/server.c deleted file mode 100644 index a04d60e9b1..0000000000 --- a/lib/ic/examples/c-server/server.c +++ /dev/null @@ -1,246 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ - -#include <stdio.h> -#include <stdlib.h> -#include <sys/types.h> -#include <string.h> -#ifdef __WIN32__ -#include <winsock2.h> -#include <direct.h> -#include <windows.h> -#include <winbase.h> -#else /* not __WIN32__ */ -#include <errno.h> -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <arpa/inet.h> -#include <netdb.h> -#endif -#include "rmod_random__s.h" -#include "ei_connect.h" - -/* Used functions */ -extern int gethostname(char *buf, int buflen); -static int getport(int sockd); -static int getlisten(int port); -static int init(ei_cnode *ec, int *sd, int *portnr, int *epmd_fd); -void terminate(int *fd, int *sd, int *epmd_fd); -static void server_loop(ei_cnode *ec, int fd, int sd); - -/* change these, or even better, make command-line args to program... */ -#define COOKIE "flash" -#define SERVER "babbis" -#define NODENAMESZ 512 -#define HOSTNAMESZ 256 -#define INBUFSZ 1024 -#define OUTBUFSZ 1024 - - -int main(int argc, char **argv) -{ - int sd; - int portnr; - int epmd_fd; - ei_cnode ec; - - /* crate file descriptors */ - if (init(&ec, &sd, &portnr, &epmd_fd) < 0) - return -1; - - /* start server loop */ - server_loop(&ec, sd, epmd_fd); - - return 0; -} - - - -static void server_loop(ei_cnode *ec, int sd, int epmd_fd) -{ - ErlConnect conn; - erlang_msg msg; - int status=1; - CORBA_Environment *env; - - /* Create and init CORBA_Environment */ - env = CORBA_Environment_alloc(INBUFSZ,OUTBUFSZ); - - while (status >= 0) { - status = 1; - - if ((env->_fd = ei_accept(ec, sd, &conn)) < 0) { - /* error */ - fprintf(stderr,"Accept failed: %s\n",strerror(errno)); - } else { - /* connection */ - fprintf(stderr,"Accepted connection from %s\n",conn.nodename); - - while (status >= 0) { - - /* write message to buffer */ - status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, &msg, &env->_iin); - switch(status) { - case ERL_SEND: - case ERL_REG_SEND : - /* do transaction with fd */ - rmod_random__switch(NULL,env); - - switch(env->_major) { - case CORBA_NO_EXCEPTION: /* Success */ - break; - case CORBA_SYSTEM_EXCEPTION: /* System exception */ - printf("Request failure, reason : %s\n",(char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - break; - default: /* Should not come here */ - CORBA_exception_free(env); - break; - } - - /* send outdata */ - if (env->_iout > 0) - ei_send_encoded(env->_fd,&env->_caller,env->_outbuf,env->_iout); - break; - - case ERL_TICK : - break; - default : /* < 0 */ - printf("Connection terminated\n"); - break; - } - } - } - status=0; /* restart */ - } - - /* close file descriptors */ - terminate(&env->_fd, &sd, &epmd_fd); - - /* Free env & buffers */ - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); -} - - - -static int init(int *sd, int *portnr, int *epmd_fd) -{ - char host[HOSTNAMESZ]; - char servernode[NODENAMESZ]; - struct hostent *h; - - /* get the host name */ - if ((gethostname(host,HOSTNAMESZ))) - fprintf(stderr,"can't find own hostname\n"); - else { - /* identify host */ - if (!(h = erl_gethostbyname(host))) - fprintf(stdout,"can't find own ip address\n"); - else { - - /* get a listen port. 0 means let system choose port number */ - *sd = getlisten(0); - - /* what port did we get? */ - /* this call not necessary if we specified port in call to getlisten() */ - *portnr = getport(*sd); - - /* make the nodename server@host */ - sprintf(servernode,"%s@%s",SERVER,host); - - /* initiate */ - /* cnode, host, alive, alive@host, addr, cookie, creation */ - if (ei_connect_xinit(ec, host, SERVER, servernode, - (Erl_IpAddr)(h->h_addr_list[0]), - COOKIE, 0) == 0) { - /* let epmd know we are here */ - *epmd_fd = ei_publish(ec, *portnr); - if (*epmd_fd >= 0) - return 0; - } - } - } - return -1; -} - - -void terminate(int *fd, int *sd, int *epmd_fd) { - - close(*fd); - - /* remove info from epnd */ - close(*epmd_fd); - - /* return socket */ - close(*sd); - -} - - - -/* tells you what port you are using on given socket */ -static int getport(int sockd) -{ - struct sockaddr_in addr; - int namelen = sizeof(addr); - int i; - - memset(&addr,0,sizeof(addr)); - - if ((i = getsockname(sockd,(struct sockaddr *)&addr,&namelen))<0) - return i; - - return ntohs(addr.sin_port); -} - - - -/* return a listen socket, bound to given port */ -/* specify port = 0 to let system assign port */ -static int getlisten(int port) -{ - int sockd; - struct sockaddr_in inaddr; - int opt = 1; - int i; - - /* get listen socket */ - if ((sockd = socket(AF_INET,SOCK_STREAM,0)) < 0) return sockd; - - if ((i=setsockopt(sockd,SOL_SOCKET,SO_REUSEADDR,(void *)&opt,sizeof(opt)))<0) - return i; - - /* bind to requested port */ - memset(&inaddr,0,sizeof(inaddr)); - inaddr.sin_family = AF_INET; - inaddr.sin_addr.s_addr = htonl(INADDR_ANY); - inaddr.sin_port = htons(port); - - if ((i = bind(sockd,(struct sockaddr*) &inaddr, sizeof(inaddr))) < 0) - return i; - - listen(sockd,5); - - return sockd; -} diff --git a/lib/ic/examples/erl-genserv/ReadMe b/lib/ic/examples/erl-genserv/ReadMe deleted file mode 100644 index cde588e269..0000000000 --- a/lib/ic/examples/erl-genserv/ReadMe +++ /dev/null @@ -1,30 +0,0 @@ -This is a short description on the use of the c-client demo, -a client that initiates and uses a random number generator -that lies on an Erlang-genserver. - -Instructions. - - On the erlang shell type : - -------------------------- - - ic:gen(random,[{be,erl_genserv}]). ( generates the plain code ) - - make:all(). ( compiles the erlang code ) - - {ok,R} = rmod_random:oe_create(). ( initializes the server ) - - - Running the example : - --------------------- - - rmod_random:init(R,1,2,3). ( initializes the generator ) - - rmod_random:produce(R). ( generates a random number ) - - - - - - - - diff --git a/lib/ic/examples/erl-genserv/random.idl b/lib/ic/examples/erl-genserv/random.idl deleted file mode 100644 index 969b24b749..0000000000 --- a/lib/ic/examples/erl-genserv/random.idl +++ /dev/null @@ -1,51 +0,0 @@ -// ``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. -// -// The Initial Developer of the Original Code is Ericsson Utvecklings AB. -// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -// AB. All Rights Reserved.'' -// -// $Id$ -// - -#ifndef _RANDOM_IDL -#define _RANDOM_IDL - - -module rmod { - - interface random { - - double produce(); - - oneway void init(in long seed1, in long seed2, in long seed3); - - }; - -}; - -#endif - - - - - - - - - - - - - - - diff --git a/lib/ic/examples/erl-genserv/rmod_random_impl.erl b/lib/ic/examples/erl-genserv/rmod_random_impl.erl deleted file mode 100644 index 9d9ca8afd4..0000000000 --- a/lib/ic/examples/erl-genserv/rmod_random_impl.erl +++ /dev/null @@ -1,64 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% --module('rmod_random_impl'). --export([init/1, terminate/2, start/0]). --export([produce/1,init/4]). - - -init(Env) -> - {ok, []}. - -terminate(From, Reason) -> - ok. - - -produce(_Random) -> - case catch random:uniform() of - {'EXIT',_} -> - true; - RUnif -> - {reply,RUnif,[]} - end. - - -init(_Random,S1,S2,S3) -> - case catch random:seed(S1,S2,S3) of - {'EXIT',_} -> - true; - _ -> - {noreply,[]} - end. - - -%% This starts up the random number server -start() -> - %% Start the gen server - {ok,Pid} = rmod_random:oe_create([],{local,'rmod_random_impl'}), - true. - - - - - - - - - diff --git a/lib/ic/examples/erl-plain/ReadMe b/lib/ic/examples/erl-plain/ReadMe deleted file mode 100644 index 26440b4d4f..0000000000 --- a/lib/ic/examples/erl-plain/ReadMe +++ /dev/null @@ -1,27 +0,0 @@ -This is a short description on the use of the erl-plain demo, -a client that initiates and uses a random number generator -that lies on an Erlang-genserver. - -Instructions. - - On the erlang shell type : - -------------------------- - - ic:gen(random,[{be,erl_plain}]). ( generates the plain code ) - - make:all(). ( compiles the erlang code ) - - - Running the example : - --------------------- - - rmod_random:init(1,2,3). ( initializes the generator ) - - rmod_random:produce(). ( generates a random number ) - - - - - - - diff --git a/lib/ic/examples/erl-plain/random.idl b/lib/ic/examples/erl-plain/random.idl deleted file mode 100644 index 606d91f6c5..0000000000 --- a/lib/ic/examples/erl-plain/random.idl +++ /dev/null @@ -1,53 +0,0 @@ -// ``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. -// -// The Initial Developer of the Original Code is Ericsson Utvecklings AB. -// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -// AB. All Rights Reserved.'' -// -// $Id$ -// -#pragma CODEOPT "[{be,c_genserv}]" - - -#ifndef _RANDOM_IDL -#define _RANDOM_IDL - - -module rmod { - - interface random { - - double produce(); - - oneway void init(in long seed1, in long seed2, in long seed3); - - }; - -}; - -#endif - - - - - - - - - - - - - - - diff --git a/lib/ic/examples/erl-plain/rmod_random_impl.erl b/lib/ic/examples/erl-plain/rmod_random_impl.erl deleted file mode 100644 index ee8623f82d..0000000000 --- a/lib/ic/examples/erl-plain/rmod_random_impl.erl +++ /dev/null @@ -1,33 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% --module('rmod_random_impl'). - --export([produce/0,init/3]). - - -produce() -> - random:uniform(). - - -init(S1,S2,S3) -> - random:seed(S1,S2,S3), - ok. - diff --git a/lib/ic/examples/java-client-server/ReadMe b/lib/ic/examples/java-client-server/ReadMe deleted file mode 100644 index 9fde464e09..0000000000 --- a/lib/ic/examples/java-client-server/ReadMe +++ /dev/null @@ -1,69 +0,0 @@ -This is a short description on the use of the java demo, -a client that initiates and uses a random number generator -that lies on a java-server. You will be able to shift the -existing client/server with the ones refered to the other -examples. - -Instructions. - -1) Start erlang - - On the erlang shell type : - -------------------------- - - ic:gen(random,[{be,java}]). ( generates the java code ) - - -2) Modify the "SNode" string on file "server.java" to the server - node name thet suites for your machine. - - -3) Modify the "SNode" string on file "client.java" to the client - node for your machine and the "PNode" string for the server - node ( = the same as the SNode for the "server.java" file ). - - -4) Set and export the CLASSPATH variable to point to the - java classes located in java development kit, the - Otp's classes and the current directory. - Your classpath should look like this : - - .:<OTPROOT>/lib/ic-4.0/priv/ic.jar:<OTPROOT>/lib/jinterface_1.1/priv/OtpErlang.jar - - where : - - <OTPROOT> is the location there OTP is installed - - -5) Start the empd deamon by using the command : - - epmd -daemon - - -6) Compile the generated java code : - - javac rmod/*.java ( compiles all generated java code ) - - javac *.java ( compiles all manually writen java code ) - - -7) Start the java on an terminal window : - - java server ( starts the java-server ) - - -8) Start the client on an terminal window : - - java client ( calls the server ) - - - - - - - - - - - - diff --git a/lib/ic/examples/java-client-server/client.java b/lib/ic/examples/java-client-server/client.java deleted file mode 100644 index 48b5bc4f60..0000000000 --- a/lib/ic/examples/java-client-server/client.java +++ /dev/null @@ -1,61 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -public class client { - - private static java.lang.String SNode = "client"; - private static java.lang.String PNode = "babbis"; - private static java.lang.String Cookie = "flash"; - private static java.lang.String Server = "rmod_random_impl"; - - private static rmod._randomStub stub; - - public static void main(String[] args) { - - try { - - stub = new rmod._randomStub(SNode,PNode,Cookie,Server); - int seed1 = 1; - int seed2 = 2; - int seed3 = 3; - double random = 0; - - System.out.print("\nClient initialization...."); - stub.init(seed1,seed2,seed3); - System.out.println("ok\n"); - - - for (int i = 0; i < 10; i++) { - random = stub.produce(); - System.out.println("Random" + i + " = " + random); - } - System.out.println("\nClient terminated.\n"); - - stub.__disconnect(); - - } catch( Exception e) { - System.out.println("Exception :"); - e.printStackTrace(); - } - - } - -} - diff --git a/lib/ic/examples/java-client-server/random.idl b/lib/ic/examples/java-client-server/random.idl deleted file mode 100644 index 7ce302a2e7..0000000000 --- a/lib/ic/examples/java-client-server/random.idl +++ /dev/null @@ -1,50 +0,0 @@ -// ``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. -// -// The Initial Developer of the Original Code is Ericsson Utvecklings AB. -// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -// AB. All Rights Reserved.'' -// -// $Id$ -// - -#ifndef _RANDOM_IDL -#define _RANDOM_IDL - -module rmod { - - interface random { - - double produce(); - - oneway void init(in long seed1, in long seed2, in long seed3); - - }; - -}; - -#endif - - - - - - - - - - - - - - - diff --git a/lib/ic/examples/java-client-server/server.java b/lib/ic/examples/java-client-server/server.java deleted file mode 100644 index 79618ba8be..0000000000 --- a/lib/ic/examples/java-client-server/server.java +++ /dev/null @@ -1,83 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -public class server { - - private static java.lang.String SNode = "babbis"; - private static java.lang.String Cookie = "flash"; - private static java.lang.String RegName = "rmod_random_impl"; - - public static void main(String[] args) { - - - System.out.println("\nServer running.\n"); - boolean serverState = true; - boolean recState = true; - - try { - - com.ericsson.otp.erlang.OtpServer self = new com.ericsson.otp.erlang.OtpServer(SNode, Cookie); - self.publishPort(); - - /* Server loop */ - while(serverState == true) { - - com.ericsson.otp.erlang.OtpConnection connection = self.accept(); - serverImpl srv = new serverImpl(); - com.ericsson.otp.erlang.OtpInputStream request; - com.ericsson.otp.erlang.OtpOutputStream reply; - com.ericsson.otp.erlang.OtpErlangPid client; - - /* Server loop */ - while(recState == true) { - - if (connection.isConnected() == true) - try { - - request = connection.receiveBuf(); - - reply = srv.invoke(request); - - if (reply != null) { - client = srv.__getCallerPid(); - - connection.sendBuf(client,reply); - } - - } catch( Exception e) { - System.out.println("Server terminated.\n\n"); - recState = false; - serverState = false; - } - } - - connection.close(); - } - - } catch( Exception e) { - System.out.println("Initialization exception :"); - e.printStackTrace(); - } - } -} - - - - diff --git a/lib/ic/examples/java-client-server/serverImpl.java b/lib/ic/examples/java-client-server/serverImpl.java deleted file mode 100644 index 336bc7e327..0000000000 --- a/lib/ic/examples/java-client-server/serverImpl.java +++ /dev/null @@ -1,43 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -public class serverImpl extends rmod._randomImplBase { - - java.util.Random random = null; - - - public void init(int seed1, int seed2, int seed3) throws java.lang.Exception { - - random = new java.util.Random(seed1+seed2+seed3); - }; - - - public double produce() throws java.lang.Exception { - - return random.nextDouble(); - } - -} - - - - - - diff --git a/lib/ic/examples/pre_post_condition/Makefile b/lib/ic/examples/pre_post_condition/Makefile deleted file mode 100644 index cd7e630724..0000000000 --- a/lib/ic/examples/pre_post_condition/Makefile +++ /dev/null @@ -1,135 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-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% -# -# -# ``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. -# -# The Initial Developer of the Original Code is Ericsson Utvecklings AB. -# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -# AB. All Rights Reserved.'' -# -# $Id$ -# -include $(ERL_TOP)/make/target.mk - -EBIN= ./ - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(IC_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -IDL_FILES = \ - ex.idl - -GEN_ERL_MODULES = \ - oe_ex \ - m_i \ - m_NotAnInteger - -MODULES= \ - m_i_impl \ - tracer - -GEN_HRL_FILES = \ - oe_ex.hrl \ - m.hrl \ - m_i.hrl - -HRL_FILES = -TXT_FILES = ReadMe.txt - -ERL_FILES= $(MODULES:%=%.erl) - - -TARGET_FILES = \ - $(GEN_ERL_MODULES:%=$(EBIN)/%.$(EMULATOR)) \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_LOCAL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin -# The -pa option is just used temporary until erlc can handle -# includes from other directories than ../include . -ERL_COMPILE_FLAGS += \ - $(ERL_LOCAL_FLAGS) \ - -pa $(ERL_TOP)/lib/orber -I$(ERL_TOP)/lib/orber -YRL_FLAGS = - - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -debug opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED - rm -f errs core *~ - -docs: - -test: $(TEST_TARGET_FILES) - - -IDL-GENERATED: ex.idl - $(gen_verbose)erlc $(ERL_LOCAL_FLAGS) +'{precond,{tracer,pre}}' \ - +'{{postcond,"m::i::f"},{tracer,post}}' ex.idl - $(V_at)>IDL-GENERATED - -$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): IDL-GENERATED - -$(TARGET_FILES): IDL-GENERATED - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/examples/pre_post_condition" - $(INSTALL_DATA) $(ERL_FILES) $(IDL_FILES) $(TXT_FILES) "$(RELSYSDIR)/examples/pre_post_condition" - - -release_docs_spec: - - diff --git a/lib/ic/examples/pre_post_condition/ReadMe.txt b/lib/ic/examples/pre_post_condition/ReadMe.txt deleted file mode 100644 index 2fb3f0a04f..0000000000 --- a/lib/ic/examples/pre_post_condition/ReadMe.txt +++ /dev/null @@ -1,74 +0,0 @@ - ``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. - - The Initial Developer of the Original Code is Ericsson Utvecklings AB. - Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings - AB. All Rights Reserved.'' - - $Id$ - - -This example shows how pre and post condition can be used for a Corba server object. - - -The example consists of three files; - -ex.idl - the interface specification -m_i_impl.erl - the server implementation -tracer.erl - a module which contains a pre and a post condition - - -The IDL file can for example be compiled with the following options: - -ic:gen(ex, [{precond, {tracer, pre}},{{postcond, "m::i::f"}, {tracer, post}}]). - -The result is that the function m::i::f gets both a pre and post condition call while -the function m::i::g just get a pre condition call. - - -A pre/post condition function should always return the atom ok and if something is wrong -it should raise an exception ( ex: corba:raise(#userexception{}) ). - - - - -Compile all erlang files and test the application. - -First start an erlang node, then type the following commands in the erlang shell. - -1> mnesia:create_schema([]). -2> orber:install([]). -3> orber:start(). -3> -3> X = m_i:oe_create(). -4> catch m_i:f(X, 17). -Precond called in process <0.139.0>: m_i:f() [[],17] -f working .... -Postcond called in process <0.139.0>: m_i:f() [[],17] {reply,{17,17},[]} -17 -5> -5> catch m_i:f(X, q). -6> {'EXCEPTION',{m_NotAnInteger,"IDL:m/NotAnInteger:1.0"}} -7> -7>m_i:g(X, 17). -Precond called in process <0.139.0>: m_i:g() [[],17] -ok -g working .... -8> -8>corba_boa:dispose(X). -9> orber:stop(). -10> - - - - - diff --git a/lib/ic/examples/pre_post_condition/ex.idl b/lib/ic/examples/pre_post_condition/ex.idl deleted file mode 100644 index 29298c8efb..0000000000 --- a/lib/ic/examples/pre_post_condition/ex.idl +++ /dev/null @@ -1,30 +0,0 @@ -// ``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. -// -// The Initial Developer of the Original Code is Ericsson Utvecklings AB. -// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -// AB. All Rights Reserved.'' -// -// $Id$ -// - -module m { - - exception NotAnInteger {}; - - interface i { - short f(in short i); - oneway void g(in long i); - }; - -}; - diff --git a/lib/ic/examples/pre_post_condition/m_i_impl.erl b/lib/ic/examples/pre_post_condition/m_i_impl.erl deleted file mode 100644 index fa6d9675a2..0000000000 --- a/lib/ic/examples/pre_post_condition/m_i_impl.erl +++ /dev/null @@ -1,50 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% -%%------------------------------------------------------------ -%% -%% Example -%% -%%------------------------------------------------------------ --module(m_i_impl). - -%% Standard functions --export([init/1, terminate/2]). -%% Interface functions --export([f/2, g/2]). - -init(_Env) -> - {ok, []}. - -terminate(_From, _Reason) -> - ok. - -f(State, In) -> - io:format("f working ....\n", []), - {reply, In, State}. - -g(State, _In) -> - io:format("g working ....\n", []), - {noreply, State}. - - - - - diff --git a/lib/ic/examples/pre_post_condition/tracer.erl b/lib/ic/examples/pre_post_condition/tracer.erl deleted file mode 100644 index c64459f4fd..0000000000 --- a/lib/ic/examples/pre_post_condition/tracer.erl +++ /dev/null @@ -1,57 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% -%%----------------------------------------------------------------- -%% File: tracer.erl -%% -%% Description: -%% This file contains an example of pre and post conditions for -%% the corba backend. -%% -%%----------------------------------------------------------------- --module(tracer). --include("m.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([pre/3, post/4]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- -pre(M, F, [State, I]) when is_integer(I) -> - io:format("Precond called in process ~p: ~s:~s() ~p\n", [self(), M, F, [State, I]]), - ok; -pre(_M, _F, _A) -> %% Just an silly example to get an exception case - corba:raise(#'m_NotAnInteger'{}). - -post(M, F, A, R) -> - io:format("Postcond called in process ~p: ~s:~s() ~p ~p\n", [self(), M, F, A, R]), - ok. - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/include/erlang.idl b/lib/ic/include/erlang.idl deleted file mode 100644 index 87d1247b87..0000000000 --- a/lib/ic/include/erlang.idl +++ /dev/null @@ -1,58 +0,0 @@ -// ``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. -// -// The Initial Developer of the Original Code is Ericsson Utvecklings AB. -// Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -// AB. All Rights Reserved.'' -// -// $Id$ -// - -#ifndef _ERLANG_IDL_ -#define _ERLANG_IDL_ - -module erlang -{ - - // an erlang pid - struct pid { - string<256> node; - unsigned long num; - unsigned long serial; - unsigned long creation; - }; - - // an erlang port - struct port { - string<256> node; - unsigned long id; - unsigned long creation; - }; - - // port and ref have identical structure - struct ref { - string<256> node; - unsigned long id; - unsigned long creation; - }; - - - // an erlang term - typedef any term; - - - // an erlang binary - typedef sequence<octet> binary; - -}; - -#endif diff --git a/lib/ic/include/ic.h b/lib/ic/include/ic.h deleted file mode 100644 index 3dc5dbd4b5..0000000000 --- a/lib/ic/include/ic.h +++ /dev/null @@ -1,432 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1998-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% - * - */ -#include <stdlib.h> -#include <string.h> -#include <assert.h> -#include <ei.h> -#include <erl_interface.h> - -#ifdef __WIN32__ -/* Windows.h #defines interface to struct, get rid of it! */ -#ifdef interface -#undef interface -#endif -#endif - -#ifndef __IC_H__ -#define __IC_H__ - -#ifdef __cplusplus -extern "C" { -#endif - -/* Standard type mapping */ - -#ifndef __CORBA_SHORT__ -#define __CORBA_SHORT__ - typedef short CORBA_short; -#endif - -#ifndef __CORBA_LONG__ -#define __CORBA_LONG__ - typedef long CORBA_long; -#endif - -/* CORBA_long_long = long because of erl_interface limitation */ -#ifndef __CORBA_LONG_LONG__ -#define __CORBA_LONG_LONG__ - typedef long CORBA_long_long; /* LONG LONG */ -#endif - -#ifndef __CORBA_UNSIGNED_SHORT__ -#define __CORBA_UNSIGNED_SHORT__ - typedef unsigned short CORBA_unsigned_short; -#endif - -#ifndef __CORBA_UNSIGNED_LONG__ -#define __CORBA_UNSIGNED_LONG__ - typedef unsigned long CORBA_unsigned_long; -#endif - -/* CORBA_unsigned long_long = unsigned long because of erl_interface - limitation */ - -#ifndef __CORBA_UNSIGNED_LONG_LONG__ -#define __CORBA_UNSIGNED_LONG_LONG__ - typedef unsigned long CORBA_unsigned_long_long; -#endif - -#ifndef __CORBA_FLOAT__ -#define __CORBA_FLOAT__ - typedef float CORBA_float; -#endif - -#ifndef __CORBA_DOUBLE__ -#define __CORBA_DOUBLE__ - typedef double CORBA_double; -#endif - - -#ifndef __CORBA_LONG_DOUBLE__ -#define __CORBA_LONG_DOUBLE__ - typedef double CORBA_long_double; -#endif - -#ifndef __CORBA_CHAR__ -#define __CORBA_CHAR__ - typedef char CORBA_char; -#endif - -#ifndef __CORBA_WCHAR__ -#define __CORBA_WCHAR__ - typedef unsigned long CORBA_wchar; -#endif - -#ifndef __CORBA_BOOLEAN__ -#define __CORBA_BOOLEAN__ - typedef unsigned char CORBA_boolean; -#endif - -#ifndef __CORBA_OCTET__ -#define __CORBA_OCTET__ - typedef char CORBA_octet; -#endif - -#ifndef CORBA_enum -#define CORBA_enum enum -#endif - -#ifndef __ERLANG_BINARY__ -#define __ERLANG_BINARY__ - typedef struct { - CORBA_unsigned_long _maximum; - CORBA_unsigned_long _length; - CORBA_octet* _buffer; - } erlang_binary; -#endif - - -/* Object definition */ - typedef void* CORBA_Object; - - -/* Exception discriminators */ -#ifndef CORBA_NO_EXCEPTION -#define CORBA_NO_EXCEPTION 0 -#endif - -#ifndef CORBA_SYSTEM_EXCEPTION -#define CORBA_SYSTEM_EXCEPTION -1 -#endif - -#ifndef CORBA_USER_EXCEPTION -#define CORBA_USER_EXCEPTION -2 -#endif - -/* System exceptions */ - -#define UNKNOWN "UNKNOWN" -#define BAD_PARAM "BAD_PARAM" -#define NO_MEMORY "NO_MEMORY" -#define IMPL_LIMIT "IMP_LIMIT" -#define COMM_FAILURE "COMM_FAILURE" -#define INV_OBJREF "INV_OBJREF" -#define NO_PERMISSION "NO_PERMISSION" -#define INTERNAL "INTERNAL" -#define MARSHAL "MARSHAL" -#define INITIALIZE "INITIALIZE" -#define NO_IMPLEMENT "NO_IMPLEMENT" -#define BAD_TYPECODE "BAD_TYPECODE" -#define BAD_OPERATION "BAD_OPERATION" -#define NO_RESOURCES "NO_RESOURCES" -#define NO_RESPONSE "NO_RESPONSE" -#define PERSIST_STORE "PERSIST_STORE" -#define BAD_INV_ORDER "BAD_INV_ORDER" -#define TRANSIENT "TRANSIENT" -#define FREE_MEM "FREE_MEM" -#define INV_IDENT "INV_IDENT" -#define INV_FLAG "INV_FLAG" -#define INTF_REPOS "INTF_REPOS" -#define BAD_CONTEXT "BAD_CONTEXT" -#define OBJ_ADAPTER "OBJ_ADAPTER" -#define DATA_CONVERSION "DATA_CONVERSION" -#define OBJ_NOT_EXIST "OBJECT_NOT_EXIST" - - - -/* Exception type */ - typedef int CORBA_exception_type; - - -#ifndef __CORBA_ENVIRONMENT__ -#define __CORBA_ENVIRONMENT__ - -/* Environment definition */ - typedef struct { - - /*----- CORBA compatibility part ------------------------------------*/ - CORBA_exception_type _major; /* Exception tag, initially set - to CORBA_NO_EXCEPTION */ - - /*----- External Implementation part - initiated by the user --------*/ - int _fd; /* File descriptor */ - int _inbufsz; /* Size of input buffer */ - char *_inbuf; /* Pointer to always - dynamically allocated - buffer for input */ - int _outbufsz; /* Size of output buffer */ - char *_outbuf; /* Pointer to always - dynamically - allocated buffer - for output */ - int _memchunk; /* Size of memory - chunks in bytes, - used for increasing - the output buffer, - set to >= 32, - should be around >= - 1024 for - performance reasons */ - char _regname[256]; /* Pointer for - registered name */ - erlang_pid *_to_pid; /* Process identity - for caller */ - erlang_pid *_from_pid; /* Process identity - for callee */ - /*----- Internal Implementation part - used by the server/client ----*/ - int _iin; /* Index for input buffer */ - int _iout; /* Index for output buffer */ - char _operation[256]; /* Pointer for operation name*/ - int _received; /* Used to count parameters */ - erlang_pid _caller; /* Used to identify - the caller*/ - erlang_ref _unique; /* Used to identify the call */ - CORBA_char *_exc_id; /* Exception id field */ - void *_exc_value; /* Exception value field */ - - unsigned int _ref_counter_1; /* Counter for reference */ - unsigned int _ref_counter_2; /* Counter for reference */ - unsigned int _ref_counter_3; /* Counter for reference */ - - } CORBA_Environment; - -#endif - - -/* Corba standard functions */ - - void CORBA_free(void *); - CORBA_char *CORBA_string_alloc(CORBA_unsigned_long); - CORBA_wchar *CORBA_wstring_alloc(CORBA_unsigned_long); - CORBA_char *CORBA_exception_id(CORBA_Environment *env); - void *CORBA_exception_value(CORBA_Environment *env); - void CORBA_exception_free(CORBA_Environment *env); - void CORBA_exc_set(CORBA_Environment *env, - CORBA_exception_type Major, - CORBA_char *Id, - CORBA_char *Value); - CORBA_Environment *CORBA_Environment_alloc(int inbufsz, int outbufsz); - void ic_init_ref(CORBA_Environment *env, erlang_ref *ref); - int ic_compare_refs(erlang_ref *ref1, erlang_ref *ref2); - -/* Used internally */ - -#define __OE_MEMCHUNK__ 1024 -#define __OE_VSNSZ__ 1 -#define __OE_LONGSZ__ 7 -#define __OE_LONGLONGSZ__ 7 -#define __OE_ULONGSZ__ 7 -#define __OE_ULONGLONGSZ__ 7 -#define __OE_DOUBLESZ__ 32 -#define __OE_CHARSZ__ 2 -#define __OE_WCHARSZ__ 7 -#define __OE_TUPLEHDRSZ__ 5 -#define __OE_LISTHDRSZ__ 5 - -/* The actual size of a wide char (used to be #define __OE_WCHAR_SIZE_OF__ 4) */ -#define __OE_WCHAR_SIZE_OF__ sizeof(CORBA_wchar) - -/* Size check macro */ -#define OE_MALLOC_SIZE_CHECK(env,x) { \ - assert((x) > 0); \ - if (!((x) > 0)) { \ - CORBA_exc_set((env), CORBA_SYSTEM_EXCEPTION, INTERNAL, \ - "Bad malloc size calculation"); \ - return -1; \ - } \ -} - -/* Exec function -- probably not needed */ - typedef int oe_exec_function_t(CORBA_Object, CORBA_Environment*); -/* These are for backward compatibility */ - typedef oe_exec_function_t ___exec_function___; - typedef oe_exec_function_t ___generic___; - -/* Operation declaration */ - typedef struct { - char *interface; - char *name; - oe_exec_function_t *function; - } oe_operation_t; - -/* For backward compatibility */ - typedef oe_operation_t ___operation___; - -/* Map declaration */ - typedef struct { - int length; - oe_operation_t *operations; - } oe_map_t; -/* For backward compatibility */ - typedef oe_map_t ___map___; - -/* Align macro */ -#define OE_ALIGN(x) (((x) + sizeof(double) - 1) & ~(sizeof(double) - 1)) - -/* Encoders */ - int oe_ei_encode_version(CORBA_Environment *env); - int oe_ei_encode_long(CORBA_Environment *env, long p); - int oe_ei_encode_longlong(CORBA_Environment *env, CORBA_long_long p); - int oe_ei_encode_ulong(CORBA_Environment *env, unsigned long p); - int oe_ei_encode_ulonglong(CORBA_Environment *env, - CORBA_unsigned_long_long p); - int oe_ei_encode_double(CORBA_Environment *env, double p); - int oe_ei_encode_char(CORBA_Environment *env, char p); - int oe_ei_encode_wchar(CORBA_Environment *env, CORBA_wchar p); - int oe_ei_encode_string(CORBA_Environment *env, const char *p); - int oe_ei_encode_wstring(CORBA_Environment *env, CORBA_wchar *p); - int oe_ei_encode_atom(CORBA_Environment *env, const char *p); - int oe_ei_encode_pid(CORBA_Environment *env, const erlang_pid *p); - int oe_ei_encode_port(CORBA_Environment *env, const erlang_port *p); - int oe_ei_encode_ref(CORBA_Environment *env, const erlang_ref *p); - int oe_ei_encode_term(CORBA_Environment *env, void *t); - int oe_ei_encode_tuple_header(CORBA_Environment *env, int arity); - int oe_ei_encode_list_header(CORBA_Environment *env, int arity); - int oe_encode_erlang_binary(CORBA_Environment *env, erlang_binary *binary); - -#define oe_ei_encode_empty_list(ev) oe_ei_encode_list_header(ev,0) - -/* Decoders */ - int oe_ei_decode_wchar(const char *buf, int *index, CORBA_wchar *p); - int oe_ei_decode_wstring(const char *buf, int *index, CORBA_wchar *p); - int oe_ei_decode_longlong(const char *buf, int *index, CORBA_long_long *p); - int oe_ei_decode_ulonglong(const char *buf, int *index, - CORBA_unsigned_long_long *p); - int oe_decode_erlang_binary(CORBA_Environment *env, char *buf, int *index, - erlang_binary *binary); - -/* Generic client encoders (gen_server protocol) */ - int oe_prepare_notification_encoding(CORBA_Environment *env); - int oe_prepare_request_encoding(CORBA_Environment *env); - -/* Generic client decoders (gen_server protocol) */ - int oe_prepare_reply_decoding(CORBA_Environment *env); - -/* Generic client send and receive functions (Erlang distribution protocol) */ - int oe_send_notification(CORBA_Environment *env); - int oe_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms); - int oe_send_request_and_receive_reply(CORBA_Environment *env); - int oe_send_request_and_receive_reply_tmo(CORBA_Environment *env, - unsigned int send_ms, - unsigned int recv_ms); - -/* Generic server decoder */ - int oe_prepare_request_decoding(CORBA_Environment *env); - -/* Generic server encoder */ - int oe_prepare_reply_encoding(CORBA_Environment *env); - -/* -------- */ - -/* Generic server receive (possibly send reply) */ - int oe_server_receive(CORBA_Environment *env, oe_map_t *map); - int oe_server_receive_tmo(CORBA_Environment *env, oe_map_t *map, - unsigned int send_ms, - unsigned int recv_ms); - -/* -------- */ - -/* Size calculators */ - int oe_sizecalc_erlang_binary(CORBA_Environment *env, int *index, - int *size); -/* Print functions */ - int print_erlang_binary(erlang_binary*); - -/* Length counter for wide strings */ - int ic_wstrlen(CORBA_wchar * p); - -/* Wide string comparison */ - int ic_wstrcmp(CORBA_wchar * ws1, CORBA_wchar * ws2); - -/* Put for 64-bits integer type */ -#define put64le(s,n) do { \ - (s)[0] = (n) & 0xff; \ - (s)[1] = ((n) >> 8) & 0xff; \ - (s)[2] = ((n) >> 16) & 0xff; \ - (s)[3] = ((n) >> 24) & 0xff; \ - (s)[4] = ((n) >> 32) & 0xff; \ - (s)[5] = ((n) >> 40) & 0xff; \ - (s)[6] = ((n) >> 48) & 0xff; \ - (s)[7] = ((n) >> 56) & 0xff; \ - (s)[8] = ((n) >> 64) & 0xff; \ - (s) += 8; \ -} while (0) - -/* Get for 64-bits integer type */ -#define get64le(s) \ - ((s) += 8, \ - ((((unsigned char *)(s))[-1] << 56) | \ - (((unsigned char *)(s))[-2] << 48) | \ - (((unsigned char *)(s))[-3] << 40) | \ - (((unsigned char *)(s))[-4] << 32) | \ - (((unsigned char *)(s))[-5] << 24) | \ - (((unsigned char *)(s))[-6] << 16) | \ - (((unsigned char *)(s))[-7] << 8) | \ - ((unsigned char *)(s))[-8])) - - - -/* Exec function switch */ - int oe_exec_switch(CORBA_Object, CORBA_Environment*, oe_map_t*); -/* For backward compatibility */ - int ___switch___(CORBA_Object, CORBA_Environment*, oe_map_t*); - -/* For backward compatibility -- replaced by oe_prepare_request_decoding() */ - int ___call_info___(CORBA_Object, CORBA_Environment*); - -/* Map merging */ - oe_map_t* oe_merge_maps(oe_map_t*, int); -/* For backward compatibility */ - oe_map_t* ___merge___(oe_map_t*, int); - -/* Macro for error reporting */ - -#ifdef OE_C_REPORT -#define OE_RPT_ERR(x) fprintf(stderr, (x)) -#else -#define OE_RPT_ERR(x) -#endif - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/lib/ic/info b/lib/ic/info deleted file mode 100644 index 96cb88d01f..0000000000 --- a/lib/ic/info +++ /dev/null @@ -1,2 +0,0 @@ -group: orb Object Request Broker & IDL Applications -short: IDL compiler diff --git a/lib/ic/internal_doc/c-improvements-1.txt b/lib/ic/internal_doc/c-improvements-1.txt deleted file mode 100644 index ccfdec7cbe..0000000000 --- a/lib/ic/internal_doc/c-improvements-1.txt +++ /dev/null @@ -1,84 +0,0 @@ -Peter Hogfeldt 2003-08-14 PA1 - -IC C BACK-ENDS IMPROVEMENTS - -1 C CLIENT - -1.1 Cast - - Each oneway operation roughly consists of the following code - parts: - - - encoding the cast message - - setting index of the out buffer to zero (1.1.1) - - encoding the magic (1.1.1) - - encoding a tuple header of size 2 (1.1.1) - - encoding '$gen_cast' (1.1.1) - - encoding the operation parameters (1.1.2) - - sending the cast message (1.1.3) - - Only (1.1.2) is unique for the operation in question. - -1.1.1 Todo - - Define functions: - - int oe_ei_encode_cast(CORBA_environment *) that performs (1.1.1) - - int oe_ei_cast(CORBA_environment *) that performs (1.1.3) - - This will reduce code size. - - As compiler options - - oe_ei_encode_cast(), and - oe_ei_cast() - - may be replaced by user defined functions. - -1.2 Call - - Each (non-oneway) operation roughly consists of the following code - parts: - - - encoding the call message - - setting index of the out buffer to zero (1.2.1) - - encoding the magic (1.2.1) - - encoding a tuple header of size 3 (1.2.1) - - encoding '$gen_call' (1.2.1) - - encoding a tuple header of size 2 (1.2.1) - - encoding the from pid (1.2.1) - - encoding the unique ref (1.2.1) - - encoding the operation parameters (1.2.2) - - sending the call message (1.2.3) - - receiving the reply message (1.2.3) - - decoding the reply parameters (1.2.4) - - Only (1.2.2) and (1.2.4) are unique for the operation in question. - -1.2.1 Todo - - Define functions: - - int oe_ei_encode_send(CORBA_environment *) that performs (1.2.1) - - int oe_ei_send_and_receive(CORBA_environment *) that performs (1.2.3) - - This will reduce code size. - - As compiler options - - oe_ei_encode_send(), and - oe_ei_send_and_receive() - - may be replaced by user defined function. - - -2 SERVER - - We do not provide any code for receiving operation messages, execute - operations, and send the result back. Should we not do that? - - - -
\ No newline at end of file diff --git a/lib/ic/internal_doc/protocol.txt b/lib/ic/internal_doc/protocol.txt deleted file mode 100644 index 54e1ef55cf..0000000000 --- a/lib/ic/internal_doc/protocol.txt +++ /dev/null @@ -1,182 +0,0 @@ -Peter Hogfeldt 2003-08-18 PA3 - -THE IC PROTOCOL - -1 INTRODUCTION - - The IDL Compiler (IC) transforms Interface Definition Language - (IDL) specifications files to interface code for Erlang, C, and - Java. The Erlang language mapping is described in the Orber - documentation, while the other mappings are described in the IC - documentation (they are of course in accordance with the CORBA C - and Java language mapping specifications, with some restrictions). - - The most important parts of an IDL specification are the operation - declarations. An operation defines what information a client - provides to a server, and what information (if any) the client - gets back from the server. We consider IDL operations and language - mappings in section 2. - - What we here call the IC protocol, is the description of messages - exchanged between IC end-points (client and servers). It is valid - for all IC back-ends, except the 'erl_plain' and 'erl_corba' - back-ends. The protocol is described in section 3. - - The IC protocol is in turn embedded into the Erlang gen_server - protocol, which is described in section 4. - - Finally, the gen_server protocol is embedded in the Erlang - distribution protocol. Pertinent parts of that protocol is - described in section 5. - - -2 LANGUAGE MAPPINGS AND IDL OPERATIONS - -2.1 IDL Operations - - An IDL operation is declared as follows: - - [oneway] RetType Op(in IType1 I1, in IType2 I2, ..., in ITypeN IN, - out OType1 O1, out OType2 O2, ..., out OTypeM OM) - N, M = 0, 1, 2, ... (2.1.1) - - `Op' is the operation name, RetType is the return type, and ITypei, - i = 1, 2, ..., N, and OTypej, j = 1, 2, ..., M, are the `in' types - and `out' types, respectively. The values I1, I2, ..., IN are - provided by the caller, and the value of RetType, and the values - O1, O2, ..., OM, are provided as results to the caller. - - The types can be any basic types or derived types declared in the - IDL specification of which the operation declaration is a part. - - If the RetType has the special name `void' there is no return - value (but there might still be result values O1, 02, ..., OM). - - The `in' and `out' parameters can be declared in any order, but - for clarity we have listed all `in' parameters before the `out' - parameters in the declaration above. - - If the keyword `oneway' is present, the operation is a cast, i.e. - there is no confirmation of the operation, and consequently there - must be no result values: RetType must be equal to `void', and M = - 0 must hold. - - Otherwise the operation is a call, i.e. it is confirmed (or else - an exception is raised). - - Note carefully that an operation declared without `oneway' is - always a call, even if RetType is `void' and M = 0. - -2.2 Language Mappings - - There are several CORBA Language Mapping specifications. These are - about mapping interfaces to various programming languages. IC - supports the CORBA C and Java mapping specifications, and the - Erlang language mapping specified in the Orber documentation. - - Excerpt from "6.4 Basic OMG IDL Types" in the Orber User's Guide: - - Functions with return type void will return the atom ok. - - Excerpt from "6.13 Invocations of Operations" in the Orber User's Guide: - - A function call will invoke an operation. The first parameter - of the function should be the object reference and then all in - and inout parameters follow in the same order as specified in - the IDL specification. The result will be a return value - unless the function has inout or out parameters specified; in - which case, a tuple of the return value, followed by the - parameters will be returned. - - Hence the function that is mapped from an IDL operation to Erlang - always have a return value (an Erlang function always has). That - fact has influenced the IC protocol, in that there is always a - return value (which is 'ok' if the return type was declared 'void'). - - -3 IC PROTOCOL - - Given the operation declaration (2.1.1) the IC protocol maps to - messages as follows, defined in terms of Erlang terms. - -3.1 Call (Request/Reply, i.e. not oneway) - - request: Op atom() N = 0 - {Op, I1, I2, ..., IN} tuple() N > 0 - (3.1.1) - - reply: Ret M = 0 - {Ret, O1, O2, ..., OM} M > 0 - (3.1.2) - - Notice; Even if the RetType of the operation Op is declared to be - 'void', a return value 'ok' is returned in the reply message. That - return value is of no significance, and is therefore ignored (note - however that a C server back-end returns the atom 'void' instead - of 'ok'). - -3.2 Cast (oneway) - - notification: Op atom() N = 0 - {Op, I1, I2, ..., IN} tuple() N > 0 - (3.2.1) - (There is of course no return message). - -3.3 Propagation of Exceptions - - Currently there is no propagation of exceptions from the server to - the client. As it is now a an exception detected by the server - will hang the client in a receive. That is unacceptable. - - Exception propagation is only meaningful for Call (request/reply). - - -4 GEN_SERVER PROTOCOL - - Most of the IC generated code deals with encoding and decoding the - gen_server protocol. - -4.1 Call - - request: {'$gen_call', {self(), Ref}, Request} (4.1.1) - - reply: {Ref, Reply} (4.1.2) - - where Request and Reply are the messages defined in 3.1 Call. - -4.2 Cast - - notification: {'$gen_cast', Notification} (4.2.1) - - where Notification is the message defined in 3.2 Cast. - - -5 ERLANG DISTRIBUTION PROTOCOL - - Messages (of interest here) between Erlang nodes are of the form: - - Len(4), Type(1), CtrlBin(N), MsgBin(M) (5.1) - - Type is equal to 112 = PASS_THROUGH. - - CtrlBin and MsgBin are Erlang terms in binary form (as if created - by term_to_binary/1), whence for each of them the first byte is - equal to 131 = VERSION_MAGIC. - - CtrlBin (of interest here) contains the SEND and REG_SEND control - messages, which are binary forms of the Erlang terms - - {2, Cookie, ToPid} , (5.2) - - and - - {6, FromPid, Cookie, ToName} , (5.3) - - respectively. - - The CtrlBin(N) message is read and written by erl_interface code - (C), j_interface code (Java), or the Erlang distribution - implementation, which are invoked from IC generated code. - - The MsgBin(N) is the "real" message, i.e. of the form described - in section 4. diff --git a/lib/ic/java_src/Makefile b/lib/ic/java_src/Makefile deleted file mode 100644 index 86d1e54fff..0000000000 --- a/lib/ic/java_src/Makefile +++ /dev/null @@ -1,42 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-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% -# -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(ORBER_VSN) - -# ---------------------------------------------------- -# Common Macros -# ---------------------------------------------------- - -SUB_DIRECTORIES = com/ericsson/otp/ic - -SPECIAL_TARGETS = - -# ---------------------------------------------------- -# Default Subdir Targets -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_subdir.mk - diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Any.java b/lib/ic/java_src/com/ericsson/otp/ic/Any.java deleted file mode 100644 index d90b942877..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/Any.java +++ /dev/null @@ -1,1026 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - - -/** - -The Any class is the java mapping of the any OMG-IDL type. - - -**/ - - -public class Any { - - // Typecode value holder - protected TypeCode tcV; - - // Primitive value holder - protected java.lang.String stringV; - protected byte byteV; - protected boolean booleanV; - protected char charV; - protected short shortV; - protected int intV; - protected long longV; - protected float floatV; - protected double doubleV; - - // Streams used for user defined types - protected com.ericsson.otp.erlang.OtpInputStream is; - protected com.ericsson.otp.erlang.OtpOutputStream os; - - - // Constructor - public Any() { - tcV = null; - } - - // Equal function - - /** - Any comparison method - @return true if the input Any is equal to the object, false otherwize - **/ - public boolean equal(com.ericsson.otp.ic.Any _any) { - - int _is1Len,_is2Len; - byte _compressed[]; - com.ericsson.otp.erlang.OtpInputStream _is1,_is2; - TypeCode _tc = _any.type(); - - if (!tcV.equal(_tc)) - return false; - - try { - - TCKind _tck = _tc.kind(); - - switch (_tck.value()) { - - case TCKind._tk_short: - return (_any.extract_short() == shortV); - - case TCKind._tk_ushort: - return (_any.extract_ushort() == shortV); - - case TCKind._tk_long: - return (_any.extract_long() == intV); - - case TCKind._tk_longlong: - return (_any.extract_longlong() == longV); - - case TCKind._tk_ulong: - return (_any.extract_ulong() == intV); - - case TCKind._tk_ulonglong: - return (_any.extract_ulonglong() == longV); - - case TCKind._tk_float: - return equal(_any.extract_float(),floatV); - - case TCKind._tk_double: - return equal(_any.extract_double(),doubleV); - - case TCKind._tk_boolean: - return (_any.extract_boolean() == booleanV); - - case TCKind._tk_char: - return (_any.extract_char() == charV); - - case TCKind._tk_wchar: - return (_any.extract_wchar() == charV); - - case TCKind._tk_octet: - return (_any.extract_octet() == byteV); - - case TCKind._tk_string: - return (_any.extract_string().compareTo(stringV) == 0); - - case TCKind._tk_wstring: - return (_any.extract_wstring().compareTo(stringV) == 0); - - case TCKind._tk_sequence: - - _is1 = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); - - _is2 = _any.extract_Streamable(); - - if (_is1.peek() != _is2.peek()) { - - // _is1's sequence is compressed to string - if(_is1.peek() == com.ericsson.otp.erlang.OtpExternal.stringTag) { - - _compressed = (_is1.read_string()).getBytes(); - _is1Len = _compressed.length; - - _is2.read_list_head(); - - for(int i = 0; i < _is1Len; i++) { - if ((long)(_compressed[i] & 0xff) != _is2.read_long()) - return false; - } - - _is2.read_nil(); - } - else { // _is2's sequence is compressed to string - - _compressed = (_is2.read_string()).getBytes(); - _is2Len = _compressed.length; - - _is1.read_list_head(); - - for(int i = 0; i < _is2Len; i++) - if ((long)(_compressed[i] & 0xff) != _is1.read_long()) - return false; - - _is1.read_nil(); - } - } - else { // None of them is compressed - - _is2Len = _is2.available(); - - if (_is1.available() != _is2Len) - return false; - - for(int i = 0; i < _is2Len; i++) { - if (_is1.read() != _is2.read()) - return false; - } - } - - return true; - - case TCKind._tk_struct: - case TCKind._tk_union: - case TCKind._tk_array: - case TCKind._tk_enum: - - _is1 = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); - - _is2 = _any.extract_Streamable(); - - _is2Len = _is2.available(); - - if (_is1.available() != _is2Len) - return false; - - for(int i = 0; i < _is2Len; i++) { - if (_is1.read() != _is2.read()) - return false; - } - - return true; - - // Not used in real - case TCKind._tk_any: - case TCKind._tk_void: - case TCKind._tk_atom: - case TCKind._tk_null: - case TCKind._tk_TypeCode: - case TCKind._tk_Principal: - case TCKind._tk_objref: - case TCKind._tk_alias: - case TCKind._tk_except: - case TCKind._tk_longdouble: - case TCKind._tk_fixed: - return true; - - default : - return false; - - } - } catch (Exception e) { - //e.printStackTrace(); - return false; - } - - } - - - /* Equal function for floats ( relative diff ) */ - boolean equal(float x, float y) { - - if (x != 0) - return (java.lang.Math.abs((x-y)/x) < 1.0E-15); - - if (y != 0) - return (java.lang.Math.abs((y-x)/y) < 1.0E-15); - - return (x==y); - } - - /* Equal function for doubles ( relative diff ) */ - boolean equal(double x, double y) { - - if (x != 0) - return (java.lang.Math.abs((x-y)/x) < 1.0E-15); - - if (y != 0) - return (java.lang.Math.abs((y-x)/y) < 1.0E-15); - - return (x==y); - } - - - - /** - TypeCode accessor method - @return the Any's TypeCode - **/ - public TypeCode type() { - return tcV; - } - - - /** - TypeCode insertion method - **/ - public void type(TypeCode _tc) { - tcV = _tc; - } - - - /* Value accessors */ - - /** - Reads a value from the stream, according to the inserted TypeCode - **/ - public void read_value(com.ericsson.otp.erlang.OtpInputStream _is, - TypeCode _tc) - throws java.lang.Exception { - - tcV = _tc; - - switch(tcV.kind().value()) { - - case TCKind._tk_short : - shortV = _is.read_short(); - break; - case TCKind._tk_ushort : - shortV = _is.read_ushort(); - break; - case TCKind._tk_long : - intV = _is.read_int(); - break; - case TCKind._tk_ulong : - intV = _is.read_uint(); - break; - case TCKind._tk_longlong : - longV = _is.read_long(); - break; - case TCKind._tk_ulonglong : - longV = _is.read_ulong(); - break; - case TCKind._tk_float : - floatV = _is.read_float(); - break; - case TCKind._tk_double : - doubleV = _is.read_double(); - break; - case TCKind._tk_boolean : - booleanV = _is.read_boolean(); - break; - case TCKind._tk_char : - case TCKind._tk_wchar : - charV = _is.read_char(); - break; - case TCKind._tk_octet : - byteV = _is.read_byte(); - break; - case TCKind._tk_string : - case TCKind._tk_wstring : - stringV = _is.read_string(); - break; - case TCKind._tk_atom : - stringV = _is.read_atom(); - break; - case TCKind._tk_void : - _is.read_atom(); - break; - - /* - * Not supported types - */ - case TCKind._tk_any : - case TCKind._tk_null : - case TCKind._tk_TypeCode : - case TCKind._tk_Principal : - case TCKind._tk_objref : - case TCKind._tk_alias : - case TCKind._tk_except : - case TCKind._tk_longdouble : - case TCKind._tk_fixed : - throw new java.lang.Exception("Unsupported type"); - - default: // User defined type - - if (os == null) - os = new com.ericsson.otp.erlang.OtpOutputStream(); - else - os.reset(); - - try { - read_user_defined(_is, _tc); - is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); - } catch (Exception e) { - throw new java.lang.Exception("BAD VALUE"); - } - } - - } - - void read_user_defined(com.ericsson.otp.erlang.OtpInputStream _is, TypeCode _tc) - throws java.lang.Exception { - - TypeCode memberTC = null; - int len = -1; - int __tag; - - switch(_tc.kind().value()) { - - case TCKind._tk_short : - os.write_short(_is.read_short()); - break; - case TCKind._tk_ushort : - os.write_ushort(_is.read_ushort()); - break; - case TCKind._tk_long : - os.write_int(_is.read_int()); - break; - case TCKind._tk_longlong : - os.write_long(_is.read_long()); - break; - case TCKind._tk_ulong : - os.write_uint(_is.read_uint()); - break; - case TCKind._tk_ulonglong : - os.write_ulong(_is.read_ulong()); - break; - case TCKind._tk_float : - os.write_float(_is.read_float()); - break; - case TCKind._tk_double : - os.write_double(_is.read_double()); - break; - case TCKind._tk_boolean : - os.write_boolean(_is.read_boolean()); - break; - case TCKind._tk_char : - case TCKind._tk_wchar : - os.write_char(_is.read_char()); - break; - case TCKind._tk_octet : - os.write_byte(_is.read_byte()); - break; - case TCKind._tk_string : - case TCKind._tk_wstring : - os.write_string(_is.read_string()); - break; - - case TCKind._tk_struct: - len = _is.read_tuple_head(); - os.write_tuple_head(len); - os.write_atom(_is.read_atom()); - // Member list - len -=1; - for(int i=0; i<len; i++) - read_user_defined(_is,_tc.member_type(i)); - break; - - case TCKind._tk_union: - os.write_tuple_head(_is.read_tuple_head()); - os.write_atom(_is.read_atom()); - - int __mlen = _tc.member_count(); - __tag = _is.peek(); - boolean __found = false; - - switch (__tag) { - case (com.ericsson.otp.erlang.OtpExternal.atomTag): - case (com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag): - case (com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag): - java.lang.String __elabel = _is.read_atom(); // Enumerant or Boolean - os.write_atom(__elabel); - - for (int i=0; i<__mlen; i++) { - java.lang.String __mlabel; - if (_tc.member_label(i).type().kind().value() == TCKind._tk_string) - __mlabel = _tc.member_label(i).extract_string(); - else // Default - __mlabel = _tc.member_label(i).extract_atom(); - - if (__elabel.compareTo(__mlabel)==0) { - read_user_defined(_is,_tc.member_type(i)); - i = __mlen; - __found = true; - } - } - break; - - default: // Integer type - long __ilabel = _is.read_long(); - os.write_long(__ilabel); - - for (int i=0; i<__mlen; i++) { - boolean __itype = true; - long __mlabel = 0; - - switch (_tc.member_label(i).type().kind().value()) { - - case TCKind._tk_short : - __mlabel = _tc.member_label(i).extract_short(); - break; - case TCKind._tk_ushort : - __mlabel = _tc.member_label(i).extract_ushort(); - break; - case TCKind._tk_long : - __mlabel = _tc.member_label(i).extract_long(); - break; - case TCKind._tk_longlong : - __mlabel = _tc.member_label(i).extract_longlong(); - break; - case TCKind._tk_ulong : - __mlabel = _tc.member_label(i).extract_ulong(); - break; - case TCKind._tk_ulonglong : - __mlabel = _tc.member_label(i).extract_ulonglong(); - break; - case TCKind._tk_char : - __mlabel = _tc.member_label(i).extract_char(); - break; - case TCKind._tk_wchar : - __mlabel = _tc.member_label(i).extract_wchar(); - break; - - default : // Default label - __itype = false; - - } - - if (__itype) { - if (__ilabel == __mlabel) { - read_user_defined(_is,_tc.member_type(i)); - i = __mlen; - __found = true; - } - } - } - } - - // Use the default label instead - if (!__found) - read_user_defined(_is,_tc.member_type(_tc.default_index())); - - break; - - case TCKind._tk_sequence: - __tag = _is.peek(); - - switch(__tag) { - case com.ericsson.otp.erlang.OtpExternal.stringTag: - os.write_string(_is.read_string()); - break; - default: - len = _is.read_list_head(); - os.write_list_head(len); - - for (int i=0; i<len; i++) - read_user_defined(_is,_tc.content_type()); - - _is.read_nil(); - os.write_nil(); - } - break; - - case TCKind._tk_array: - len = _is.read_tuple_head(); - os.write_tuple_head(len); - for (int i=0; i<len; i++) - read_user_defined(_is,_tc.content_type()); - break; - - case TCKind._tk_enum: - os.write_atom(_is.read_atom()); - break; - - case TCKind._tk_void : - os.write_atom(_is.read_atom()); - break; - - case TCKind._tk_any : - AnyHelper.marshal(os,AnyHelper.unmarshal(_is)); - break; - - /* - * Not supported types - */ - default : - throw new java.lang.Exception(""); - - } - - } - - - /** - Writes the Any's value to the ouput stream - **/ - public void write_value(com.ericsson.otp.erlang.OtpOutputStream _os) - throws java.lang.Exception { - - switch(tcV.kind().value()) { - - case TCKind._tk_short : - _os.write_short(shortV); - break; - case TCKind._tk_ushort : - _os.write_ushort(shortV); - break; - case TCKind._tk_long : - _os.write_int(intV); - break; - case TCKind._tk_ulong : - _os.write_uint(intV); - break; - case TCKind._tk_longlong : - _os.write_long(longV); - break; - case TCKind._tk_ulonglong : - _os.write_ulong(longV); - break; - case TCKind._tk_float : - _os.write_float(floatV); - break; - case TCKind._tk_double : - _os.write_double(doubleV); - break; - case TCKind._tk_boolean : - _os.write_boolean(booleanV); - break; - case TCKind._tk_char : - case TCKind._tk_wchar : - _os.write_char(charV); - break; - case TCKind._tk_octet : - _os.write_byte(byteV); - break; - case TCKind._tk_string : - case TCKind._tk_wstring : - _os.write_string(stringV); - break; - case TCKind._tk_atom : - _os.write_atom(stringV); - break; - case TCKind._tk_void : - _os.write_atom("ok"); - break; - - /* - * Not supported types - */ - case TCKind._tk_any : - case TCKind._tk_null : - case TCKind._tk_TypeCode : - case TCKind._tk_Principal : - case TCKind._tk_objref : - case TCKind._tk_alias : - case TCKind._tk_except : - case TCKind._tk_longdouble : - case TCKind._tk_fixed : - throw new java.lang.Exception("BAD KIND"); - - default: - _os.write(os.toByteArray()); - } - } - - - /* - * Insert and extract each primitive type - */ - - /* short */ - - /** - Short value extractor method - @return short, the value of Any - **/ - public short extract_short() - throws java.lang.Exception { - if (tcV.kind() == TCKind.tk_short) - return shortV; - - throw new java.lang.Exception(""); - } - - /** - Short value insertion method - **/ - public void insert_short(short s) { - shortV = s; - tcV = new TypeCode(TCKind.tk_short); - }; - - - /* long */ - /** - Long value extractor method - @return int, the value of Any - **/ - public int extract_long() - throws java.lang.Exception { - if (tcV.kind() == TCKind.tk_long) - return intV; - - throw new java.lang.Exception(""); - } - - /** - Long value insertion method - **/ - public void insert_long(int i){ - intV = i; - tcV = new TypeCode(TCKind.tk_long); - } - - - - /* long long */ - /** - Long Long value extractor method - @return long, the value of Any - **/ - public long extract_longlong() - throws java.lang.Exception { - if (tcV.kind() == TCKind.tk_longlong) - return longV; - - throw new java.lang.Exception(""); - } - - /** - Long Long value insertion method - **/ - public void insert_longlong(long l){ - longV = l; - tcV = new TypeCode(TCKind.tk_longlong); - } - - - /* ushort */ - /** - Unsigned Short value extractor method - @return short, the value of Any - **/ - public short extract_ushort() - throws java.lang.Exception { - if (tcV.kind() == TCKind.tk_ushort) - return shortV; - - throw new java.lang.Exception(""); - } - - /** - Unsigned Short value insertion method - **/ - public void insert_ushort(short s){ - shortV = s; - tcV = new TypeCode(TCKind.tk_ushort); - } - - - /* ulong */ - - /** - Unsigned Long value extractor method - @return int, the value of Any - **/ - public int extract_ulong() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_ulong) - return intV; - - throw new java.lang.Exception(""); - } - - /** - Unsigned Long value insertion method - **/ - public void insert_ulong(int i){ - intV = i; - tcV = new TypeCode(TCKind.tk_ulong); - } - - - - - /* unsigned long long */ - /** - Unsigned Long Long value extractor method - @return long, the value of Any - **/ - public long extract_ulonglong() - throws java.lang.Exception { - if (tcV.kind() == TCKind.tk_ulonglong) - return longV; - - throw new java.lang.Exception(""); - } - - /** - Unsigned Long Long value insertion method - **/ - public void insert_ulonglong(long l){ - longV = l; - tcV = new TypeCode(TCKind.tk_ulonglong); - } - - - /* float */ - /** - Float value extractor method - @return float, the value of Any - **/ - public float extract_float() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_float) - return floatV; - - throw new java.lang.Exception(""); - } - - /** - Float value insertion method - **/ - public void insert_float(float f){ - floatV = f; - tcV = new TypeCode(TCKind.tk_float); - } - - - /* double */ - /** - Double value extractor method - @return double, the value of Any - **/ - public double extract_double() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_double) - return doubleV; - - throw new java.lang.Exception(""); - } - - /** - Double value insertion method - **/ - public void insert_double(double d){ - doubleV = d; - tcV = new TypeCode(TCKind.tk_double); - } - - - /* boolean */ - /** - Boolean value extractor method - @return boolean, the value of Any - **/ - public boolean extract_boolean() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_boolean) - return booleanV; - - throw new java.lang.Exception(""); - } - - /** - Boolean value insertion method - **/ - public void insert_boolean(boolean b){ - booleanV = b; - tcV = new TypeCode(TCKind.tk_boolean); - } - - - - /* char */ - /** - Char value extractor method - @return char, the value of Any - **/ - public char extract_char() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_char) - return charV; - - throw new java.lang.Exception(""); - } - - /** - Char value insertion method - **/ - public void insert_char(char c) { - charV = c; - tcV = new TypeCode(TCKind.tk_char); - } - - - /* wchar */ - /** - Wchar value extractor method - @return char, the value of Any - **/ - public char extract_wchar() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_wchar) - return charV; - - throw new java.lang.Exception(""); - } - - /** - Wchar value insertion method - **/ - public void insert_wchar(char c) { - charV = c; - tcV = new TypeCode(TCKind.tk_wchar); - } - - - - /* octet */ - /** - Octet value extractor method - @return byte, the value of Any - **/ - public byte extract_octet() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_octet) - return byteV; - - throw new java.lang.Exception(""); - } - - /** - Octet value insertion method - **/ - public void insert_octet(byte b){ - byteV = b; - tcV = new TypeCode(TCKind.tk_octet); - } - - - /* string */ - /** - String value extractor method - @return String, the value of Any - **/ - public java.lang.String extract_string() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_string) - return stringV; - - throw new java.lang.Exception(""); - } - - /** - String value insertion method - **/ - public void insert_string(java.lang.String s) { - stringV = s; - tcV = new TypeCode(TCKind.tk_string); - } - - - - /* wstring */ - /** - Wstring value extractor method - @return String, the value of Any - **/ - public java.lang.String extract_wstring() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_wstring) - return stringV; - - throw new java.lang.Exception(""); - } - - /** - Wstring value insertion method - **/ - public void insert_wstring(java.lang.String s) { - stringV = s; - tcV = new TypeCode(TCKind.tk_wstring); - } - - - - /* atom */ - /** - Atom value extractor method - @return atom, the value of Any - **/ - public java.lang.String extract_atom() - throws java.lang.Exception{ - if (tcV.kind() == TCKind.tk_atom) - return stringV; - - throw new java.lang.Exception(""); - } - - /** - Atom value insertion method - **/ - public void insert_atom(java.lang.String s) { - stringV = s; - tcV = new TypeCode(TCKind.tk_atom); - } - - - /** - Object Stream insertion method - **/ - public void insert_Streamable(com.ericsson.otp.erlang.OtpOutputStream _os) { - os = _os; - } - - /** - Object Stream extractor method - @return OtpInputStream, the stream value of Any - **/ - public com.ericsson.otp.erlang.OtpInputStream extract_Streamable() { - - if (is == null) { - if (os == null) - return null; - else { - is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); - } - } - - is.reset(); - return is; - } - -} - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java deleted file mode 100644 index 518087a1ed..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/AnyHelper.java +++ /dev/null @@ -1,79 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - -Helper class for Any, according to OMG-IDL java mapping. -<p>Instead for write,read methods, the methods marshal respective -unmarshal are used to denote the implementation difference. - -**/ - - -public class AnyHelper { - - // Constructors - private AnyHelper() {} - - // Methods - /** - Marshal method for the Any class, encodes the Any object to the output stream. - **/ - public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Any _any) - throws java.lang.Exception { - - TypeCode _tc = _any.type(); - - _out.write_tuple_head(3); - _out.write_atom("any"); - - TypeCode.marshal(_out, _tc); - _any.write_value(_out); - - } - - /** - Unmarshal method for the Any class, decodes an Any object from the stream. - @return Any, read from the input stream - **/ - public static Any unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) - throws java.lang.Exception { - - Any _value; - TypeCode _tc; - - _in.read_tuple_head(); - - if ((_in.read_atom()).compareTo("any") != 0) - throw new java.lang.Exception(""); - - _tc = TypeCode.unmarshal(_in); - _value = new Any(); - _value.read_value(_in,_tc); - - return _value; - } - -} - - - diff --git a/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java deleted file mode 100644 index e22876f51e..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/AnyHolder.java +++ /dev/null @@ -1,61 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - -Holder class for Any, according to OMG-IDL java mapping. -<p>Instead for _write,_read methods, the methods _marshal respective -_unmarshal are used to denote the implementation difference. - -**/ - -final public class AnyHolder { - - // Instance variables - public Any value; - - // Constructors - public AnyHolder() {} - - public AnyHolder(Any initial) { - value = initial; - } - - // Methods - /** - Marshal method for the Any class, encodes the Any object to the output stream. - **/ - public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) - throws java.lang.Exception { - AnyHelper.marshal(out, value); - } - - /** - Unmarshal method for the Any class, decodes an Any object from the stream and - assigns it to the Holder value. - **/ - public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) - throws java.lang.Exception { - value = AnyHelper.unmarshal(in); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java deleted file mode 100644 index b71da196de..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/BooleanHolder.java +++ /dev/null @@ -1,63 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for boolean - * - */ -package com.ericsson.otp.ic; - -/** - -Holder class for Boolean, according to OMG-IDL java mapping. - -**/ - - -final public class BooleanHolder implements Holder { - public boolean value; - - public BooleanHolder() {} - - public BooleanHolder(boolean initial) { - value = initial; - } - - /* Extra methods not in standard. */ - /** - Comparisson method for Booleans. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof Boolean ) - return ( value == ((Boolean)obj).booleanValue()); - else - return false; - } - - /** - Comparisson method for Booleans. - @return true if the input boolean value equals the value of the current object, false otherwize - **/ - public boolean equals( boolean b ) { - return ( value == b ); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java deleted file mode 100644 index 7c79e8f90d..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/ByteHolder.java +++ /dev/null @@ -1,62 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for byte - * - */ -package com.ericsson.otp.ic; - -/** - -Holder class for Byte, according to OMG-IDL java mapping. - -**/ - -final public class ByteHolder implements Holder { - public byte value; - - public ByteHolder() {} - - public ByteHolder(byte initial) { - value = initial; - } - - /* Extra methods not in standard. */ - /** - Comparisson method for Bytes. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof Byte ) - return ( value == ((Byte)obj).byteValue()); - else - return false; - } - - /** - Comparisson method for Byte. - @return true if the input boolean value equals the value of the current object, false otherwize - **/ - public boolean equals( byte b ) { - return ( value == b); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java deleted file mode 100644 index 81d8c6ac73..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/CharHolder.java +++ /dev/null @@ -1,64 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for char - * - */ -package com.ericsson.otp.ic; - - -/** - -Holder class for Char, according to OMG-IDL java mapping. - -**/ - - -final public class CharHolder implements Holder { - public char value; - - public CharHolder() {} - - public CharHolder(char initial) { - value = initial; - } - - /* Extra methods not in standard. */ - /** - Comparisson method for Chars. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof Character ) - return ( value == ((Character)obj).charValue()); - else - return false; - } - - /** - Comparisson method for Chars. - @return true if the input char value equals the value of the current object, false otherwize - **/ - public boolean equals( char c ) { - return ( value == c); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java deleted file mode 100644 index 6daaa25aa8..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/DoubleHolder.java +++ /dev/null @@ -1,62 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for double - * - */ -package com.ericsson.otp.ic; - -/** - -Holder class for Double, according to OMG-IDL java mapping. - -**/ - -final public class DoubleHolder implements Holder { - public double value; - - public DoubleHolder() {} - - public DoubleHolder(double initial) { - value = initial; - } - - /* Extra methods not in standard. */ - /** - Comparisson method for Doubles. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof Double ) - return ( value == ((Double)obj).doubleValue()); - else - return false; - } - - /** - Comparisson method for Doubles. - @return true if the input double value equals the value of the current object, false otherwize - **/ - public boolean equals( double d ) { - return ( value == d); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Environment.java b/lib/ic/java_src/com/ericsson/otp/ic/Environment.java deleted file mode 100644 index bffa0e27e6..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/Environment.java +++ /dev/null @@ -1,480 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * The Environment class for Java IDL - * - */ -package com.ericsson.otp.ic; - -/** - - The Environment class handles communication - setup and stub state. The methods of this class - are specially designed for the generated stubs. - This class must be used when designing asynchronous - message passing. - - **/ - - -public class Environment { - - // Private variables - private com.ericsson.otp.erlang.OtpSelf self; - private com.ericsson.otp.erlang.OtpPeer peer; - private java.lang.Object server; - private java.lang.String cookie; - private com.ericsson.otp.erlang.OtpConnection connection; - private com.ericsson.otp.erlang.OtpErlangRef send_ref; /* Client side send reference */ - private com.ericsson.otp.erlang.OtpErlangRef receive_ref; /* Client side received reference */ - private com.ericsson.otp.erlang.OtpErlangPid clientP; - private com.ericsson.otp.erlang.OtpErlangPid serverP; - private com.ericsson.otp.erlang.OtpOutputStream os; /* Output stream */ - private com.ericsson.otp.erlang.OtpInputStream is; /* Input stream */ - private boolean stopped; - - // Private variables used by server only - private int tag; - private java.lang.String operation; - private java.lang.String type; - private com.ericsson.otp.erlang.OtpErlangRef ref; /* Server side client reference */ - private com.ericsson.otp.erlang.OtpErlangPid caller; /* Server side client pid */ - - // Tags to distiguish client / server environments - private boolean clientT; - private boolean serverT; - - - /** - Client stub side constructor. - **/ - public Environment(com.ericsson.otp.erlang.OtpSelf _Self, - com.ericsson.otp.erlang.OtpPeer _Peer, - java.lang.Object _Server) throws java.lang.Exception { - - init(); - clientT = true; - self = _Self; - peer = _Peer; - server = _Server; - os = new com.ericsson.otp.erlang.OtpOutputStream(); - } - - - /** - Client stub side constructor. - **/ - public Environment(java.lang.String _SelfNode, - java.lang.String _PeerNode, - java.lang.String _Cookie, - java.lang.Object _Server) throws java.lang.Exception { - - init(); - clientT = true; - self = new com.ericsson.otp.erlang.OtpSelf(_SelfNode, _Cookie); - peer = new com.ericsson.otp.erlang.OtpPeer(_PeerNode); - cookie = _Cookie; - server = _Server; - os = new com.ericsson.otp.erlang.OtpOutputStream(); - } - - - /** - Client stub side constructor. - **/ - public Environment(com.ericsson.otp.erlang.OtpConnection _connection, - java.lang.Object _Server) throws java.lang.Exception { - - init(); - clientT = true; - self = _connection.self(); - peer = _connection.peer(); - connection = _connection; - server = _Server; - os = new com.ericsson.otp.erlang.OtpOutputStream(); - } - - - /** - Server skeleton side constructor. - **/ - public Environment() throws java.lang.Exception { - - init(); - serverT = true; - stopped = false; - os = new com.ericsson.otp.erlang.OtpOutputStream(); - - } - - - /* Communication toolbox */ - - /** - Client stub side connector. - **/ - public void connect() throws java.lang.Exception { - - if (connection == null) - connection = self.connect(peer); - - clientP = self.createPid(); /* This is not perfect */ - send_ref = self.createRef(); - - } - - /** - Reconnects a client by closing existing connection - and connecting. - **/ - public void reconnect() throws java.lang.Exception { - - if (connection.isConnected()) - connection.close(); - - connection = self.connect(peer); - - } - - /** - Closes the established connection. - **/ - public void disconnect() { - - connection.close(); - - } - - - /** - Client side message sender. - **/ - public void send() throws java.lang.Exception { - - if (server instanceof java.lang.String) - connection.sendBuf((java.lang.String)server, os); - else - connection.sendBuf((com.ericsson.otp.erlang.OtpErlangPid)server, os); - - } - - - /** - Client message receiver. - **/ - public void receive() throws java.lang.Exception { - - is = connection.receiveBuf(); - - if (clientT) { // If client, decode message reference too - is.read_tuple_head(); - receive_ref = is.read_ref(); - } - } - - - /** - Universal message receiver. - **/ - public void receive(com.ericsson.otp.erlang.OtpConnection _connection) throws java.lang.Exception { - - is = _connection.receiveBuf(); - - if (clientT) { // If client, decode message reference too - is.read_tuple_head(); - receive_ref = is.read_ref(); - } - } - - - /* Accessors */ - - /** - Server RegName/OtpErlangPid accessor. - Used to access the server Reg/Pid, which - initiated the connection. - @return java.lang.Object, the server for the active OtpConnection. - **/ - public java.lang.Object server() { - - return server; - - } - - /** - Caller identity accessor. Used by a server stub to access the - caller identity of the received message. - @return OtpErlangPid, the caller identity. - **/ - public com.ericsson.otp.erlang.OtpErlangPid caller_pid() { - - return clientP; - - } - - - /** - Received message reference accessor. Used by a server stub to access the - reference of the received message. - @return OtpErlangRef, the reference of the received message. - **/ - public com.ericsson.otp.erlang.OtpErlangRef received_ref() { - - return receive_ref; - - } - - - /* Encoders */ - - /** - Client Pid Encoder. Used by a server stub to encode the - enclosed client process identity. - **/ - public void write_client_pid() { - - os.write_pid(clientP.node(),clientP.id(),clientP.serial(),clientP.creation()); - - } - - /** - Client Ref Encoder. Used by a server stub to encode the - enclosed client message reference. - **/ - public void write_client_ref() { - - os.write_ref(send_ref.node(),send_ref.id(),send_ref.creation()); - - } - - - - /* Field access functions */ - - /** - Output Stream accessor. - @return OtpOutputStream, the enclosed output stream. - **/ - public com.ericsson.otp.erlang.OtpOutputStream getOs() { - return os; - } - - /** - Input Stream accessor. - @return OtpInputStream, the enclosed input stream. - **/ - public com.ericsson.otp.erlang.OtpInputStream getIs() { - return is; - } - - /** - Server skeleton side client (caller) pid accessor. - @return OtpErlangPid, the caller process identity. - **/ - public com.ericsson.otp.erlang.OtpErlangPid getScaller() { - return caller; - } - - /** - Server skeleton side client call reference accessor. - @return OtpErlangRef, the latest call message reference. - **/ - public com.ericsson.otp.erlang.OtpErlangRef getSref() { - return ref; - } - - - - /* Field modifiers */ - - - - /* Decoders */ - - /** - Decodes the message head from existing stream. - Assignes message data to private variables of the Environment Object. - **/ - public void uHead() throws java.lang.Exception { - uHead(is); - } - - /** - Decodes the message head and writes over input stream. - Assignes message data to private variables of the Environment Object. - **/ - public void uHead(com.ericsson.otp.erlang.OtpInputStream _is) throws java.lang.Exception { - - is = _is; - is.read_tuple_head(); - type = is.read_atom(); - - if (type.equals("$gen_call")) { // Call type operation - is.read_tuple_head(); - caller = is.read_pid(); - ref = is.read_ref(); - tag = is.peek(); - - switch (tag) { - case com.ericsson.otp.erlang.OtpExternal.atomTag: - case com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag: - case com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag: - operation = is.read_atom(); - break; - default: - is.read_tuple_head(); - operation = is.read_atom(); - } - } else { // Cast type operation - tag = is.peek(); - switch (tag) { - case com.ericsson.otp.erlang.OtpExternal.atomTag: - case com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag: - case com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag: - operation = is.read_atom(); - break; - default: - is.read_tuple_head(); - operation = is.read_atom(); - } - } - } - - /** - Operation label accessor. - @return int, the label hash value. - **/ - public int uLabel(java.util.Dictionary _operations) { - - java.lang.Integer __label = - (java.lang.Integer) _operations.get(operation); - - if(__label == null) - return -1; - - return __label.intValue(); - } - - - - /* Controllers */ - - /** - Operation controller. - @return boolean, true if the operation variable found in Environment class - is supported in the input operation dictionary, false otherwize. - **/ - public boolean validOp(java.util.Dictionary _operations) { - - if((_operations.get(operation)) == null) - return false; - - return true; - } - - - /** - Server stop request controller. - @return boolean, true if there is a client request for the server - to be stopped, false otherwize. - **/ - public boolean isStopped() { - return stopped; - }; - - - - /* Destroy functions */ - - /* - Creates and sends a stop message. - Called by client stub to terminate the server. - */ - public void client_stop_server() - throws java.lang.Exception { - - // Message header assembly - os.reset(); - os.write_tuple_head(2); - os.write_atom("$gen_cast"); - - os.write_atom("stop"); - - send(); - - } - - /* - Sets the stop flag for the server. - Called by server skeleton when stop message is received. - */ - public void server_stop_server() { - - // Note at server is dead ! - stopped = true; - } - - - /* Private methods */ - - /** - Private variable initialization. - **/ - public void init() { - - clientT = false; - serverT = false; - stopped = false; - self = null; - peer = null; - server = null; - cookie = null; - connection = null; - clientP = null; - serverP = null; - send_ref = null; - receive_ref = null; - os = null; - is = null; - - tag = -1; - operation = null; - type = null; - - }; - -} - - - - - - - - - - - - - - - - diff --git a/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java deleted file mode 100644 index c804973ad6..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/FloatHolder.java +++ /dev/null @@ -1,63 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for float - * - */ -package com.ericsson.otp.ic; - -/** - -Holder class for Float, according to OMG-IDL java mapping. - -**/ - - -final public class FloatHolder implements Holder { - public float value; - - public FloatHolder() {} - - public FloatHolder(float initial) { - value = initial; - } - - /* Extra methods not in standard. */ - /** - Comparisson method for Floats. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof Float ) - return ( value == ((Float)obj).floatValue()); - else - return false; - } - - /** - Comparisson method for Floats. - @return true if the input float value equals the value of the current object, false otherwize - **/ - public boolean equals( float f ) { - return ( value == f); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Holder.java b/lib/ic/java_src/com/ericsson/otp/ic/Holder.java deleted file mode 100644 index a2888539a9..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/Holder.java +++ /dev/null @@ -1,34 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * Holder interface class. -*/ -package com.ericsson.otp.ic; -import java.io.Serializable; - -/** - Holder interface class. - **/ - -public interface Holder extends Serializable -{ - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java deleted file mode 100644 index 7327d03843..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/IntHolder.java +++ /dev/null @@ -1,63 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for long - * - */ -package com.ericsson.otp.ic; - -/** - -Holder class for Int, according to OMG-IDL java mapping. - -**/ - -final public class IntHolder implements Holder { - public int value; - - public IntHolder() {} - - public IntHolder(int initial) { - value = initial; - } - - /* Extra methods not in standard. */ - - /** - Comparisson method for Ints. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof Integer ) - return ( value == ((Integer)obj).intValue()); - else - return false; - } - - /** - Comparisson method for Ints. - @return true if the input int value equals the value of the current object, false otherwize - **/ - public boolean equals( int i ) { - return ( value == i); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java deleted file mode 100644 index 34af201b42..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/LongHolder.java +++ /dev/null @@ -1,61 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for long - * - */ -package com.ericsson.otp.ic; - -/** - -Holder class for Long, used by the Term class. - -**/ - -final public class LongHolder implements Holder { - public long value; - - public LongHolder() {} - - public LongHolder(long initial) { - value = initial; - } - - /** - Comparisson method for Longs. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof Long ) - return ( value == ((Long)obj).longValue()); - else - return false; - } - - /** - Comparisson method for Longs. - @return true if the input long value equals the value of the current object, false otherwize - **/ - public boolean equals( long l ) { - return ( value == l); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Makefile b/lib/ic/java_src/com/ericsson/otp/ic/Makefile deleted file mode 100644 index 21c38e54b5..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/Makefile +++ /dev/null @@ -1,122 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-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% -# -# -include $(ERL_TOP)/make/target.mk - - -JAVA_DEST_ROOT = $(ERL_TOP)/lib/ic/priv/ -JAVA_SRC_ROOT = $(ERL_TOP)/lib/ic/java_src/ -JAVA_CLASS_SUBDIR = com/ericsson/otp/ic/ -JAVA_INCL_ROOT = $(ERL_TOP)/lib/jinterface/priv/ - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include $(ERL_TOP)/lib/ic/vsn.mk -VSN=$(IC_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) - -# -# JAVA macros -# -JAVA_CLASSES = \ - Holder \ - BooleanHolder \ - ByteHolder \ - CharHolder \ - DoubleHolder \ - FloatHolder \ - IntHolder \ - LongHolder \ - ShortHolder \ - StringHolder \ - Environment \ - Any \ - AnyHelper \ - AnyHolder \ - TypeCode \ - TCKind \ - Pid \ - PidHolder \ - PidHelper \ - Ref \ - RefHolder \ - RefHelper \ - Port \ - PortHolder \ - PortHelper \ - Term \ - TermHolder \ - TermHelper - -TARGET_FILES= $(JAVA_CLASSES:%=$(JAVA_DEST_ROOT)$(JAVA_CLASS_SUBDIR)%.class) -JAVA_FILES= $(JAVA_CLASSES:%=%.java) - -JARFILE= ic.jar - -# ---------------------------------------------------- -# Programs and Flags -# ---------------------------------------------------- -CLASSPATH = $(JAVA_SRC_ROOT):$(JAVA_INCL_ROOT) - -JAR= jar - -JAVADOCFLAGS=-d $(DOCDIR) -JAVAFLAGS=-d $(JAVA_DEST_ROOT) -JARFLAGS= -cf -ifneq ($(V),0) -JARFLAGS= -cfv -endif - -JAVA_OPTIONS = - -# ---------------------------------------------------- -# Make Rules -# ---------------------------------------------------- - -debug opt: $(JAVA_DEST_ROOT)$(JARFILE) - -$(JAVA_DEST_ROOT)$(JARFILE): $(TARGET_FILES) - @(cd $(JAVA_DEST_ROOT) ; $(JAR) $(JARFLAGS) $(JARFILE) $(JAVA_CLASS_SUBDIR)) - -clean: - rm -f $(TARGET_FILES) *~ - -docs: - -# ---------------------------------------------------- -# Release Targets -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/java_src/com/ericsson/otp/ic" - $(INSTALL_DATA) $(JAVA_FILES) "$(RELSYSDIR)/java_src/com/ericsson/otp/ic" - $(INSTALL_DIR) "$(RELSYSDIR)/priv" - $(INSTALL_DATA) $(JAVA_DEST_ROOT)$(JARFILE) "$(RELSYSDIR)/priv" - -release_docs_spec: - diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Pid.java b/lib/ic/java_src/com/ericsson/otp/ic/Pid.java deleted file mode 100644 index 0f26c32aef..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/Pid.java +++ /dev/null @@ -1,56 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - - -/** - -Pid class mapps the built-in erlang type pid, a process identity. - -**/ - - -final public class Pid extends com.ericsson.otp.erlang.OtpErlangPid { - - public Pid(com.ericsson.otp.erlang.OtpSelf self) { - super(self); - } - - public Pid(com.ericsson.otp.erlang.OtpInputStream buf) - throws com.ericsson.otp.erlang.OtpErlangDecodeException { - super(buf); - } - - - public Pid(String node, int id, int serial, int creation) { - super(node,id,serial,creation); - } - - - /** - Comparisson method for Pid. - @return true if the input Pid value equals the value of the current object, false otherwize - **/ - public boolean equal(Pid _pid) { - return super.equals(_pid); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java deleted file mode 100644 index 4c51035738..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/PidHelper.java +++ /dev/null @@ -1,145 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - Helper class for Pid. - **/ - -public class PidHelper { - - // constructors - private PidHelper() {} - - // methods - /** - Marshal method for the Pid class, encodes the Pid object to the output stream. - **/ - public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Pid _value) - throws java.lang.Exception { - - _out.write_pid(_value.node(),_value.id(),_value.serial(),_value.creation()); - } - - /** - Unmarshal method for the Pid class, decodes a Pid object from the stream. - @return Pid, read from the input stream - **/ - public static Pid unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) - throws java.lang.Exception { - - // Double job is done here, there should be - // a function returning a Pid instead of an - // OtpErlangPid - com.ericsson.otp.erlang.OtpErlangPid oep = _in.read_pid(); - - return new Pid(oep.node(),oep.id(),oep.serial(),oep.creation()); - } - - /** - Standard method that returns the interface repository identity. - @return String containing the interface repository identity of Pid - **/ - public static String id() { - return "IDL:com/ericsson/otp/ic/Pid:1.0"; - } - - /** - Standard method that returns the Pid class name. - @return String containing the class name of Pid - **/ - public static String name() { - return "Pid"; - } - - /** - Holds the TypeCode - **/ - private static com.ericsson.otp.ic.TypeCode _tc; - - /** - Standard TypeCode accessor method. - @return the TypeCode for Pid - **/ - synchronized public static com.ericsson.otp.ic.TypeCode type() { - - if (_tc != null) - return _tc; - - com.ericsson.otp.ic.TypeCode _tc0 = - new com.ericsson.otp.ic.TypeCode(); - _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct); - _tc0.id("IDL:com/ericsson/otp/ic/Pid:1.0"); - _tc0.name("Pid"); - _tc0.member_count(4); - _tc0.member_name(0,"node"); - com.ericsson.otp.ic.TypeCode _tc1 = - new com.ericsson.otp.ic.TypeCode(); - _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string); - _tc1.length(256); - _tc0.member_type(0,_tc1); - _tc0.member_name(1,"num"); - com.ericsson.otp.ic.TypeCode _tc2 = - new com.ericsson.otp.ic.TypeCode(); - _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong); - _tc0.member_type(1,_tc2); - _tc0.member_name(2,"serial"); - com.ericsson.otp.ic.TypeCode _tc3 = - new com.ericsson.otp.ic.TypeCode(); - _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong); - _tc0.member_type(2,_tc3); - _tc0.member_name(3,"creation"); - com.ericsson.otp.ic.TypeCode _tc4 = - new com.ericsson.otp.ic.TypeCode(); - _tc4.kind(com.ericsson.otp.ic.TCKind.tk_ulong); - _tc0.member_type(3,_tc4); - - _tc = _tc0; - - return _tc0; - } - - - /** - Standard method for inserting a Pid to an Any. - **/ - public static void insert(com.ericsson.otp.ic.Any _any, Pid _this) - throws java.lang.Exception { - - com.ericsson.otp.erlang.OtpOutputStream _os = - new com.ericsson.otp.erlang.OtpOutputStream(); - - _any.type(type()); - marshal(_os, _this); - _any.insert_Streamable(_os); - } - - /** - Standard method for extracting a Pid from an Any. - @return Pid, the value found in an Any contained stream. - **/ - public static Pid extract(com.ericsson.otp.ic.Any _any) - throws java.lang.Exception { - - return unmarshal(_any.extract_Streamable()); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java deleted file mode 100644 index f5dfd81576..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/PidHolder.java +++ /dev/null @@ -1,55 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - Holder class for Pid. - **/ - -final public class PidHolder { - - /** - Pid instance variable. - **/ - public Pid value; - - // constructors - public PidHolder() {} - public PidHolder(Pid initial) { - value = initial; - } - - // methods - /** - Marshal method for the PidHolder class, encodes the Pid object value to the output stream. - **/ - public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) throws java.lang.Exception { - PidHelper.marshal(out, value); - } - - /** - Unmarshal method for the PidHolder class, decodes a Pid object from the output stream - and assigns it to the Holder value field. - **/ - public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) throws java.lang.Exception { - value = PidHelper.unmarshal(in); - } -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Port.java b/lib/ic/java_src/com/ericsson/otp/ic/Port.java deleted file mode 100644 index 34edbea362..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/Port.java +++ /dev/null @@ -1,49 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - -Port class mapps the built-in erlang type port, a process port. - -**/ - -final public class Port extends com.ericsson.otp.erlang.OtpErlangPort { - - public Port(com.ericsson.otp.erlang.OtpInputStream buf) - throws com.ericsson.otp.erlang.OtpErlangDecodeException { - super(buf); - } - - public Port(String node, int id, int creation) { - super(node,id,creation); - } - - /** - Comparisson method for Port. - @return true if the input Port value equals the value of the current object, false otherwize - **/ - public boolean equal(Port _port) { - return super.equals(_port); - } - - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java deleted file mode 100644 index 3e74758739..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/PortHelper.java +++ /dev/null @@ -1,141 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - Helper class for Port. - **/ - -public class PortHelper { - - // constructors - private PortHelper() {} - - // methods - - /** - Marshal method for the Port class, encodes the Port object to the output stream. - **/ - public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Port _value) - throws java.lang.Exception { - - _out.write_port(_value.node(),_value.id(),_value.creation()); - } - - /** - Unmarshal method for the Port class, decodes a Port object from the stream. - @return Port, read from the input stream - **/ - public static Port unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) - throws java.lang.Exception { - - // Double job is done here, there should be - // a function returning a Port instead of an - // OtpErlangPort - com.ericsson.otp.erlang.OtpErlangPort oep = _in.read_port(); - - return new Port(oep.node(),oep.id(),oep.creation()); - } - - /** - Standard method that returns the interface repository identity. - @return String containing the interface repository identity of Port - **/ - public static String id() { - return "IDL:com/ericsson/otp/ic/Port:1.0"; - } - - /** - Standard method that returns the Port class name. - @return String containing the class name of Port - **/ - public static String name() { - return "Port"; - } - - /** - Holds the TypeCode - **/ - private static com.ericsson.otp.ic.TypeCode _tc; - - /** - Standard TypeCode accessor method. - @return the TypeCode for Port - **/ - synchronized public static com.ericsson.otp.ic.TypeCode type() { - - if (_tc != null) - return _tc; - - com.ericsson.otp.ic.TypeCode _tc0 = - new com.ericsson.otp.ic.TypeCode(); - _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct); - _tc0.id("IDL:com/ericsson/otp/ic/Port:1.0"); - _tc0.name("Port"); - _tc0.member_count(3); - _tc0.member_name(0,"node"); - com.ericsson.otp.ic.TypeCode _tc1 = - new com.ericsson.otp.ic.TypeCode(); - _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string); - _tc1.length(256); - _tc0.member_type(0,_tc1); - _tc0.member_name(1,"id"); - com.ericsson.otp.ic.TypeCode _tc2 = - new com.ericsson.otp.ic.TypeCode(); - _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong); - _tc0.member_type(1,_tc2); - _tc0.member_name(2,"creation"); - com.ericsson.otp.ic.TypeCode _tc3 = - new com.ericsson.otp.ic.TypeCode(); - _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong); - _tc0.member_type(2,_tc3); - - _tc = _tc0; - - return _tc0; - } - - - /** - Standard method for inserting a Port to an Any. - **/ - public static void insert(com.ericsson.otp.ic.Any _any, Port _this) - throws java.lang.Exception { - - com.ericsson.otp.erlang.OtpOutputStream _os = - new com.ericsson.otp.erlang.OtpOutputStream(); - - _any.type(type()); - marshal(_os, _this); - _any.insert_Streamable(_os); - } - - /** - Standard method for extracting a Port from an Any. - @return Port, the value found in an Any contained stream. - **/ - public static Port extract(com.ericsson.otp.ic.Any _any) - throws java.lang.Exception { - - return unmarshal(_any.extract_Streamable()); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java deleted file mode 100644 index da0df3bbc7..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/PortHolder.java +++ /dev/null @@ -1,57 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - Holder class for Port. - **/ - -final public class PortHolder { - - /** - Port instance variable. - **/ - public Port value; - - // constructors - public PortHolder() {} - public PortHolder(Port initial) { - value = initial; - } - - // methods - /** - Marshal method for the PortHolder class, encodes the Port object value to the output stream. - **/ - public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) - throws java.lang.Exception { - PortHelper.marshal(out, value); - } - - /** - Unmarshal method for the PortHolder class, decodes a Port object from the output stream - and assigns it to the Holder value field. - **/ - public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) - throws java.lang.Exception { - value = PortHelper.unmarshal(in); - } -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Ref.java b/lib/ic/java_src/com/ericsson/otp/ic/Ref.java deleted file mode 100644 index a55da87d0d..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/Ref.java +++ /dev/null @@ -1,61 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - -Ref class mapps the built-in erlang type Ref, a message reference. - -**/ - -final public class Ref extends com.ericsson.otp.erlang.OtpErlangRef { - - public Ref(com.ericsson.otp.erlang.OtpSelf self) { - super(self); - } - - - public Ref(com.ericsson.otp.erlang.OtpInputStream buf) - throws com.ericsson.otp.erlang.OtpErlangDecodeException { - super(buf); - } - - /** - Old style Ref costructor. Costructs an Ref that coresponds to the - old erlang Ref type. - **/ - public Ref(String node, int id, int creation) { - super(node,id,creation); - } - - public Ref(String node, int[] ids, int creation) { - super(node,ids,creation); - } - - /** - Comparisson method for Ref. - @return true if the input Ref value equals the value of the current object, false otherwize - **/ - public boolean equal(Ref _ref) { - return super.equals(_ref); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java deleted file mode 100644 index cb145bbbb2..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/RefHelper.java +++ /dev/null @@ -1,142 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - Helper class for Ref. - **/ - -public class RefHelper { - - // constructors - private RefHelper() {} - - // methods - /** - Marshal method for the Ref class, encodes the Ref object to the output stream. - **/ - public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Ref _value) - throws java.lang.Exception { - - _out.write_ref(_value.node(),_value.id(),_value.creation()); - } - - /** - Unmarshal method for the Ref class, decodes a Ref object from the stream. - @return Ref, read from the input stream - **/ - public static Ref unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) - throws java.lang.Exception { - - // Double job is done here, there should be - // a function returning a Ref instead of an - // OtpErlangRef - com.ericsson.otp.erlang.OtpErlangRef oer = _in.read_ref(); - - if (oer.isNewRef()) - return new Ref(oer.node(),oer.ids(),oer.creation()); - else - return new Ref(oer.node(),oer.id(),oer.creation()); - } - - /** - Standard method that returns the interface repository identity. - @return String containing the interface repository identity of Ref - **/ - public static String id() { - return "IDL:com/ericsson/otp/ic/Ref:1.0"; - } - - /** - Standard method that returns the Ref class name. - @return String containing the class name of Ref - **/ - public static String name() { - return "Ref"; - } - - /** - Holds the TypeCode - **/ - private static com.ericsson.otp.ic.TypeCode _tc; - - /** - Standard TypeCode accessor method. - @return the TypeCode for Ref - **/ - synchronized public static com.ericsson.otp.ic.TypeCode type() { - - if (_tc != null) - return _tc; - - com.ericsson.otp.ic.TypeCode _tc0 = - new com.ericsson.otp.ic.TypeCode(); - _tc0.kind(com.ericsson.otp.ic.TCKind.tk_struct); - _tc0.id("IDL:com/ericsson/otp/ic/Ref:1.0"); - _tc0.name("Ref"); - _tc0.member_count(3); - _tc0.member_name(0,"node"); - com.ericsson.otp.ic.TypeCode _tc1 = - new com.ericsson.otp.ic.TypeCode(); - _tc1.kind(com.ericsson.otp.ic.TCKind.tk_string); - _tc1.length(256); - _tc0.member_type(0,_tc1); - _tc0.member_name(1,"id"); - com.ericsson.otp.ic.TypeCode _tc2 = - new com.ericsson.otp.ic.TypeCode(); - _tc2.kind(com.ericsson.otp.ic.TCKind.tk_ulong); - _tc0.member_type(1,_tc2); - _tc0.member_name(2,"creation"); - com.ericsson.otp.ic.TypeCode _tc3 = - new com.ericsson.otp.ic.TypeCode(); - _tc3.kind(com.ericsson.otp.ic.TCKind.tk_ulong); - _tc0.member_type(2,_tc3); - - _tc = _tc0; - - return _tc0; - } - - /** - Standard method for inserting a Ref to an Any. - **/ - public static void insert(com.ericsson.otp.ic.Any _any, Ref _this) - throws java.lang.Exception { - - com.ericsson.otp.erlang.OtpOutputStream _os = - new com.ericsson.otp.erlang.OtpOutputStream(); - - _any.type(type()); - marshal(_os, _this); - _any.insert_Streamable(_os); - } - - /** - Standard method for extracting a Ref from an Any. - @return Ref, the value found in an Any contained stream. - **/ - public static Ref extract(com.ericsson.otp.ic.Any _any) - throws java.lang.Exception { - - return unmarshal(_any.extract_Streamable()); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java deleted file mode 100644 index 9ef2eacea1..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/RefHolder.java +++ /dev/null @@ -1,55 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - Holder class for Ref. - **/ - -final public class RefHolder { - - /** - Ref instance variable. - **/ - public Ref value; - - // constructors - public RefHolder() {} - public RefHolder(Ref initial) { - value = initial; - } - - // methods - /** - Marshal method for the RefHolder class, encodes the Ref object value to the output stream. - **/ - public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) throws java.lang.Exception { - RefHelper.marshal(out, value); - } - - /** - Unmarshal method for the RefHolder class, decodes a Ref object from the output stream - and assigns it to the Holder value field. - **/ - public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) throws java.lang.Exception { - value = RefHelper.unmarshal(in); - } -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java deleted file mode 100644 index 3b191dd633..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/ShortHolder.java +++ /dev/null @@ -1,62 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for long - * - */ -package com.ericsson.otp.ic; - -/** - -Holder class for Short, according to OMG-IDL java mapping. - -**/ - -final public class ShortHolder implements Holder { - public short value; - - public ShortHolder() {} - - public ShortHolder(short initial) { - value = initial; - } - - /* Extra methods not in standard. */ - /** - Comparisson method for Shorts. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof Short ) - return ( value == ((Short)obj).shortValue()); - else - return false; - } - - /** - Comparisson method for Shorts. - @return true if the input short value equals the value of the current object, false otherwize - **/ - public boolean equals( short s ) { - return ( value == s); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java deleted file mode 100644 index f4cd069148..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/StringHolder.java +++ /dev/null @@ -1,63 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * A Holder class for IDL's out/inout argument passing modes for string - * - */ -package com.ericsson.otp.ic; - - -/** - -Holder class for String, according to OMG-IDL java mapping. - -**/ - -final public class StringHolder implements Holder { - public String value; - - public StringHolder() {} - - public StringHolder(String initial) { - value = initial; - } - - /* Extra methods not in standard. */ - /** - Comparisson method for Strings. - @return true if the input object equals the current object, false otherwize - **/ - public boolean equals( Object obj ) { - if( obj instanceof String ) - return ( value == obj); - else - return false; - } - - /** - Comparisson method for Strings. - @return true if the input String value equals the value of the current object, false otherwize - **/ - public boolean equals( String s ) { - return ( value == s); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java b/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java deleted file mode 100644 index e6265ae586..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/TCKind.java +++ /dev/null @@ -1,200 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * The TCKind class for Java IDL - * - */ -package com.ericsson.otp.ic; - -/** - The TCKind class is the implementation of the OMG-IDL enumerant type TCKind. - **/ - -final public class TCKind { - - // instance variables - public static final int _tk_null = 0, - _tk_void = 1, - _tk_short = 2, - _tk_long = 3, - _tk_ushort = 4, - _tk_ulong = 5, - _tk_float = 6, - _tk_double = 7, - _tk_boolean = 8, - _tk_char = 9, - _tk_octet = 10, - _tk_any = 11, - _tk_TypeCode = 12, - _tk_Principal = 13, - _tk_objref = 14, - _tk_struct = 15, - _tk_union = 16, - _tk_enum = 17, - _tk_string = 18, - _tk_sequence = 19, - _tk_array = 20, - _tk_alias = 21, - _tk_except = 22, - _tk_longlong = 23, - _tk_ulonglong = 24, - _tk_longdouble = 25, - _tk_wchar = 26, - _tk_wstring = 27, - _tk_fixed = 28, - _tk_atom = 20000, /* Used for union label default value only */ - _tk_pid = 20001, /* Used for special pid struct */ - _tk_port = 20002, /* Used for special port struct */ - _tk_ref = 20003, /* Used for special ref struct */ - _tk_term = 20004; /* Used for special term struct */ - - public static final TCKind tk_null = new TCKind(_tk_null); - public static final TCKind tk_void = new TCKind(_tk_void); - public static final TCKind tk_short = new TCKind(_tk_short); - public static final TCKind tk_long = new TCKind(_tk_long); - public static final TCKind tk_ushort = new TCKind(_tk_ushort); - public static final TCKind tk_ulong = new TCKind(_tk_ulong); - public static final TCKind tk_float = new TCKind(_tk_float); - public static final TCKind tk_double = new TCKind(_tk_double); - public static final TCKind tk_boolean = new TCKind(_tk_boolean); - public static final TCKind tk_char = new TCKind(_tk_char); - public static final TCKind tk_octet = new TCKind(_tk_octet); - public static final TCKind tk_any = new TCKind(_tk_any); - public static final TCKind tk_TypeCode = new TCKind(_tk_TypeCode); - public static final TCKind tk_Principal = new TCKind(_tk_Principal); - public static final TCKind tk_objref = new TCKind(_tk_objref); - public static final TCKind tk_struct = new TCKind(_tk_struct); - public static final TCKind tk_union = new TCKind(_tk_union); - public static final TCKind tk_enum = new TCKind(_tk_enum); - public static final TCKind tk_string = new TCKind(_tk_string); - public static final TCKind tk_sequence = new TCKind(_tk_sequence); - public static final TCKind tk_array = new TCKind(_tk_array); - public static final TCKind tk_alias = new TCKind(_tk_alias); - public static final TCKind tk_except = new TCKind(_tk_except); - public static final TCKind tk_longlong = new TCKind(_tk_longlong); - public static final TCKind tk_ulonglong = new TCKind(_tk_ulonglong); - public static final TCKind tk_longdouble = new TCKind(_tk_longdouble); - public static final TCKind tk_wchar = new TCKind(_tk_wchar); - public static final TCKind tk_wstring = new TCKind(_tk_wstring); - public static final TCKind tk_fixed = new TCKind(_tk_fixed); - protected static final TCKind tk_atom = new TCKind(_tk_atom); - protected static final TCKind tk_pid = new TCKind(_tk_pid); - protected static final TCKind tk_port = new TCKind(_tk_port); - protected static final TCKind tk_ref = new TCKind(_tk_ref); - protected static final TCKind tk_term = new TCKind(_tk_term); - private int _value; - - // constructors - private TCKind(int __value) { - _value = __value; - } - - // methods - - /** - Accessor method for the value of TCKind. - @return int, the value of TCKind object - **/ - public int value() { - return _value; - } - - /** - Translator method for TCKind. - Traslates the input integer value to a TCKind enumerant object. - @return TCKind, a TCKind object - **/ - public static final TCKind from_int(int __value) throws java.lang.Exception { - switch (__value) { - case _tk_null: - return tk_null; - case _tk_void: - return tk_void; - case _tk_short: - return tk_short; - case _tk_long: - return tk_long; - case _tk_ushort: - return tk_ushort; - case _tk_ulong: - return tk_ulong; - case _tk_float: - return tk_float; - case _tk_double: - return tk_double; - case _tk_boolean: - return tk_boolean; - case _tk_char: - return tk_char; - case _tk_octet: - return tk_octet; - case _tk_any: - return tk_any; - case _tk_TypeCode: - return tk_TypeCode; - case _tk_Principal: - return tk_Principal; - case _tk_objref: - return tk_objref; - case _tk_struct: - return tk_struct; - case _tk_union: - return tk_union; - case _tk_enum: - return tk_enum; - case _tk_string: - return tk_string; - case _tk_sequence: - return tk_sequence; - case _tk_array: - return tk_array; - case _tk_alias: - return tk_alias; - case _tk_except: - return tk_except; - case _tk_longlong: - return tk_longlong; - case _tk_ulonglong: - return tk_ulonglong; - case _tk_longdouble: - return tk_longdouble; - case _tk_wchar: - return tk_wchar; - case _tk_wstring: - return tk_wstring; - case _tk_fixed: - return tk_fixed; - case _tk_atom: - return tk_atom; - case _tk_pid: - return tk_pid; - case _tk_port: - return tk_port; - case _tk_ref: - return tk_ref; - case _tk_term: - return tk_term; - default: - throw new java.lang.Exception(""); - } - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Term.java b/lib/ic/java_src/com/ericsson/otp/ic/Term.java deleted file mode 100644 index 7a27905fcd..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/Term.java +++ /dev/null @@ -1,1113 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - -The Term class is intended to represent the erlang term generic type. -It extends the Any class and is basically used the same way as the Any class. -<p>The main difference between Term and Any is the use of guard methods -instead for TypeCode to determine the data included in the Term. -This actual when cannot determine a Term's value class returned at compile time. - -**/ - -final public class Term extends Any { - - // Primitive value holder - protected java.lang.String atomV; - protected long longV; - protected Pid PidV; - protected Ref RefV; - protected Port PortV; - protected com.ericsson.otp.erlang.OtpErlangObject ObjV; - protected int tag; - - /** - Tag accessor method - @return int, the tag of the Object that denotes the erlang external format tag - **/ - public int tag() { - return tag; - } - - /* Guards */ - - /** - Guard method - @return true if the Term is an OtpErlangAtom, false otherwize - **/ - public boolean isAtom() { - - if (ObjV == null) { - if (tag == com.ericsson.otp.erlang.OtpExternal.atomTag || - tag == com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag || - tag == com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag) - - return true; - - return false; - } - - return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangAtom) ; - } - - /** - Guard method - @return true if the Term is not an OtpErlangList nor an OtpErlangTuple, false otherwize - **/ - public boolean isConstant() { - if (isList()) - return false; - - if (isTuple()) - return false; - - return true; - } - - /** - Guard method - @return true if the Term is an OtpErlangFloat, false otherwize - **/ - public boolean isFloat() { - if (tag == com.ericsson.otp.erlang.OtpExternal.floatTag) - return true; - - return false; - } - - /** - Guard method - @return true if the Term is an OtpErlangInt, false otherwize - **/ - public boolean isInteger() { - switch(tag) { - case com.ericsson.otp.erlang.OtpExternal.smallIntTag: - case com.ericsson.otp.erlang.OtpExternal.intTag: - case com.ericsson.otp.erlang.OtpExternal.smallBigTag: - return true; - default: - return false; - } - } - - /** - Guard method - @return true if the Term is an OtpErlangList, false otherwize - **/ - public boolean isList() { - - if (ObjV == null) { - switch(tag) { - case com.ericsson.otp.erlang.OtpExternal.listTag: - case com.ericsson.otp.erlang.OtpExternal.stringTag: - case com.ericsson.otp.erlang.OtpExternal.nilTag: - return true; - default: - return false; - } - } - - if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangList) - return true; - - if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangString) - return true; - - return false; - } - - - /** - Guard method - @return true if the Term is an OtpErlangString, false otherwize - **/ - public boolean isString() { - - if (ObjV == null) { - switch(tag) { - case com.ericsson.otp.erlang.OtpExternal.stringTag: - case com.ericsson.otp.erlang.OtpExternal.nilTag: - return true; - default: - try { - stringV = extract_string(); - return true; - } catch (Exception e) { - return false; - } - } - } - - if (ObjV instanceof com.ericsson.otp.erlang.OtpErlangString) - return true; - - try { - stringV = extract_string(); - return true; - } catch (Exception e) { - return false; - } - } - - /** - Guard method - @return true if the Term is an OtpErlangInteger or an OtpErlangFloat, false otherwize - **/ - public boolean isNumber() { - switch(tag) { - case com.ericsson.otp.erlang.OtpExternal.smallIntTag: - case com.ericsson.otp.erlang.OtpExternal.intTag: - case com.ericsson.otp.erlang.OtpExternal.smallBigTag: - case com.ericsson.otp.erlang.OtpExternal.floatTag: - return true; - default : - return false; - } - } - - - /** - Guard method - @return true if the Term is an OtpErlangPid or Pid, false otherwize - **/ - public boolean isPid() { - - if (ObjV == null) { - if (tag == com.ericsson.otp.erlang.OtpExternal.pidTag) - return true; - - return false; - } - - return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangPid) ; - } - - - /** - Guard method - @return true if the Term is an OtpErlangPort or Port, false otherwize - **/ - public boolean isPort() { - if (ObjV == null) { - if (tag == com.ericsson.otp.erlang.OtpExternal.portTag) - return true; - - return false; - } - - return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangPort); - } - - - /** - Guard method - @return true if the Term is an OtpErlangRef, false otherwize - **/ - public boolean isReference() { - if (ObjV == null) { - switch(tag) { - case com.ericsson.otp.erlang.OtpExternal.refTag: - case com.ericsson.otp.erlang.OtpExternal.newRefTag: - return true; - default : - return false; - } - } - - return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangRef) ; - } - - - /** - Guard method - @return true if the Term is an OtpErlangTuple, false otherwize - **/ - public boolean isTuple() { - if (ObjV == null) { - switch(tag) { - case com.ericsson.otp.erlang.OtpExternal.smallTupleTag: - case com.ericsson.otp.erlang.OtpExternal.largeTupleTag: - return true; - default : - return false; - } - } - - return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangTuple); - } - - - /** - Guard method - @return true if the Term is an OtpErlangBinary, false otherwize - **/ - public boolean isBinary() { - if (ObjV == null) { - if (tag == com.ericsson.otp.erlang.OtpExternal.binTag) - return true; - - return false; - } - - return (ObjV instanceof com.ericsson.otp.erlang.OtpErlangBinary); - } - - - - - // Equal function - /** - Term comparison method - @return true if the input Term is equal to the object, false otherwize - **/ - public boolean equal(Term _any) { - - try { - - /* Pids */ - if ((PidV != null) && (_any.PidV != null)) - if (PidV.equal(_any.PidV)) - return true; - - /* Refs */ - if ((RefV != null) && (_any.RefV != null)) - if (RefV.equal(_any.RefV)) - return true; - - /* Ports */ - if ((PortV != null) && (_any.PortV != null)) - if (PortV.equals(_any.PortV)) - return true; - - /* strings */ - if ((stringV != null) && (_any.stringV != null)) - if (stringV.equals(_any.stringV)) - return true; - - /* atoms and booleans */ - if ((atomV != null) && (_any.atomV != null)) - if (atomV.equals(_any.atomV)) - return true; - - /* booleans */ - if (atomV != null) - if (_any.booleanV == Boolean.valueOf(atomV).booleanValue()) - return true; - - if (_any.atomV != null) - if (booleanV == Boolean.valueOf(_any.atomV).booleanValue()) - return true; - - /* integer types plus floating point types */ - double _ownNS = - longV+doubleV; - - double _othersNS = - _any.longV+_any.doubleV; - - if ((equal(_ownNS,_othersNS)) && - (!equal(_ownNS,0))) - return true; - - /* All together, 0 or false */ - if ((equal(_ownNS,_othersNS)) && - booleanV == _any.booleanV) - return true; - - - return false; - - } catch (Exception e) { - e.printStackTrace(); - return false; - } - } - - /** - Writes the value of Term to a stream - **/ - public void write_value(com.ericsson.otp.erlang.OtpOutputStream _os) - throws java.lang.Exception { - - if ((tcV == null) && (ObjV != null)) - _os.write_any(ObjV); // Type not generated by IC - - else { - - switch(tcV.kind().value()) { - - case TCKind._tk_octet : - case TCKind._tk_char : - case TCKind._tk_wchar : - case TCKind._tk_short : - case TCKind._tk_ushort : - case TCKind._tk_long : - case TCKind._tk_longlong : - case TCKind._tk_ulong : - case TCKind._tk_ulonglong : - _os.write_long(longV); - break; - - case TCKind._tk_float : - _os.write_double(doubleV); - break; - - case TCKind._tk_double : - _os.write_double(doubleV); - break; - - case TCKind._tk_boolean : - _os.write_boolean(booleanV); - break; - - case TCKind._tk_string : - case TCKind._tk_wstring : - _os.write_string(stringV); - break; - - case TCKind._tk_atom : - _os.write_atom(stringV); - break; - - case TCKind._tk_struct: - if (isPid()) - PidHelper.marshal(_os, PidV); - else { - if (isReference()) - RefHelper.marshal(_os, RefV); - else { - if (isPort()) - PortHelper.marshal(_os, PortV); - else - _os.write(os.toByteArray()); - } - } - break; - - case TCKind._tk_union: - case TCKind._tk_array: - case TCKind._tk_sequence: - case TCKind._tk_enum: - _os.write(os.toByteArray()); - break; - - case TCKind._tk_void : - _os.write_atom("ok"); - break; - - /* - * Not supported types - */ - default: - throw new java.lang.Exception("BAD KIND"); - } - } - } - - - - /* - * Insert and extract each primitive type - */ - - - /* short */ - - /** - Short value extractor method - @return short, the value of Term - **/ - public short extract_short() - throws java.lang.Exception { - - if (tcV == null) - return (short) longV; - - if (tcV.kind() == TCKind.tk_short) - return (short) longV; - - throw new java.lang.Exception(""); - } - - /** - Short value insertion method - **/ - public void insert_short(short s) { - longV = s; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_short); - }; - - /** - Short value insertion method - **/ - public void insert_short(long l) { - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_short); - }; - - - /* long */ - - /** - Long value extractor method - @return int, the value of Term - **/ - public int extract_long() - throws java.lang.Exception { - - if (tcV == null) - return (int) longV; - - if (tcV.kind() == TCKind.tk_long) - return (int) longV; - - throw new java.lang.Exception(""); - } - - /** - Long value insertion method - **/ - public void insert_long(int i){ - longV = i; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_long); - } - - /** - Long value insertion method - **/ - public void insert_long(long l){ - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_long); - } - - - /* longlong */ - - /** - Long Long value extractor method - @return long, the value of Term - **/ - public long extract_longlong() - throws java.lang.Exception { - - if (tcV == null) - return longV; - - if (tcV.kind() == TCKind.tk_longlong) - return longV; - - throw new java.lang.Exception(""); - } - - - /** - Long Long value insertion method - **/ - public void insert_longlong(long l){ - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_longlong); - } - - - /* ushort */ - - /** - Unsigned Short value extractor method - @return short, the value of Term - **/ - public short extract_ushort() - throws java.lang.Exception { - - if (tcV == null) - return (short) longV; - - if (tcV.kind() == TCKind.tk_ushort) - return (short) longV; - - throw new java.lang.Exception(""); - } - - /** - Unsigned Short value insertion method - **/ - public void insert_ushort(short s){ - longV = s; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_ushort); - } - - /** - Unsigned Short value insertion method - **/ - public void insert_ushort(long l){ - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_ushort); - } - - - /* ulong */ - - /** - Unsigned Long value extractor method - @return int, the value of Term - **/ - public int extract_ulong() - throws java.lang.Exception{ - - if (tcV == null) - return (int) longV; - - if (tcV.kind() == TCKind.tk_ulong) - return (int) longV; - - throw new java.lang.Exception(""); - } - - /** - Unsigned Long value insertion method - **/ - public void insert_ulong(int i){ - longV = i; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_ulong); - } - - - /** - Unsigned Long value insertion method - **/ - public void insert_ulong(long l){ - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_ulong); - } - - - - /* ulonglong */ - - /** - Unsigned Long Long value extractor method - @return long, the value of Term - **/ - public long extract_ulonglong() - throws java.lang.Exception { - - if (tcV == null) - return longV; - - if (tcV.kind() == TCKind.tk_ulonglong) - return longV; - - throw new java.lang.Exception(""); - } - - - /** - Unsigned Long Long value insertion method - **/ - public void insert_ulonglong(long l){ - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.intTag; - tcV = new TypeCode(TCKind.tk_ulonglong); - } - - - - /* float */ - /** - Float value extractor method - @return float, the value of Term - **/ - public float extract_float() - throws java.lang.Exception{ - - if (tcV == null) - return (float) doubleV; - - if (tcV.kind() == TCKind.tk_float) - return (float) doubleV; - - throw new java.lang.Exception(""); - } - - - /** - Float value insertion method - **/ - public void insert_float(float f){ - doubleV = f; - tag = com.ericsson.otp.erlang.OtpExternal.floatTag; - tcV = new TypeCode(TCKind.tk_float); - } - - /** - Float value insertion method - **/ - public void insert_float(double f){ - doubleV = f; - tag = com.ericsson.otp.erlang.OtpExternal.floatTag; - tcV = new TypeCode(TCKind.tk_float); - } - - - /* double */ - /** - Double value extractor method - @return double, the value of Term - **/ - public double extract_double() - throws java.lang.Exception{ - - if (tcV == null) - return doubleV; - - if (tcV.kind() == TCKind.tk_double) - return doubleV; - - throw new java.lang.Exception(""); - } - - /** - Double value insertion method - **/ - public void insert_double(double d){ - doubleV = d; - tag = com.ericsson.otp.erlang.OtpExternal.floatTag; - tcV = new TypeCode(TCKind.tk_double); - } - - - /* boolean */ - /** - Boolean value extractor method - @return boolean, the value of Term - **/ - public boolean extract_boolean() - throws java.lang.Exception{ - - if ((tcV == null) && (atomV != null)) - return Boolean.valueOf(atomV).booleanValue(); - - if (tcV.kind() == TCKind.tk_boolean) - return booleanV; - - throw new java.lang.Exception(""); - } - - /** - Boolean value insertion method - **/ - public void insert_boolean(boolean b){ - booleanV = b; - tag = com.ericsson.otp.erlang.OtpExternal.atomTag; - tcV = new TypeCode(TCKind.tk_boolean); - } - - - /* char */ - /** - Char value extractor method - @return char, the value of Term - **/ - public char extract_char() - throws java.lang.Exception{ - - if (tcV == null) - return (char) longV; - - if (tcV.kind() == TCKind.tk_char) - return (char) longV; - - throw new java.lang.Exception(""); - } - - /** - Char value insertion method - **/ - public void insert_char(char c) { - longV = c; - tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; - tcV = new TypeCode(TCKind.tk_char); - } - - /** - Char value insertion method - **/ - public void insert_char(long l) { - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; - tcV = new TypeCode(TCKind.tk_char); - } - - - - /* wchar */ - /** - Wchar value extractor method - @return char, the value of Term - **/ - public char extract_wchar() - throws java.lang.Exception{ - - if (tcV == null) - return (char) longV; - - if (tcV.kind() == TCKind.tk_wchar) - return (char) longV; - - throw new java.lang.Exception(""); - } - - /** - Wchar value insertion method - **/ - public void insert_wchar(char c) { - longV = c; - tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; - tcV = new TypeCode(TCKind.tk_wchar); - } - - /** - Wchar value insertion method - **/ - public void insert_wchar(long l) { - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; - tcV = new TypeCode(TCKind.tk_wchar); - } - - - /* octet */ - /** - Octet value extractor method - @return byte, the value of Term - **/ - public byte extract_octet() - throws java.lang.Exception{ - - if (tcV == null) - return (byte) longV; - - if (tcV.kind() == TCKind.tk_octet) - return (byte) longV; - - throw new java.lang.Exception(""); - } - - /** - Octet value insertion method - **/ - public void insert_octet(byte b){ - longV = b; - tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; - tcV = new TypeCode(TCKind.tk_octet); - } - - /** - Octet value insertion method - **/ - public void insert_octet(long l){ - longV = l; - tag = com.ericsson.otp.erlang.OtpExternal.smallIntTag; - tcV = new TypeCode(TCKind.tk_octet); - } - - - - /* string */ - - /** - String value extractor method - @return String, the value of Term - **/ - public java.lang.String extract_string() - throws java.lang.Exception{ - - if (tcV == null) { - if (stringV != null) - return stringV; - else { - is = this.extract_Streamable(); - stringV = is.read_string(); - return stringV; - } - } - else - if (tcV.kind() == TCKind.tk_string) - return stringV; - - throw new java.lang.Exception(""); - } - - /** - String value insertion method - **/ - public void insert_string(java.lang.String s) { - stringV = s; - tag = com.ericsson.otp.erlang.OtpExternal.stringTag; - tcV = new TypeCode(TCKind.tk_string); - } - - - - /* wstring */ - /** - Wstring value extractor method - @return String, the value of Term - **/ - public java.lang.String extract_wstring() - throws java.lang.Exception{ - - if (tcV == null) { - if (stringV != null) - return stringV; - else { - is = this.extract_Streamable(); - stringV = is.read_string(); - return stringV; - } - } - else - if (tcV.kind() == TCKind.tk_wstring) - return stringV; - - throw new java.lang.Exception(""); - } - - /** - Wstring value insertion method - **/ - public void insert_wstring(java.lang.String s) { - stringV = s; - tag = com.ericsson.otp.erlang.OtpExternal.stringTag; - tcV = new TypeCode(TCKind.tk_wstring); - } - - - - /* atom */ - /** - Atom value extractor method - @return atom, the value of Term - **/ - public java.lang.String extract_atom() - throws java.lang.Exception{ - - if ((tcV == null) && (atomV != null)) - return atomV; - - if (tcV.kind() == TCKind.tk_atom) - return stringV; - - throw new java.lang.Exception(""); - } - - - /** - Atom value insertion method - **/ - public void insert_atom(java.lang.String s) { - stringV = s; - tag = com.ericsson.otp.erlang.OtpExternal.atomTag; - tcV = new TypeCode(TCKind.tk_atom); - } - - - /* Pid */ - /** - Pid value extractor method - @return Pid, the value of Term - **/ - public Pid extract_Pid() - throws java.lang.Exception{ - - if ((tcV == null) && (PidV != null)) - return PidV; - - if (tcV.equal(PidHelper.type())) - return PidV; - - throw new java.lang.Exception(""); - } - - - /** - Pid value insertion method - **/ - public void insert_Pid(Pid p) { - PidV = p; - tag = com.ericsson.otp.erlang.OtpExternal.pidTag; - tcV = PidHelper.type(); - } - - - - /* Ref */ - /** - Ref value extractor method - @return Ref, the value of Term - **/ - public Ref extract_Ref() - throws java.lang.Exception{ - - if ((tcV == null) && (RefV != null)) - return RefV; - - if (tcV.equal(RefHelper.type())) - return RefV; - - throw new java.lang.Exception(""); - } - - /** - Ref value insertion method - **/ - public void insert_Ref(Ref r) { - RefV = r; - - if (r.isNewRef()) - tag = com.ericsson.otp.erlang.OtpExternal.newRefTag; - else - tag = com.ericsson.otp.erlang.OtpExternal.refTag; - - tcV = RefHelper.type(); - } - - - - /* Port */ - /** - Port value extractor method - @return Port, the value of Term - **/ - public Port extract_Port() - throws java.lang.Exception{ - - if ((tcV == null) && (PortV != null)) - return PortV; - - if (tcV.equal(PortHelper.type())) - return PortV; - - throw new java.lang.Exception(""); - } - - /** - Port value insertion method - **/ - public void insert_Port(Port p) { - PortV = p; - tag = com.ericsson.otp.erlang.OtpExternal.portTag; - tcV = PortHelper.type(); - } - - - /** - Object Stream extractor method - @return OtpInputStream, the stream value of Term - **/ - public com.ericsson.otp.erlang.OtpInputStream extract_Streamable() { - - if (is == null) { - if (os == null) { - if (stringV == null) - return null; - else { - // A sequence that become a string ! - os = new com.ericsson.otp.erlang.OtpOutputStream(); - os.write_string(stringV); - is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); - } - } - else { - is = new com.ericsson.otp.erlang.OtpInputStream(os.toByteArray()); - } - } - - is.reset(); - return is; - } - - /** - Inserts Objects to Term - **/ - public void insert_Object(com.ericsson.otp.erlang.OtpErlangObject o) { - ObjV = o; - } - - /** - Extract Object value from Term - @return OtpErlangObject, the Object value of Term - **/ - public com.ericsson.otp.erlang.OtpErlangObject extract_Object() { - return ObjV; - } - - -} - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java b/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java deleted file mode 100644 index 1a6271d9c0..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/TermHelper.java +++ /dev/null @@ -1,142 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - Helper class for Term. - **/ - -public class TermHelper { - - // Constructors - private TermHelper() {} - - // Methods - /** - Marshal method for the Term class, encodes the Term object to the output stream. - **/ - public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _out, Term _any) - throws java.lang.Exception { - - _any.write_value(_out); - } - - /** - Unmarshal method for the Term class, decodes a Term object from the stream. - @return Term, read from the input stream - **/ - public static Term unmarshal(com.ericsson.otp.erlang.OtpInputStream _in) - throws java.lang.Exception { - - Term _value = new Term(); - - int tag = _in.peek(); - if (tag == com.ericsson.otp.erlang.OtpExternal.versionTag) { - _in.read1(); - tag = _in.peek(); - } - _value.tag = tag; - - - // Allways save the object in OtpErlangObject form - _in.mark(0); - com.ericsson.otp.erlang.OtpErlangObject _obj = _in.read_any(); - _value.insert_Object(_obj); - - switch (tag) { - case com.ericsson.otp.erlang.OtpExternal.smallIntTag: - case com.ericsson.otp.erlang.OtpExternal.intTag: - case com.ericsson.otp.erlang.OtpExternal.smallBigTag: - _in.reset(); - _value.longV = _in.read_long(); - break; - - case com.ericsson.otp.erlang.OtpExternal.atomTag: - case com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag: - case com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag: - _in.reset(); - _value.atomV = _in.read_atom(); - break; - - case com.ericsson.otp.erlang.OtpExternal.floatTag: - _in.reset(); - _value.doubleV = _in.read_double(); - break; - - case com.ericsson.otp.erlang.OtpExternal.refTag: - case com.ericsson.otp.erlang.OtpExternal.newRefTag: - _in.reset(); - com.ericsson.otp.erlang.OtpErlangRef _eref = - _in.read_ref(); - - if (_eref.isNewRef()) - _value.RefV = new Ref(_eref.node(),_eref.ids(),_eref.creation()); - else - _value.RefV = new Ref(_eref.node(),_eref.id(),_eref.creation()); - - break; - - case com.ericsson.otp.erlang.OtpExternal.portTag: - _in.reset(); - com.ericsson.otp.erlang.OtpErlangPort _eport = - _in.read_port(); - - _value.PortV = new Port(_eport.node(),_eport.id(),_eport.creation()); - break; - - case com.ericsson.otp.erlang.OtpExternal.pidTag: - _in.reset(); - com.ericsson.otp.erlang.OtpErlangPid _epid = - _in.read_pid(); - - _value.PidV = new Pid(_epid.node(),_epid.id(),_epid.serial(),_epid.creation()); - break; - - case com.ericsson.otp.erlang.OtpExternal.stringTag: - _in.reset(); - _value.stringV = _in.read_string(); - break; - - case com.ericsson.otp.erlang.OtpExternal.listTag: - case com.ericsson.otp.erlang.OtpExternal.nilTag: - case com.ericsson.otp.erlang.OtpExternal.smallTupleTag: - case com.ericsson.otp.erlang.OtpExternal.largeTupleTag: - case com.ericsson.otp.erlang.OtpExternal.binTag: - - com.ericsson.otp.erlang.OtpOutputStream _os = - new com.ericsson.otp.erlang.OtpOutputStream(); - - _obj.encode(_os); - _value.insert_Streamable(_os); - break; - - case com.ericsson.otp.erlang.OtpExternal.largeBigTag: - default: - throw new com.ericsson.otp.erlang.OtpErlangDecodeException("Uknown data type: " + tag); - } - - return _value; - } - -} - - - diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java b/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java deleted file mode 100644 index 6a30bad5ea..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/TermHolder.java +++ /dev/null @@ -1,59 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -package com.ericsson.otp.ic; - -/** - Holder class for Term. - **/ - -final public class TermHolder { - - /** - Term instance variable. - **/ - public Term value; - - // Constructors - public TermHolder() {} - - public TermHolder(Term initial) { - value = initial; - } - - // Methods - /** - Marshal method for the TermHolder class, encodes the Term object value to the output stream. - **/ - public void _marshal(com.ericsson.otp.erlang.OtpOutputStream out) - throws java.lang.Exception { - TermHelper.marshal(out, value); - } - - /** - Unmarshal method for the TermHolder class, decodes a Term object from the output stream - and assigns it to the Holder value field. - **/ - public void _unmarshal(com.ericsson.otp.erlang.OtpInputStream in) - throws java.lang.Exception { - value = TermHelper.unmarshal(in); - } - -} diff --git a/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java b/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java deleted file mode 100644 index da036fea54..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/TypeCode.java +++ /dev/null @@ -1,883 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-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% - * - */ -/** - * The TypeCode class for Java IDL - * - */ -package com.ericsson.otp.ic; - -/** - The TypeCode class is the implementation of the OMG-IDL TypeCode type. - **/ - -public class TypeCode { - - private TCKind _kind; - private java.lang.String _id,_name; - private int _length,_member_count,_default_index; - private TypeCode _member_type,_discriminator_type,_content_type; - private Any _member_label; - private boolean extracted; - private TypeCode _members[]; - private java.lang.String _member_names[]; - private Any _member_labels[]; - - - - /* - * Constructors - */ - public TypeCode() { - extracted = false; - _members = null; - _member_names = null; - _member_labels = null; - _kind = null; - _id = null; - _name = null; - _length = -1; - _member_count = -1; - _default_index = -1; - _member_type = null; - _content_type = null; - _discriminator_type = null; - _member_label = null; - } - - public TypeCode(TCKind __kind) { - _kind = __kind; - } - - - /* - * Operation "TypeCode::equal" - */ - - /** - Comparisson method for TypeCode. - @return true if the input TypeCode value equals the value of the current object, false otherwize - **/ - public boolean equal(TypeCode tc) { - - try { - - TCKind tck = tc.kind(); - - switch (tck.value()) { - - case TCKind._tk_short: - case TCKind._tk_long: - case TCKind._tk_longlong: - case TCKind._tk_ushort: - case TCKind._tk_ulong: - case TCKind._tk_ulonglong: - case TCKind._tk_float: - case TCKind._tk_double: - case TCKind._tk_boolean: - case TCKind._tk_char: - case TCKind._tk_wchar: - case TCKind._tk_octet: - case TCKind._tk_string: - case TCKind._tk_wstring: - case TCKind._tk_any: - case TCKind._tk_void: - case TCKind._tk_atom: - - return (tck.value() == _kind.value()); - - case TCKind._tk_struct: - - if((tc.id().compareTo(_id) == 0) && - (tc.name().compareTo(_name) == 0) && - (tc.member_count() == _member_count)){ - - for (int i = 0; i < _member_count; i++) - if (!tc.member_type(i).equal(_members[i])) - return false; - - return true; - } - else - return false; - - case TCKind._tk_union: - - if((tc.id().compareTo(_id) == 0) && - (tc.name().compareTo(_name) == 0) && - (tc.member_count() == _member_count) && - (tc.discriminator_type().equal(_discriminator_type))){ - - for (int i = 0; i < _member_count; i++) - if ((!tc.member_type(i).equal(_members[i])) && - (tc.member_name(i).compareTo(_member_names[i]) != 0)) - return false; - - return true; - } - else - return false; - - case TCKind._tk_sequence: - case TCKind._tk_array: - - if((tck.value() == _kind.value()) && - (tc.content_type().equal(_content_type))) - return true; - else - return false; - - case TCKind._tk_enum: - if((tck.value() == _kind.value()) && - (tc.member_count() == _member_count)) { - - for (int i = 0; i < _member_count; i++) - if (tc.member_name(i).compareTo(_member_names[i]) != 0) - return false; - - return true; - } - else - return false; - - // Not used in real - case TCKind._tk_null: - case TCKind._tk_TypeCode: - case TCKind._tk_Principal: - case TCKind._tk_objref: - case TCKind._tk_alias: - case TCKind._tk_except: - case TCKind._tk_longdouble: - case TCKind._tk_fixed: - - return (tck.value() == _kind.value()); - - default : - return false; - - } - } catch (Exception e) { - return false; - } - - } - - - /* - * Operation "TypeCode::kind" - */ - - /** - Accessor method for the TCKind value of TypeCode. - @return TCKind, the TCKind value of the TypeCode object. - **/ - public TCKind kind() { - return _kind; - } - - /** - Insertion method for the TCKind value of TypeCode. - Sets the TCKind value of the object. - **/ - public void kind(TCKind __kind) { - _kind = __kind; - } - - /** - Insertion method for the TCKind value of TypeCode. - Sets the TCKind value of the object. - **/ - public static TCKind kind(java.lang.String atom) - throws java.lang.Exception { - - if (atom.equals("tk_null")) - return TCKind.tk_null; - else - if (atom.equals("tk_void")) - return TCKind.tk_void; - else - if (atom.equals("tk_short")) - return TCKind.tk_short; - else - if (atom.equals("tk_long")) - return TCKind.tk_long; - else - if (atom.equals("tk_ushort")) - return TCKind.tk_ushort; - else - if (atom.equals("tk_ulong")) - return TCKind.tk_ulong; - else - if (atom.equals("tk_float")) - return TCKind.tk_float; - else - if (atom.equals("tk_double")) - return TCKind.tk_double; - else - if (atom.equals("tk_boolean")) - return TCKind.tk_boolean; - else - if (atom.equals("tk_char")) - return TCKind.tk_char; - else - if (atom.equals("tk_octet")) - return TCKind.tk_octet; - else - if (atom.equals("tk_any")) - return TCKind.tk_any; - else - if (atom.equals("tk_TypeCode")) - return TCKind.tk_TypeCode; - else - if (atom.equals("tk_Principal")) - return TCKind.tk_Principal; - else - if (atom.equals("tk_objref")) - return TCKind.tk_objref; - else - if (atom.equals("tk_struct")) - return TCKind.tk_struct; - else - if (atom.equals("tk_union")) - return TCKind.tk_union; - else - if (atom.equals("tk_enum")) - return TCKind.tk_enum; - else - if (atom.equals("tk_string")) - return TCKind.tk_string; - else - if (atom.equals("tk_sequence")) - return TCKind.tk_sequence; - else - if (atom.equals("tk_array")) - return TCKind.tk_array; - else - if (atom.equals("tk_alias")) - return TCKind.tk_alias; - else - if (atom.equals("tk_except")) - return TCKind.tk_except; - else - if (atom.equals("tk_longlong")) - return TCKind.tk_longlong; - else - if (atom.equals("tk_ulonglong")) - return TCKind.tk_ulonglong; - else - if (atom.equals("tk_longdouble")) - return TCKind.tk_longdouble; - else - if (atom.equals("tk_wchar")) - return TCKind.tk_wchar; - else - if (atom.equals("tk_wstring")) - return TCKind.tk_wstring; - else - if (atom.equals("tk_fixed")) - return TCKind.tk_fixed; - else - if (atom.equals("tk_atom")) - return TCKind.tk_atom; - else - throw new java.lang.Exception("BAD KIND"); - - } - - - - /* - * Operation "TypeCode::id" - */ - - /** - Accessor method for the id value of TypeCode. - @return String, the id value of TypeCode object - **/ - public java.lang.String id() - throws java.lang.Exception{ - - if (_id == null) - throw new java.lang.Exception("BAD KIND"); - - return _id; - } - - - /** - Insertion method for the id value of TypeCode. - Sets the id value of the object. - **/ - public void id(java.lang.String __id) { - - _id = __id; - } - - - - /* - * Operation "TypeCode::name" - */ - - /** - Accessor method for the name value of TypeCode. - @return String, the name value of TypeCode object - **/ - public java.lang.String name() - throws java.lang.Exception{ - - if (_name == null) - throw new java.lang.Exception("BAD KIND"); - - return _name; - } - - /** - Insertion method for the name value of TypeCode. - Sets the name value of the object. - **/ - public void name(java.lang.String __name) { - _name = __name; - } - - - - /* - * Operation "TypeCode::member_count" - */ - - /** - Accessor method for the member number value of TypeCode. - @return int, the number of members of TypeCode object - **/ - public int member_count() - throws java.lang.Exception{ - - if (_member_count == -1) - throw new java.lang.Exception("BAD KIND"); - - return _member_count; - } - - /** - Insertion method for the member number value of TypeCode. - Sets the number of members value of the object. - **/ - public void member_count(int __member_count) { - - switch(_kind.value()) { - case TCKind._tk_struct: - _members = new TypeCode[__member_count]; - _member_names = new java.lang.String[__member_count]; - _member_count = __member_count; - break; - case TCKind._tk_union: - _members = new TypeCode[__member_count]; - _member_names = new java.lang.String[__member_count]; - _member_labels = new Any[__member_count]; - _member_count = __member_count; - break; - case TCKind._tk_enum: - _member_names = new java.lang.String[__member_count]; - _member_count = __member_count; - break; - default : - // Do nothing - } - } - - - /* - * Operation "TypeCode::member_name" - */ - - /** - Member name accessor method for TypeCode. - @return String, the name value of the member of the TypeCode object - on the selected index - **/ - public java.lang.String member_name(int __index) - throws java.lang.Exception{ - - return _member_names[__index]; - } - - /** - Insertion method for the indexed member name of TypeCode. - Sets the name of a member value of the object at the selected index.. - **/ - public void member_name(int __index, java.lang.String __member_name) { - _member_names[__index] = __member_name; - } - - - /* - * Operation "TypeCode::member_type" - */ - - /** - Member type accessor method for TypeCode. - @return TypeCOde, the type of the member of the TypeCode object - on the selected index - **/ - public TypeCode member_type(int __index) - throws java.lang.Exception{ - - return _members[__index]; - } - - /** - Insertion method for the indexed member type of TypeCode. - Sets the type of a member value of the object at the selected index.. - **/ - public void member_type(int __index, TypeCode __member_type) { - _members[__index] = __member_type; - } - - - /* - * Operation "TypeCode::member_label" - */ - - /** - Member label accessor method for TypeCode. - @return Any, the label of the member of the TypeCode object - on the selected index - **/ - public Any member_label(int __index) - throws java.lang.Exception{ - - return _member_labels[__index]; - } - - /** - Insertion method for the indexed member label of TypeCode. - Sets the label of a member value of the object at the selected index. - **/ - public void member_label(int __index, Any __member_label) { - _member_labels[__index] = __member_label; - } - - - /* - * Operation "TypeCode::discriminator_type" - */ - - /** - Discriminator type accessor method for TypeCode. - @return TypeCode, the type of the discriminator of the TypeCode object - **/ - public TypeCode discriminator_type() - throws java.lang.Exception{ - - if (_discriminator_type == null) - throw new java.lang.Exception("BAD KIND"); - - return _discriminator_type; - } - - /** - Insertion method for the type of the discriminator value of TypeCode. - Sets the discriminator type value of the object. - **/ - public void discriminator_type(TypeCode __discriminator_type) { - _discriminator_type = __discriminator_type; - } - - - /* - * Operation "TypeCode::default_index" - */ - - /** - Index accessor method for TypeCode. - @return int, the default index value of the member of the TypeCode object - **/ - public int default_index() - throws java.lang.Exception{ - - if (_default_index == -1) - throw new java.lang.Exception("BAD KIND"); - - return _default_index; - } - - /** - Insertion method for the default index value of TypeCode. - Sets the default index value of the object. - **/ - public void default_index(int __default_index) { - _default_index = __default_index; - } - - - /* - * Operation "TypeCode::length" - */ - - /** - Length accessor method for TypeCode. - @return int, the length of the TypeCode object - **/ - public int length() - throws java.lang.Exception{ - - if (_length == -1) - throw new java.lang.Exception("BAD KIND"); - - return _length; - } - - /** - Insertion method for the length value of TypeCode. - Sets the length value of the object. - **/ - public void length(int __length) { - _length = __length; - } - - - /* - * Operation "TypeCode::content_type" - */ - - /** - Content type accessor method for TypeCode. - @return TypeCode, the content type of the TypeCode object - **/ - public TypeCode content_type() - throws java.lang.Exception { - - if (_content_type == null) - throw new java.lang.Exception("BAD KIND"); - - return _content_type; - } - - /** - Insertion method for the content type value of TypeCode. - Sets the content type value of the object. - **/ - public void content_type(TypeCode __content_type) { - _content_type = __content_type; - } - - - /** - Marshal operation for TypeCode. - **/ - public static void marshal(com.ericsson.otp.erlang.OtpOutputStream _os, TypeCode _tc) - throws java.lang.Exception { - - TypeCode memberTC = null; - int len = -1; - - switch(_tc.kind().value()) { - - case TCKind._tk_short : - _os.write_atom("tk_short"); - break; - case TCKind._tk_ushort : - _os.write_atom("tk_ushort"); - break; - case TCKind._tk_long : - _os.write_atom("tk_long"); - break; - case TCKind._tk_longlong : - _os.write_atom("tk_longlong"); - break; - case TCKind._tk_ulong : - _os.write_atom("tk_ulong"); - break; - case TCKind._tk_ulonglong : - _os.write_atom("tk_ulonglong"); - break; - case TCKind._tk_float : - _os.write_atom("tk_float"); - break; - case TCKind._tk_double : - _os.write_atom("tk_double"); - break; - case TCKind._tk_boolean : - _os.write_atom("tk_boolean"); - break; - case TCKind._tk_char : - _os.write_atom("tk_char"); - break; - case TCKind._tk_wchar : - _os.write_atom("tk_wchar"); - break; - case TCKind._tk_octet : - _os.write_atom("tk_octet"); - break; - case TCKind._tk_string : - _os.write_tuple_head(2); - _os.write_atom("tk_string"); - _os.write_ulong(_tc.length()); - break; - case TCKind._tk_wstring : - _os.write_tuple_head(2); - _os.write_atom("tk_wstring"); - _os.write_ulong(_tc.length()); - break; - case TCKind._tk_struct: - len = _tc.member_count(); - _os.write_tuple_head(4); - _os.write_atom("tk_struct"); - _os.write_string(_tc.id()); - _os.write_string(_tc.name()); - // Member list - _os.write_list_head(len); - for(int i=0; i<len; i++) { - _os.write_tuple_head(2); - _os.write_string(_tc.member_name(i)); - marshal(_os,_tc.member_type(i)); - } - _os.write_nil(); - break; - case TCKind._tk_union: - len = _tc.member_count(); - _os.write_tuple_head(6); - _os.write_atom("tk_union"); - _os.write_string(_tc.id()); - _os.write_string(_tc.name()); - marshal(_os,_tc.discriminator_type()); - _os.write_int(_tc.default_index()); - // Member list - _os.write_list_head(len); - for(int i=0; i<len; i++) { - _os.write_tuple_head(3); - _tc.member_label(i).write_value(_os); - _os.write_string(_tc.member_name(i)); - marshal(_os,_tc.member_type(i)); - } - _os.write_nil(); - break; - case TCKind._tk_sequence: - _os.write_tuple_head(3); - _os.write_atom("tk_sequence"); - marshal(_os,_tc.content_type()); - _os.write_int(_tc.length()); - break; - case TCKind._tk_array: - _os.write_tuple_head(3); - _os.write_atom("tk_array"); - marshal(_os,_tc.content_type()); - _os.write_int(_tc.length()); - break; - case TCKind._tk_enum: - len = _tc.member_count(); - _os.write_tuple_head(4); - _os.write_atom("tk_enum"); - _os.write_string(_tc.id()); - _os.write_string(_tc.name()); - _os.write_list_head(len); - for(int i=0; i<len; i++) - _os.write_string(_tc.member_name(i)); - _os.write_nil(); - break; - case TCKind._tk_any: - _os.write_atom("tk_any"); - break; - case TCKind._tk_void : - _os.write_atom("tk_void"); - break; - /* - * Not supported types - */ - default : - throw new java.lang.Exception("Unsupported type"); - - } - - } - - - /** - Unmarshal operation for TypeCode. - @return TypeCode, the TypeCode read from the input stream. - **/ - public static TypeCode unmarshal(com.ericsson.otp.erlang.OtpInputStream _is) - throws java.lang.Exception { - - TypeCode _tc, __member; - TCKind __kind; - int __len; - int __tag = _is.peek(); - - switch(__tag) { - case (com.ericsson.otp.erlang.OtpExternal.atomTag): - case (com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag): - case (com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag): - __kind = TypeCode.kind(_is.read_atom()); - - switch(__kind.value()) { - case TCKind._tk_short : - case TCKind._tk_ushort : - case TCKind._tk_long : - case TCKind._tk_longlong : - case TCKind._tk_ulong : - case TCKind._tk_ulonglong : - case TCKind._tk_float : - case TCKind._tk_double : - case TCKind._tk_boolean : - case TCKind._tk_char : - case TCKind._tk_wchar : - case TCKind._tk_octet : - case TCKind._tk_void : - case TCKind._tk_any : - _tc = new TypeCode(); - _tc.kind(__kind); - - return _tc; - default : - throw new java.lang.Exception("Unsupported type"); - } - - case (com.ericsson.otp.erlang.OtpExternal.smallTupleTag): - case (com.ericsson.otp.erlang.OtpExternal.largeTupleTag): - - __len = _is.read_tuple_head(); - __tag = _is.peek(); - - switch(__tag) { - - case (com.ericsson.otp.erlang.OtpExternal.atomTag): - case (com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag): - case (com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag): - - __kind = TypeCode.kind(_is.read_atom()); - _tc = new TypeCode(); - _tc.kind(__kind); - - switch(__kind.value()) { - - case TCKind._tk_string : - _tc.length((int)_is.read_ulong()); - return _tc; - - case TCKind._tk_wstring : - _tc.length((int)_is.read_ulong()); - return _tc; - - case TCKind._tk_struct: - - _tc.id(_is.read_string()); - _tc.name(_is.read_string()); - __len = _is.read_list_head(); - _tc.member_count(__len); - - for(int i=0; i<__len; i++) { - _is.read_tuple_head(); - _tc.member_name(i,_is.read_string()); - _tc.member_type(i,unmarshal(_is)); - } - _is.read_nil(); - - return _tc; - - - case TCKind._tk_union: - - _tc.id(_is.read_string()); - _tc.name(_is.read_string()); - _tc.discriminator_type(unmarshal(_is)); - _tc.default_index(_is.read_int()); - __len = _is.read_list_head(); - _tc.member_count(__len); - - for(int i=0; i<__len; i++) { - _is.read_tuple_head(); - - __tag = _is.peek(); - Any __label = new Any(); - TypeCode __label_type = new TypeCode(); - - __label_type.kind(com.ericsson.otp.ic.TCKind.tk_long); - __label.type(__label_type); - - switch(__tag) { - case (com.ericsson.otp.erlang.OtpExternal.stringTag): - java.lang.String __enum = _is.read_string(); - __label.insert_string(__enum); - break; - case (com.ericsson.otp.erlang.OtpExternal.atomTag): - case (com.ericsson.otp.erlang.OtpExternal.atomUtf8Tag): - case (com.ericsson.otp.erlang.OtpExternal.smallAtomUtf8Tag): - - java.lang.String __default = _is.read_atom(); - __label.insert_atom(__default); - break; - default: - __label.insert_long(_is.read_int()); - } - - _tc.member_label(i,__label); - _tc.member_name(i,_is.read_string()); - _tc.member_type(i,unmarshal(_is)); - } - _is.read_nil(); - - return _tc; - - - case TCKind._tk_sequence: - _tc.content_type(unmarshal(_is)); - _tc.length(_is.read_int()); - return _tc; - - - case TCKind._tk_array: - _tc.content_type(unmarshal(_is)); - _tc.length(_is.read_int()); - return _tc; - - - case TCKind._tk_enum: - - _tc.id(_is.read_string()); - _tc.name(_is.read_string()); - __len = _is.read_list_head(); - _tc.member_count(__len); - - for(int i=0; i<__len; i++) - _tc.member_name(i,_is.read_string()); - - _is.read_nil(); - - return _tc; - - default: - throw new java.lang.Exception("Unsupported type"); - - } - - default: - throw new java.lang.Exception("Unsupported type"); - } - - } - - return null; - } - -} - - diff --git a/lib/ic/prebuild.skip b/lib/ic/prebuild.skip deleted file mode 100644 index 8d1ef24091..0000000000 --- a/lib/ic/prebuild.skip +++ /dev/null @@ -1 +0,0 @@ -priv diff --git a/lib/ic/priv/lib/.gitignore b/lib/ic/priv/lib/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ic/priv/lib/.gitignore +++ /dev/null diff --git a/lib/ic/priv/obj/.gitignore b/lib/ic/priv/obj/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/ic/priv/obj/.gitignore +++ /dev/null diff --git a/lib/ic/src/Makefile b/lib/ic/src/Makefile deleted file mode 100644 index 6ad2fbeeb7..0000000000 --- a/lib/ic/src/Makefile +++ /dev/null @@ -1,219 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-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% -# -# -include $(ERL_TOP)/make/target.mk - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -W -endif - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(IC_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - ic \ - ic_erlbe \ - ic_cbe \ - icscan \ - icparse \ - iceval \ - ictype \ - ictk \ - icstruct \ - icenum \ - icpreproc \ - icunion \ - ic_pp \ - ic_pragma \ - ic_noc \ - ic_plainbe \ - ic_cclient \ - ic_cserver \ - ic_fetch \ - ic_code \ - ic_codegen \ - ic_error \ - ic_file \ - ic_forms \ - ic_genobj \ - ic_options \ - ic_symtab \ - ic_util \ - ic_jbe \ - ic_struct_java \ - ic_union_java \ - ic_enum_java \ - ic_constant_java \ - ic_sequence_java \ - ic_array_java \ - ic_attribute_java \ - ic_java_type \ - ic_erl_template - - -CCL_EX_FILES = \ - ../examples/c-client/ReadMe \ - ../examples/c-client/Makefile \ - ../examples/c-client/client.c \ - ../examples/c-client/random.idl \ - ../examples/c-client/rmod_random_impl.erl \ - ../examples/c-client/test.erl - -CSRV_EX_FILES = \ - ../examples/c-server/ReadMe \ - ../examples/c-server/Makefile \ - ../examples/c-server/client.c \ - ../examples/c-server/client.erl \ - ../examples/c-server/server.c \ - ../examples/c-server/callbacks.c \ - ../examples/c-server/random.idl - -EPL_EX_FILES = \ - ../examples/erl-plain/ReadMe \ - ../examples/erl-plain/rmod_random_impl.erl \ - ../examples/erl-plain/random.idl - - -ESRV_EX_FILES = \ - ../examples/erl-genserv/ReadMe \ - ../examples/erl-genserv/rmod_random_impl.erl \ - ../examples/erl-genserv/random.idl - -JAVA_EX_FILES = \ - ../examples/java-client-server/ReadMe \ - ../examples/java-client-server/client.java \ - ../examples/java-client-server/server.java \ - ../examples/java-client-server/serverImpl.java \ - ../examples/java-client-server/random.idl - -MIXED_EX_FILES = \ - ../examples/all-against-all/ReadMe \ - ../examples/all-against-all/Makefile \ - ../examples/all-against-all/client.erl \ - ../examples/all-against-all/server.erl \ - ../examples/all-against-all/client.c \ - ../examples/all-against-all/server.c \ - ../examples/all-against-all/callbacks.c \ - ../examples/all-against-all/client.java \ - ../examples/all-against-all/server.java \ - ../examples/all-against-all/serverImpl.java \ - ../examples/all-against-all/random.idl - - -EXTERNAL_HRL_FILES= - -INTERNAL_HRL_FILES = \ - ic.hrl \ - ic_debug.hrl \ - icforms.hrl - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -YRL_FILE = icparse.yrl - -GEN_FILES = icparse.erl - -APP_FILE = ic.app -APP_SRC = $(APP_FILE).src -APP_TARGET = $(EBIN)/$(APP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_LOCAL_FLAGS += -pa ../../ic/ebin -# The -pa option is just used temporary until erlc can handle -# includes from other directories than ../include . -ERL_COMPILE_FLAGS += \ - $(ERL_LOCAL_FLAGS) \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,"ic_$(VSN)"}' \ - -D'COMPILERVSN="$(VSN)"' -YRL_FLAGS = -Iicyeccpre.hrl - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) $(APP_TARGET) - -clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) - rm -f errs core *~ - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -docs: - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- -../ebin/icparse.beam: icparse.erl - $(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_unused_vars +nowarn_unused_function -o$(EBIN) +pj $< - -icparse.erl: icparse.yrl icyeccpre.hrl - -### $(ERLC) $(YRL_FLAGS) $< - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) $(YRL_FILE) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/examples" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/c-client" - $(INSTALL_DATA) $(CCL_EX_FILES) "$(RELSYSDIR)/examples/c-client" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/c-server" - $(INSTALL_DATA) $(CSRV_EX_FILES) "$(RELSYSDIR)/examples/c-server" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/erl-plain" - $(INSTALL_DATA) $(EPL_EX_FILES) "$(RELSYSDIR)/examples/erl-plain" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/erl-genserv" - $(INSTALL_DATA) $(ESRV_EX_FILES) "$(RELSYSDIR)/examples/erl-genserv" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/java-client-server" - $(INSTALL_DATA) $(JAVA_EX_FILES) "$(RELSYSDIR)/examples/java-client-server" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/all-against-all" - $(INSTALL_DATA) $(MIXED_EX_FILES) "$(RELSYSDIR)/examples/all-against-all" - -release_docs_spec: - diff --git a/lib/ic/src/ic.app.src b/lib/ic/src/ic.app.src deleted file mode 100644 index 7dd47ac9c6..0000000000 --- a/lib/ic/src/ic.app.src +++ /dev/null @@ -1,53 +0,0 @@ -{application, ic, - [{description, "The IDL Compiler"}, - {vsn, "%VSN%"}, - {modules, - [ - ic, - ic_cclient, - ic_cbe, - ic_cserver, - ic_erlbe, - ic_fetch, - ic_noc, - ic_plainbe, - ic_pp, - ic_pragma, - icenum, - iceval, - icparse, - icpreproc, - icscan, - icstruct, - ictk, - ictype, - ic_array_java, - ic_attribute_java, - ic_code, - ic_codegen, - ic_constant_java, - ic_enum_java, - ic_error, - ic_file, - ic_forms, - ic_genobj, - ic_java_type, - ic_jbe, - ic_options, - ic_sequence_java, - ic_struct_java, - ic_symtab, - ic_union_java, - ic_util, - icunion, - ic_erl_template - ] - }, - {registered, []}, - {applications, [stdlib, kernel]}, - {env, []}, - {mod, {ic, []}}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} -]}. - - diff --git a/lib/ic/src/ic.erl b/lib/ic/src/ic.erl deleted file mode 100644 index 062fbef435..0000000000 --- a/lib/ic/src/ic.erl +++ /dev/null @@ -1,415 +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% -%% -%% --module(ic). - - --export([sgen/1, gen/1, gen/2, help/0, compile/3]). - - -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --export([filter_params/2, handle_preproc/4, do_gen/4]). - --import(lists, [foldr/3]). - - --include("icforms.hrl"). --include("ic.hrl"). - --include_lib("stdlib/include/erl_compile.hrl"). - --export([make_erl_options/1]). % For erlc - --export([main/3, do_scan/1, do_parse/2, do_type/2]). - - -%%------------------------------------------------------------ -%% -%% Entry point -%% -%%------------------------------------------------------------ - -%% compile(AbsFileName, Outfile, Options) -%% Compile entry point for erl_compile. - -compile(File, _OutFile, Options) -> - case gen(File, make_erl_options(Options)) of - ok -> ok; - Other -> Other - end. - - -%% Entry for the -s switch -sgen(ArgList) -> -%%% io:format("sgen called w ~p~n", [ArgList]), - apply(?MODULE, gen, ArgList). - - -gen(File) -> - gen(File, []). - -gen(File, Opts) -> - G = ic_genobj:new(Opts), - IdlFile = ic_file:add_dot_idl(File), - case ic_options:get_opt(G, show_opts) of - true -> - io:format("Opts: ~p~n", [ic_options:which_opts(G)]); - _ -> ok - end, - ic_genobj:set_idlfile(G, IdlFile), - case catch gen2(G, File, Opts) of - {_, {'EXIT', R}} -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - io:format("Fatal error : ~p~n",[R]), - error; - {_, {'EXIT', _, R}} -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - io:format("Fatal error : ~p~n",[R]), - error; - {'EXIT', R} -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - io:format("Fatal error : ~p~n",[R]), - error; - {'EXIT', _, R} -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - io:format("Fatal error : ~p~n",[R]), - error; - %% In this case, the pragma registration - %% found errors so this should return error. - error -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - error; - _ -> - X = ic_error:return(G), - ic_genobj:free_table_space(G), %% Free space for all ETS tables - X - end. - - -gen2(G, File, Opts) -> - case ic_options:get_opt(G, time) of - true -> - time("TOTAL ", ic, main, [G, File, Opts]); - _ -> - case main(G, File, Opts) of - error -> - error; - _ -> - ok - end - end. - - - -do_gen(erl_corba, G, File, T) -> - ic_erlbe:do_gen(G, File, T); -do_gen(erl_template, G, File, T) -> - ic_erl_template:do_gen(G, File, T); -do_gen(erl_genserv, G, File, T) -> - ic_erlbe:do_gen(G, File, T); -do_gen(c_genserv, G, File, T) -> - ic_cclient:do_gen(G, File, T); -do_gen(noc, G, File, T) -> - ic_noc:do_gen(G, File, T); -do_gen(erl_plain, G, File, T) -> - ic_plainbe:do_gen(G, File, T); -do_gen(c_server, G, File, T) -> - ic_cserver:do_gen(G, File, T); -do_gen(c_client, G, File, T) -> - ic_cclient:do_gen(G, File, T); -%% Java backend -do_gen(java, G, File, T) -> - ic_jbe:do_gen(G, File, T); -%% No language choice -do_gen(_,_,_,_) -> - ok. - -do_scan(G) -> - icscan:scan(G, ic_genobj:idlfile(G)). - - -do_parse(G, Tokens) -> - case icparse:parse(Tokens) of - {ok, L} -> L; - X when element(1, X) == error -> - Err = element(2, X), - ic_error:fatal_error(G, {parse_error, element(1, Err), - element(3, Err)}); - X -> exit(X) - end. - - -do_type(G, Form) -> - ictype:type_check(G, Form). - -time(STR,M,F,A) -> - case timer:tc(M, F, A) of - {_, {'EXIT', R}} -> exit(R); - {_, {'EXIT', _, R}} -> exit(R); - {_, _X} when element(1, _X)==error -> throw(_X); - {_T, _R} -> - io:format("Time for ~s: ~10.2f~n", [STR, _T/1000000]), - _R - end. - - - -%% Filters parameters so that only those with certain attributes are -%% seen. The filter parameter is a list of attributes that will be -%% seen, ex. [in] or [inout, out] -filter_params(Filter, Params) -> - lists:filter(fun(P) -> - lists:member(get_param_attr(P#param.inout), Filter) end, - Params). - - -%% Access primitive to get the attribute name (and discard the line -%% number). -get_param_attr({A, _N}) -> A. - - -%% -%% Fixing the preproc directives -%% -handle_preproc(G, _N, line_nr, X) -> - Id = ic_forms:get_id2(X), - Flags = X#preproc.aux, - case Flags of - [] -> ic_genobj:push_file(G, Id); - _ -> - foldr(fun({_, _, "1"}, Gprim) -> ic_genobj:push_file(Gprim, Id); - ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id); - ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end, - G, Flags) - end; -handle_preproc(G, _N, _Other, _X) -> - G. - - - -%%------------------------------------------------------------ -%% -%% The help department -%% -%% -%% -%%------------------------------------------------------------ - -help() -> - io:format("No help available at the moment~n", []), - ok. - -print_version_str(G) -> - case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of - {true, _} -> ok; - {_, true} -> ok; - _ -> - io:format("Erlang IDL compiler version ~s~n", [?COMPILERVSN]) - end. - - - -%% -%% Converts generic compiler options to specific options. -%% -%% Used by erlc -%% - -make_erl_options(Opts) -> - - %% This way of extracting will work even if the record passed - %% has more fields than known during compilation. - - Includes1 = Opts#options.includes, - Defines = Opts#options.defines, - Outdir = Opts#options.outdir, - Warning = Opts#options.warning, - Verbose = Opts#options.verbose, - Specific = Opts#options.specific, - Optimize = Opts#options.optimize, - PreProc = - lists:flatten( - lists:map(fun(D) -> io_lib:format("-I\"~ts\" ", [ic_util:to_list(D)]) end, - Includes1)++ - lists:map( - fun ({Name, Value}) -> - io_lib:format("-D~s=~s ", [ic_util:to_list(Name), ic_util:to_list(Value)]); - (Name) -> - io_lib:format("-D~s ", [ic_util:to_list(Name)]) - end, - Defines)), - Options = - case Verbose of - true -> []; - false -> [] - end ++ - case Warning of - 0 -> [nowarn]; - _ -> ['Wall'] - end ++ - case Optimize of - 0 -> []; - _ -> [] - end, - - Options++[{outdir, Outdir}, {preproc_flags, PreProc}]++Specific. - - -%%% -%%% NEW main, avoids memory fragmentation -%%% -main(G, File, _Opts) -> - print_version_str(G), - ?ifopt(G, time, io:format("File ~p compilation started : ~p/~p/~p ~p:~2.2.0p~n", - [ic_genobj:idlfile(G), - element(1,date()), - element(2, date()), - element(3, date()), - element(1, time()), - element(2, time())])), - - case ic_options:get_opt(G, help) of - true -> help(); - - _ -> - scanning(G, File) - end. - - - -scanning(G, File) -> - S = ?ifopt2(G, time, - time("input file scanning ", ic, do_scan, [G]), - ic:do_scan(G)), - ?ifopt2(G, tokens, io:format("TOKENS: ~p~n", [S]), - parsing(G, File, S)). - -parsing(G, File, S) -> - T = ?ifopt2(G, - time, - time("input file parsing ", ic, do_parse, [G,S]), - ic:do_parse(G,S)), - ?ifopt2(G, form, io:format("PARSE FORM: ~p~n", [T]), - pragma(G, File, T)). - - - -pragma(G, File, T) -> - case ?ifopt2(G, - time, - time("pragma registration ", ic_pragma, pragma_reg, [G,T]), - ic_pragma:pragma_reg(G,T)) of - %% All pragmas were successfully applied - {ok,Clean} -> - typing(G, File, Clean); - - error -> - error - end. - - -typing(G, File, Clean) -> - case catch ?ifopt2(G, - time, - time("type code appliance ", ic, do_type, [G,Clean]), - ic:do_type(G,Clean)) of - {'EXIT',Reason} -> - io:format("Error under type appliance : ~p~n",[Reason]), - error; - - T2 -> - ?ifopt2(G, tform, io:format("TYPE FORM: ~p~n", [T2]), - generation(G, File, T2)) - end. - - - -generation(G, File, T2) -> - case ic_options:get_opt(G, multiple_be) of - false -> - single_generation(G, File, T2); - List -> - OutDir = - case ic_options:get_opt(G, outdir) of - false -> - []; - Dir -> - Dir - end, - - case ic_options:get_opt(G, be) of - false -> - ok; - Be -> - %% Generate this first - ic_options:add_opt(G,[{outdir,OutDir++atom_to_list(Be)}],true), - single_generation(G, File, T2) - end, - multiple_generation(G, File, T2, OutDir, List) - end. - -multiple_generation(_G, _File, _T2, _RootDir, []) -> - ok; -multiple_generation(G, File, T2, RootDir, [Be|Bes]) -> - ic_options:add_opt(G,[{outdir,RootDir++atom_to_list(Be)}],true), - ic_options:add_opt(G,[{be,Be}],true), - single_generation(G, File, T2), - - case ic_error:get_error_count(G) of - 0 -> - multiple_generation(G,File,T2,RootDir,Bes); - _ -> - %% Errors reported, abort - ok - end. - - -single_generation(G, File, T2) -> - case ic_error:get_error_count(G) of - 0 -> - %% Check if user has sett backend option - case ic_options:get_opt(G, be) of - false -> - %% Use default backend option - DefaultBe = ic_options:defaultBe(), - ic_options:add_opt(G,[{be,DefaultBe}],true), - - ?ifopt2(G, - time, - time("code generation ", ic, do_gen, [DefaultBe, G, File, T2]), - ic:do_gen(DefaultBe, G, File, T2)); - Be -> - %% Use user defined backend - ?ifopt2(G, - time, - time("code generation ", ic, do_gen, [Be, G, File, T2]), - ic:do_gen(Be, G, File, T2)) - end; - _ -> - ok %% Does not matter - end. - - - diff --git a/lib/ic/src/ic.hrl b/lib/ic/src/ic.hrl deleted file mode 100644 index cf4b6a50d6..0000000000 --- a/lib/ic/src/ic.hrl +++ /dev/null @@ -1,159 +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% -%% -%% - - -%%------------------------------------------------------------ -%% Configuration macros --define(CORBAMOD, corba). --define(ORBNAME, orber). --define(CORBAHRL, "corba.hrl"). --define(CALL, "call"). --define(CAST, "cast"). --define(IFRREGID, "register"). --define(IFRTYPESHRL, "ifr_types.hrl"). - --define(GENSERVMOD, gen_server). - -%%------------------------------------------------------------ -%% Flags. NOTE! Once assigned value may NOT be changed. Deprecate ok. -%% Default flags. Can be changed if we change the default behavior. --define(IC_FLAG_TEMPLATE_1, 16#01). --define(IC_FLAG_TEMPLATE_2, 16#02). - --define(IC_INIT_FLAGS, 16#00). - -%% Flag operations -%% USAGE: Boolean = ?IC_FLAG_TEST(Flags, ?IC_ATTRIBUTE) --define(IC_FLAG_TEST(_F1, _I1), ((_F1 band _I1) == _I1)). - -%% USAGE: NewFlags = ?IC_SET_TRUE(Flags, ?IC_ATTRIBUTE) --define(IC_SET_TRUE(_F2, _I2), (_I2 bor _F2)). - -%% USAGE: NewFlags = ?IC_SET_FALSE(Flags, ?IC_ATTRIBUTE) --define(IC_SET_FALSE(_F3, _I3), ((_I3 bxor 16#ff) band _F3)). - -%% USAGE: NewFlags = ?IC_SET_FALSE_LIST(Flags, [?IC_SEC_ATTRIBUTE, ?IC_SOME]) --define(IC_SET_FALSE_LIST(_F4, _IList1), - lists:foldl(fun(_I4, _F5) -> - ((_I4 bxor 16#ff) band _F5) - end, - _F4, _IList1)). - -%% USAGE: NewFlags = ?IC_SET_TRUE_LIST(Flags, [?IC_ATTRIBUTE, ?IC_SOME]) --define(IC_SET_TRUE_LIST(_F6, _IList2), - lists:foldl(fun(_I6, _F7) -> - (_I6 bor _F7) - end, - _F6, _IList2)). - -%% USAGE: Boolean = ?IC_FLAG_TEST_LIST(Flags, [?IC_CONTEXT, ?IC_THING]) --define(IC_FLAG_TEST_LIST(_F8, _IList3), - lists:all(fun(_I7) -> - ((_F8 band _I7) == _I7) - end, - _IList3)). - - -%%------------------------------------------------------------ -%% Usefull macros - --define(ifthen(P,ACTION), if P -> ACTION; true->true end). - - -%%------------------------------------------------------------ -%% Option macros - --define(ifopt(G,OPT,ACTION), - case ic_options:get_opt(G,OPT) of true -> ACTION; _ -> ok end). - --define(ifopt2(G,OPT,ACT1,ACT2), - case ic_options:get_opt(G,OPT) of true -> ACT1; _ -> ACT2 end). - --define(ifnopt(G,OPT,ACTION), - case ic_options:get_opt(G,OPT) of false -> ACTION; _ -> ok end). - - -%% Internal record --record(id_of, {id, type, tk}). - -%%-------------------------------------------------------------------- -%% The generator object definition - --record(genobj, {symtab, impl, options, warnings, auxtab, - tktab, pragmatab, c_typedeftab, - skelfile=[], skelfiled=[], skelscope=[], - stubfile=[], stubfiled=[], stubscope=[], - includefile=[], includefiled=[], - interfacefile=[],interfacefiled=[], - helperfile=[],helperfiled=[], - holderfile=[],holderfiled=[], - filestack=0, do_gen=true, sysfile=false}). - -%%-------------------------------------------------------------------- -%% The scooped id definition --record(scoped_id, {type=local, line=-1, id=""}). - - - - - - - - -%%-------------------------------------------------------------------- -%% Secret macros -%% -%% NOTE these macros are not general, they cannot be used -%% everywhere. -%% --define(lookup(T,K), case ets:lookup(T, K) of [{_X, _Y}] -> _Y; _->[] end). --define(insert(T,K,V), ets:insert(T, {K, V})). - - -%%--------------------------------------------------------------------- -%% -%% Java specific macros -%% -%% --define(ERLANGPACKAGE,"com.ericsson.otp.erlang."). --define(ICPACKAGE,"com.ericsson.otp.ic."). - - -%% -%% Macros for reporting encode/decode errors in C back-ends. -%% -%% - --define(emit_c_enc_rpt(Fd, Fill, Fmt, Vals), - begin - CType = ic_cbe:mk_c_type2(G, N, T), - ic_codegen:emit_c_enc_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals]) - end). --define(emit_c_dec_rpt(Fd, Fill, Fmt, Vals), - begin - CType = ic_cbe:mk_c_type2(G, N, T), - ic_codegen:emit_c_dec_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals]) - end). - - - - - diff --git a/lib/ic/src/ic_array_java.erl b/lib/ic/src/ic_array_java.erl deleted file mode 100644 index 64d1b8a9ba..0000000000 --- a/lib/ic/src/ic_array_java.erl +++ /dev/null @@ -1,296 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - --module(ic_array_java). - --export([gen/4]). - --include("ic.hrl"). --include("icforms.hrl"). - - -gen(G, N, X, Array) when is_record(X, member) -> - ArrayName = ic_forms:get_java_id(Array), - ArrayElement = ic_forms:get_type(X), - emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), - emit_helper_class(G, N, X, Array, ArrayName, ArrayElement); -gen(G, N, X, Array) when is_record(X, case_dcl) -> - ArrayName = ic_forms:get_java_id(Array), - ArrayElement = ic_forms:get_type(X), - emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), - emit_helper_class(G, N, X, Array, ArrayName, ArrayElement); -gen(G, N, X, Array) -> - ArrayName = ic_forms:get_java_id(Array), - ArrayElement = ic_forms:get_body(X), - emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), - emit_helper_class(G, N, X, Array, ArrayName, ArrayElement). - - - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, _X, Array, ArrayName, ArrayElement) -> - SName = string:concat(ArrayName, "Holder"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - ArrayElementName = ic_java_type:getType(G, N, ArrayElement), - EmptyDim = arrayEmptyDim(Array), - - ic_codegen:emit(Fd, "final public class ~sHolder {\n",[ArrayName]), - - ic_codegen:emit(Fd, " // instance variables\n", []), - ic_codegen:emit(Fd, " public ~s~s value;\n\n", - [ArrayElementName,EmptyDim]), - - ic_codegen:emit(Fd, " // constructors\n", []), - ic_codegen:emit(Fd, " public ~sHolder() {}\n", [ArrayName]), - ic_codegen:emit(Fd, " public ~sHolder(~s~s initial) {\n", - [ArrayName,ArrayElementName,EmptyDim]), - ic_codegen:emit(Fd, " value = initial;\n", []), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // methods\n", []), - - ic_codegen:emit(Fd, " public void _marshal(~sOtpOutputStream out)\n", [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " ~sHelper.marshal(out, value);\n", [ArrayName]), - ic_codegen:emit(Fd, " }\n"), - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, " public void _unmarshal(~sOtpInputStream in)\n", [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " value = ~sHelper.unmarshal(in);\n", [ArrayName]), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, "}\n", []), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_helper_class/4 -%%----------------------------------------------------------------- -emit_helper_class(G, N, X, Array, ArrayName, ArrayElement) -> - SName = string:concat(ArrayName, "Helper"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - ArrayElementName = ic_java_type:getType(G, N, ArrayElement), - EmptyDim = arrayEmptyDim(Array), -% Dim = arrayDim(G,N,Array), - - ic_codegen:emit(Fd, "public class ~sHelper {\n",[ArrayName]), - - ic_codegen:emit(Fd, " // constructors\n"), - ic_codegen:emit(Fd, " private ~sHelper() {}\n\n", [ArrayName]), - - ic_codegen:emit(Fd, " // methods\n"), - - ic_codegen:emit(Fd, " public static void marshal(~sOtpOutputStream _out, ~s~s _value)\n", - [?ERLANGPACKAGE,ArrayElementName,EmptyDim]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - emit_array_marshal_loop(G,N,X,Array,ArrayElement,Fd), - ic_codegen:emit(Fd, " }\n"), - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, " public static ~s~s unmarshal(~sOtpInputStream _in)\n", - [ArrayElementName,EmptyDim,?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - ic_codegen:emit(Fd, " ~s~s _value = new ~s;\n\n", - [ArrayElementName,EmptyDim,ic_java_type:getFullType(G, N, X, Array)]), - emit_array_unmarshal_loop(G,N,X,Array,ArrayElement,Fd), - ic_codegen:emit(Fd, " return _value;\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static String id() {\n", []), - ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, Array)]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static String name() {\n", []), - ic_codegen:emit(Fd, " return ~p;\n",[ArrayName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_jbe:emit_type_function(G, N, X, Fd), - - ic_codegen:emit(Fd, " public static void insert(~sAny _any, ~s~s _this)\n", - [?ICPACKAGE,ArrayElementName,EmptyDim]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " ~sOtpOutputStream _os = \n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " new ~sOtpOutputStream();\n\n",[?ERLANGPACKAGE]), - - ic_codegen:emit(Fd, " _any.type(type());\n"), - ic_codegen:emit(Fd, " marshal(_os, _this);\n"), - ic_codegen:emit(Fd, " _any.insert_Streamable(_os);\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static ~s~s extract(~sAny _any)\n", - [ArrayElementName,EmptyDim,?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " return unmarshal(_any.extract_Streamable());\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n"), - file:close(Fd). - - - - -emit_array_marshal_loop(G,N,X,Array,AEl,Fd) -> - DimList = mk_array_dim_list(G,N,Array), - emit_array_marshal_loop_1(G,N,X,Array,AEl,DimList,0,Fd). - - -emit_array_marshal_loop_1(G,N,X,Array,AEl,[D],C,Fd) -> - - DimList = mk_array_dim_list(G,N,Array), - - ic_codegen:emit(Fd, " _out.write_tuple_head(~s);\n\n",[D]), - - ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++)\n",[C,C,D,C]), - - case ic_java_type:isBasicType(G, N, AEl) of - true -> - ic_codegen:emit(Fd, " _out~s(_value", - [ic_java_type:marshalFun(G, N, X, AEl)]); - false -> - ic_codegen:emit(Fd, " ~s(_out, _value", - [ic_java_type:marshalFun(G, N, X, AEl)]) - end, - - emit_array_dimensions(DimList,0,Fd), - - ic_codegen:emit(Fd, ");\n\n"); - -emit_array_marshal_loop_1(G,N,X,Array,AEl,[D|Ds],C,Fd) -> -% DimList = mk_array_dim_list(G,N,Array), - - ic_codegen:emit(Fd, " _out.write_tuple_head(~s);\n\n",[D]), - - ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++) {\n",[C,C,D,C]), - - emit_array_marshal_loop_1(G,N,X,Array,AEl,Ds,C+1,Fd), - - ic_codegen:emit(Fd, " }\n\n"). - - - - - -emit_array_unmarshal_loop(G,N,X,Array,AEl,Fd) -> - DimList = mk_array_dim_list(G,N,Array), - case length(DimList) > 0 of - true -> - ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), - - ic_codegen:emit(Fd, " for(int _tmp0 = 0; _tmp0 < ~s; _tmp0++) {\n\n",[hd(DimList)]), - emit_array_unmarshal_loop_1(G,N,X,Array,AEl,tl(DimList),1,Fd), - ic_codegen:emit(Fd, " }\n\n"); - false -> - emit_array_unmarshal_loop_1(G,N,X,Array,AEl,DimList,0,Fd) - end. - -emit_array_unmarshal_loop_1(G,N,X,_Array,AEl,[],1,Fd) -> %% One dimensional array - case ic_java_type:isBasicType(G, N, AEl) of - true -> - ic_codegen:emit(Fd, " _value[_tmp0] = _in~s;\n", - [ic_java_type:unMarshalFun(G, N, X, AEl)]); - false -> - ic_codegen:emit(Fd, " _value[_tmp0] = ~s.unmarshal(_in);\n\n", - [ic_java_type:getUnmarshalType(G, N, X, AEl)]) - end; -emit_array_unmarshal_loop_1(G,N,X,Array,AEl,[],_C,Fd) -> - DimList = mk_array_dim_list(G,N,Array), - ic_codegen:emit(Fd, " _value"), - emit_array_dimensions(DimList,0,Fd), - case ic_java_type:isBasicType(G,N,AEl) of - true -> - ic_codegen:emit(Fd, " = _in~s;\n", - [ic_java_type:unMarshalFun(G, N, X, AEl)]); - false -> - ic_codegen:emit(Fd, " = ~s.unmarshal(_in);\n", - [ic_java_type:getUnmarshalType(G, N, X, AEl)]) - end; -emit_array_unmarshal_loop_1(G,N,X,Array,AEl,[D|Ds],C,Fd) -> - ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), - - ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++) {\n\n",[C,C,D,C]), - emit_array_unmarshal_loop_1(G,N,X,Array,AEl,Ds,C+1,Fd), - ic_codegen:emit(Fd, " }\n"). - - - - - -%%--------------------------------------------------- -%% Utilities -%%--------------------------------------------------- - -mk_array_dim_list(G,N,Array) -> - mk_array_dim_list2(G,N,Array#array.size). - - -mk_array_dim_list2(_G,_N,[]) -> - []; - -mk_array_dim_list2(G,N,[D |Ds]) when is_record(D,scoped_id) -> - {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), - [ ic_util:to_dot(G,FSN) | mk_array_dim_list2(G,N,Ds)]; - -mk_array_dim_list2(G,N,[D |Ds]) -> - [ic_util:eval_java(G,N,D) | mk_array_dim_list2(G,N,Ds)]. - - - -%% Array dimension string -%arrayDim(G,N,X) -> -% arrayDim2(G,N,X#array.size). - -%arrayDim2(_G,_N,[]) -> -% ""; -%arrayDim2(G,N,[D|Ds]) when record(D,scoped_id) -> -% {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), -% "[" ++ ic_util:to_dot(G,FSN) ++ "]" ++ arrayDim2(G,N,Ds); -%arrayDim2(G,N,[D|Ds]) -> -% "[" ++ ic_util:eval_java(G,N,D) ++ "]" ++ arrayDim2(G,N,Ds). - - -%% Array Empty dimension string -arrayEmptyDim(X) -> - arrayEmptyDim2(X#array.size). - -arrayEmptyDim2([_D]) -> - "[]"; -arrayEmptyDim2([_D |Ds]) -> - "[]" ++ arrayEmptyDim2(Ds). - - -emit_array_dimensions([_D],C,Fd) -> - ic_codegen:emit(Fd, "[_tmp~p]",[C]); -emit_array_dimensions([_D|Ds],C,Fd) -> - ic_codegen:emit(Fd, "[_tmp~p]",[C]), - emit_array_dimensions(Ds,C+1,Fd). - - - - - - diff --git a/lib/ic/src/ic_attribute_java.erl b/lib/ic/src/ic_attribute_java.erl deleted file mode 100644 index ddbc6d24f5..0000000000 --- a/lib/ic/src/ic_attribute_java.erl +++ /dev/null @@ -1,413 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - --module(ic_attribute_java). - --include("icforms.hrl"). --include("ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([emit_attribute_prototype/4, - emit_attribute_stub_code/4, - emit_atrribute_on_dictionary/5, - emit_attribute_switch_case/5]). - - - - - -%%%----------------------------------------------------- -%%% -%%% Generates operation in interface -%%% -%%%----------------------------------------------------- -emit_attribute_prototype(G, N, X, Fd) -> - emit_attribute_prototype(G, N, X, Fd, ic_forms:get_idlist(X)). - -emit_attribute_prototype(_G, _N, _X, _Fd, []) -> - ok; -emit_attribute_prototype(G, N, X, Fd, [V|Vs]) -> - WireAttrName = ic_forms:get_id(V), - AttrName = ic_forms:get_java_id(WireAttrName), - emit_attr_prototype(G, N, X, Fd, AttrName,WireAttrName), - emit_attribute_prototype(G, N, X, Fd, Vs). - - -emit_attr_prototype(G, N, X, Fd, OpName, WireOpName) -> - - ic_codegen:emit(Fd, "/****\n"), - ic_codegen:emit(Fd, " * Attribute ~p interface functions \n", [ic_util:to_colon([WireOpName|N])]), - ic_codegen:emit(Fd, " *\n"), - ic_codegen:emit(Fd, " */\n\n"), - - AT = ic_forms:get_type(X), - Type = ic_java_type:getType(G, N, AT), -% HolderType = ic_java_type:getHolderType(G, N, AT), - - ic_codegen:emit(Fd, " ~s ~s() throws java.lang.Exception;\n\n",[Type, OpName]), - - case X#attr.readonly of - {readonly, _} -> - ok; - _ -> - ic_codegen:emit(Fd, " void ~s(~s _value) throws java.lang.Exception;\n\n",[OpName, Type]) - end. - - - -%%%----------------------------------------------------- -%%% -%%% Generates attribute insertion in dictionary -%%% -%%%----------------------------------------------------- -emit_atrribute_on_dictionary(G, N, X, Fd, C) -> - emit_atrribute_on_dictionary(G, N, X, Fd, C, ic_forms:get_idlist(X)). - -emit_atrribute_on_dictionary(_G, _N, _X, _Fd, C, []) -> - C; -emit_atrribute_on_dictionary(G, N, X, Fd, C, [V|Vs]) -> - - WireAttrName = ic_forms:get_id(V), - - ic_codegen:emit(Fd, " _operations.put(\"_get_~s\", new java.lang.Integer(~p));\n", - [WireAttrName,C]), - - case X#attr.readonly of - {readonly, _} -> - - emit_atrribute_on_dictionary(G, N, X, Fd, C+1, Vs); - - _ -> - - ic_codegen:emit(Fd, " _operations.put(\"_set_~s\", new java.lang.Integer(~p));\n", - [WireAttrName,C+1]), - - emit_atrribute_on_dictionary(G, N, X, Fd, C+2, Vs) - end. - - - -%%%----------------------------------------------------- -%%% -%%% Generates attribute case in server switch -%%% -%%%----------------------------------------------------- -emit_attribute_switch_case(G, N, X, Fd, C) -> - Tk = ic_forms:get_tk(X), - emit_attribute_switch_case(G, N, X, Fd, Tk, C, ic_forms:get_idlist(X)). - -emit_attribute_switch_case(_G, _N, _X, _Fd, _Tk, C, []) -> - C; -emit_attribute_switch_case(G, N, X, Fd, Tk, C, [V|Vs]) -> - AttrName = ic_forms:get_java_id(V), - - emit_attribute_switch_case1(G,N,X,Fd,"_get_",AttrName,Tk,C), - - case X#attr.readonly of - {readonly, _} -> - emit_attribute_switch_case(G, N, X, Fd, Tk, C+1, Vs); - - _ -> - emit_attribute_switch_case1(G,N,X,Fd,"_set_",AttrName,Tk,C+1), - emit_attribute_switch_case(G, N, X, Fd, Tk, C+2, Vs) - end. - - -emit_attribute_switch_case1(G, N, X, Fd, "_get_", Name, _Tk, C) -> - - R = ic_forms:get_type(X), - RT = ic_java_type:getParamType(G,N,R,ret), - - ic_codegen:emit(Fd, " case ~p: { // Get operation for attribute ~s\n\n",[C,ic_util:to_dot([Name|N])]), - - ic_codegen:emit(Fd, " // Calling implementation function\n"), - ic_codegen:emit(Fd, " ~s _result = this.~s();\n\n", [RT, Name]), - - ic_codegen:emit(Fd, " // Marshalling output\n"), - ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.id(),__ref.creation()); // Call reference\n"), - - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " __os~s(_result); // Return value\n\n", - [ic_java_type:marshalFun(G,N,X,R)]); - false -> - ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n\n", - [ic_java_type:marshalFun(G,N,X,R)]) - end, - - ic_codegen:emit(Fd, " } break;\n\n"); - - -emit_attribute_switch_case1(G, N, X, Fd, "_set_", Name, _Tk, C) -> - ic_codegen:emit(Fd, " case ~p: { // Set operation for attribute ~s\n\n",[C,ic_util:to_dot([Name|N])]), - - Type = ic_forms:get_type(X), - - ic_codegen:emit(Fd, " // Preparing input\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n",[?ERLANGPACKAGE]), - - case ic_java_type:isBasicType(G,N,Type) of - true -> - ic_codegen:emit(Fd, " ~s _value = __is~s; // In value\n\n", - [ic_java_type:getParamType(G,N,Type,in), - ic_java_type:unMarshalFun(G,N,X,Type)]); - false -> - ic_codegen:emit(Fd, " ~s _value = ~s.unmarshal(__is); // In value\n\n", - [ic_java_type:getParamType(G,N,Type,in), - ic_java_type:getUnmarshalType(G,N,X,Type)]) - end, - - - ic_codegen:emit(Fd, " // Calling implementation function\n"), - ic_codegen:emit(Fd, " this.~s(_value);\n\n", [Name]), - - ic_codegen:emit(Fd, " // Marshalling output\n"), - ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.id(),__ref.creation()); // Call reference\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n\n"), - - ic_codegen:emit(Fd, " } break;\n\n"). - - - - - - - -%%%----------------------------------------------------- -%%% -%%% Generates attribute function in stub -%%% -%%%----------------------------------------------------- -emit_attribute_stub_code(G, N, X, Fd) -> - emit_attribute_stub_code(G, N, X, Fd, ic_forms:get_idlist(X)). - -emit_attribute_stub_code(_G, _N, _X, _Fd, []) -> - ok; -emit_attribute_stub_code(G, N, X, Fd, [V|Vs]) -> - WireAttrName = ic_forms:get_id(V), - AttrName = ic_forms:get_java_id(WireAttrName), - - emit_attribute_stub_code1(G,N,X,Fd,"_get_",AttrName,WireAttrName), - - case X#attr.readonly of - {readonly, _} -> - emit_attribute_stub_code(G, N, X, Fd, Vs); - - _ -> - emit_attribute_stub_code1(G,N,X,Fd,"_set_",AttrName,WireAttrName), - emit_attribute_stub_code(G, N, X, Fd, Vs) - end. - - -emit_attribute_stub_code1(G,N,X,Fd,"_get_",Name,WireName) -> - - Type = ic_forms:get_type(X), - RT = ic_java_type:getType(G,N,Type), - - %% - %% Main get operation - %% - ic_codegen:emit(Fd, " // Attribute ~p get operation implementation\n", [ic_util:to_colon([WireName|N])]), - ic_codegen:emit(Fd, " public ~s ~s() throws java.lang.Exception {\n\n", [RT, Name]), - - %% Function marshal call - ic_codegen:emit(Fd, " // Calling the marshal function\n"), - ic_codegen:emit(Fd, " _~s_marshal(_env);\n\n", [Name]), - - %% Sending call - ic_codegen:emit(Fd, " // Message send\n"), - ic_codegen:emit(Fd, " _env.send();\n\n"), - - %% Receiving return value - ic_codegen:emit(Fd, " // Message receive\n"), - ic_codegen:emit(Fd, " _env.receive();\n\n"), - - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - ic_codegen:emit(Fd, " return _~s_get_unmarshal(_env);\n", [Name]), - ic_codegen:emit(Fd, " }\n\n"), - - - %% - %% Marshal get operation - %% - ic_codegen:emit(Fd, " // Marshal operation for get attribute ~p\n", [Name]), - ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env)\n", - [Name, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get output stream\n"), - ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",[?ERLANGPACKAGE]), - - %% Initiating Message header - ic_codegen:emit(Fd, " // Message header assembly\n"), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), - - - %% Creating call identity tuple - ic_codegen:emit(Fd, " // Message identity part creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __env.write_client_pid();\n"), - ic_codegen:emit(Fd, " __env.write_client_ref();\n\n"), - - OpCallName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ic_util:to_undersc(["_get_"++WireName|N]); - false -> - "_get_"++WireName - end, - - %% Creating operation identity - ic_codegen:emit(Fd, " // Message operation part creation\n"), - ic_codegen:emit(Fd, " __os.write_atom(~p);\n\n",[OpCallName]), - - ic_codegen:emit(Fd, " }\n\n"), - - - %% - %% Unmarshal get operation - %% - MRT = ic_java_type:getParamType(G,N,Type,ret), - - ic_codegen:emit(Fd, " // Unmarshal operation for get attribute ~p\n", [Name]), - ic_codegen:emit(Fd, " public static ~s _~s_get_unmarshal(~sEnvironment __env)\n", - [MRT, Name, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - - ic_codegen:emit(Fd, " // Get input stream\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",[?ERLANGPACKAGE]), - - ic_codegen:emit(Fd, " // Extracting return value\n"), - case ic_java_type:isBasicType(G, N, Type) of - true -> - ic_codegen:emit(Fd, " return __is~s;\n", - [ic_java_type:unMarshalFun(G, N, X, Type)]); - false -> - ic_codegen:emit(Fd, " return ~s.unmarshal(__is);\n", - [ic_java_type:getUnmarshalType(G, N, X, Type)]) - end, - - ic_codegen:emit(Fd, " }\n\n"); - - -emit_attribute_stub_code1(G,N,X,Fd,"_set_",Name,WireName) -> - - Type = ic_forms:get_type(X), - - %% - %% Main set operation - %% - IT = ic_java_type:getType(G,N,Type), - - ic_codegen:emit(Fd, " // Attribute ~p set operation implementation\n", [ic_util:to_colon([WireName|N])]), - ic_codegen:emit(Fd, " public void ~s(~s _value) throws java.lang.Exception {\n\n", [Name,IT]), - - %% Function marshal call - ic_codegen:emit(Fd, " // Calling the marshal function\n"), - ic_codegen:emit(Fd, " _~s_marshal(_env, _value);\n\n", [Name]), - - %% Sending call - ic_codegen:emit(Fd, " // Message send\n"), - ic_codegen:emit(Fd, " _env.send();\n\n"), - - %% Receiving return value - ic_codegen:emit(Fd, " // Message receive\n"), - ic_codegen:emit(Fd, " _env.receive();\n\n"), - - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - ic_codegen:emit(Fd, " _~s_set_unmarshal(_env);\n", [Name]), - - ic_codegen:emit(Fd, " }\n\n"), - - - %% - %% Marshal set operation - %% - IP = ic_java_type:getParamType(G, N, Type, in), - OpCallName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ic_util:to_undersc(["_set_"++WireName|N]); - false -> - "_set_"++WireName - end, - - ic_codegen:emit(Fd, " // Marshal operation for set attribute ~p\n", [Name]), - ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env, ~s _value)\n", - [Name, ?ICPACKAGE, IP]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get output stream\n"), - ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",[?ERLANGPACKAGE]), - - %% Initiating Message header - ic_codegen:emit(Fd, " // Message header assembly\n"), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), - - - %% Creating call identity tuple - ic_codegen:emit(Fd, " // Message identity part creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __env.write_client_pid();\n"), - ic_codegen:emit(Fd, " __env.write_client_ref();\n\n"), - - - %% Creating operation identity - ic_codegen:emit(Fd, " // Message operation part creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_atom(~p);\n",[OpCallName]), - - case ic_java_type:isBasicType(G, N, Type) of - true -> - ic_codegen:emit(Fd, " __os~s(_value);\n\n", - [ic_java_type:marshalFun(G, N, X, Type)]); - false -> - ic_codegen:emit(Fd, " ~s(__os, _value);\n\n", - [ic_java_type:marshalFun(G, N, X, Type)]) - end, - ic_codegen:emit(Fd, " }\n\n"), - - - ic_codegen:emit(Fd, " // Unmarshal operation for set attribute ~p\n", [Name]), - ic_codegen:emit(Fd, " public static void _~s_set_unmarshal(~sEnvironment __env)\n", - [Name, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get input stream\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",[?ERLANGPACKAGE]), - - ic_codegen:emit(Fd, " __is.read_atom();\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - - - - diff --git a/lib/ic/src/ic_cbe.erl b/lib/ic/src/ic_cbe.erl deleted file mode 100644 index f6e64d23a0..0000000000 --- a/lib/ic/src/ic_cbe.erl +++ /dev/null @@ -1,1307 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - -%%------------------------------------------------------------ -%% -%% This module is a main module for generation of C code, both -%% for ic_cclient and ic_cserver. -%% -%% The former role of this module (ic_cbe) was to generate client -%% code only. -%% --module(ic_cbe). - --export([emit_malloc_size_stmt/7, emit_encoding_stmt/6, - emit_encoding_stmt/7, emit_decoding_stmt/10, - emit_decoding_stmt/11, emit_dealloc_stmts/3, - mk_variable_name/1, mk_c_type/3, mk_c_type/4, mk_c_type2/3, - is_variable_size/1, is_variable_size/3, mk_dim/1, - mk_slice_dim/1, emit_tmp_variables/1, store_tmp_decl/2, - extract_info/3, normalize_type/1]). - -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). - --include("icforms.hrl"). --include ("ic.hrl"). - -%%------------------------------------------------------------ -%% ENCODING -%%------------------------------------------------------------ - -emit_encoding_stmt(G, N, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n} \n"); - "erlang_ref" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {enum, FSN} -> - emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer); - FSN -> - emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer) - end; - -%% XXX T is a string -emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_list(T) -> - %% Already a fullscoped name - Type = ictype:name2type(G,T), - case ictype:isBasicType(Type) of - true -> - emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); - false -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s))" - " < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), % XXX list - emit(Fd, " return oe_error_code;\n }\n") - end; -emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, string) -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, " - " ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_encode_wstring(oe_env, " - "~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) -> - case normalize_type(T) of - {basic, Type} -> - emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); - %% XXX Why only returns? - {void, _} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {sequence, _, _} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {_ArrayType, {array, _, _}} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {union, _, _, _, _} -> - %% Union as a member in struct ! - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {struct, _, _, _} -> - %% Struct as a member in struct ! - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%% Arity = 7. -%% -emit_encoding_stmt(G, N, X, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {enum, FSN} -> - emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer); - FSN -> - emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer) - end; - -%% XXX T is a string -emit_encoding_stmt(G, N, X, Fd, T, LName, _OutBuffer) when is_list(T) -> - %% Already a fullscoped name - case get_param_tk(LName,X) of - error -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - ParamTK -> - case is_variable_size(ParamTK) of - true -> - if is_tuple(ParamTK) -> - case element(1,ParamTK) of - tk_array -> - %% Array of dynamic data - emit(Fd, - " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, - "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, - " return " - "oe_error_code;\n }\n"); - _ -> - emit(Fd, - " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, - "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return " - "oe_error_code;\n }\n") - end; - true -> - emit(Fd, - " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n") - end; - false -> - if is_atom(ParamTK) -> - case normalize_type(ParamTK) of - {basic, Type} -> - emit_encoding_stmt_for_basic_type(G, N, T, Fd, - Type, - LName); - _ -> - %% Why only return? - ?emit_c_enc_rpt(Fd, " ", "~/slist/~s", [T, LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok - end; - true -> - case element(1,ParamTK) of - tk_enum -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - tk_array -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - tk_struct -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - tk_union -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, &~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n") - end - end - end - end; -emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, string) -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) -> - case normalize_type(T) of - {basic, Type} -> - emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); - {void, _} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok; - {sequence, _, _} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok; - {_ArrayType, {array, _, _}} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok; - {struct, _, _, _} -> %% Struct as a member in struct ! - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok; - _ -> - %%io:format("2 ------------> ~p~n", [T]), - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%%------------------------------------------------------------ -emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName) -> - {Cast, DecType} = - case Type of - ushort -> {"(unsigned long) ", "ulong"}; - ulong -> {"", "ulong"}; - ulonglong -> {"", "ulonglong"}; - short -> {"(long) ", "long"}; - long -> {"", "long"}; - longlong -> {"", "longlong"}; - float -> {"(double) ", "double"}; - double -> {"", "double"}; - boolean -> {"", "atom"}; - char -> {"", "char"}; - wchar -> {"", "wchar"}; - octet -> {"", "char"}; - any -> {"", "long"} % Fix for any - end, - case Type of - boolean -> - %% Note prefix: oe_ei - emit(Fd, " switch(~s) {\n",[LName]), - emit(Fd, " case 0 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, " - "\"false\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, " - "\"true\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default :\n"), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n\n"); - _ -> - Fmt = - " if ((oe_error_code = oe_ei_encode_~s(oe_env, ~s~s)) < 0) {\n", - emit(Fd, Fmt, [DecType, Cast, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n") - end. - - -%%------------------------------------------------------------ -%% MALLOC SIZE (for Decode) -%%------------------------------------------------------------ - -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, - Align, CalcType) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " oe_malloc_size += sizeof(erlang_pid);\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "erlang_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " oe_malloc_size += sizeof(erlang_port);\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_port(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "erlang_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " oe_malloc_size += sizeof(erlang_ref);\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "erlang_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - emit(Fd, " oe_malloc_size += sizeof(char*);\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_term(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "ETERM*", []), - emit(Fd, " return oe_error_code;\n }\n"); - {enum, FSN} -> - emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType); - FSN -> - %% io:format("emit_malloc_size_stmt: ~p ~p~n",[FSN, - %% CalcType]), - emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType) - end; - -%% XXX T is a string -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, - _Align, CalcType) when is_list(T) -> - %% Already a fullscoped name - Type = ictype:name2type(G,T), - case ictype:isBasicType(Type) of - true -> - emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); - false -> - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), T]), - ?emit_c_dec_rpt(Fd, " ", "~s", [T]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), T]), - ?emit_c_dec_rpt(Fd, " ", "~s", [T]), - emit(Fd, " return oe_error_code;\n }\n") - end - end; -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, - CalcType) when is_record(T, string) -> - Tname = mk_variable_name(op_variable_count), - store_tmp_decl(" int ~s = 0;\n",[Tname]), - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ei_get_type(~s, " - "oe_size_count_index, &oe_type, &~s)) < 0) {\n", - [InBuffer, Tname]); - _ -> - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_temp = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ei_get_type(~s, " - "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", - [InBuffer]) - end, - ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - if - T#string.length == 0 -> - ok; - true -> - Length = ic_util:eval_c(G, N, T#string.length), - case CalcType of - generator -> - emit(Fd, " if (~s > ~s)\n",[Tname, Length]), - emit(Fd, " return -1;\n\n"); - _ -> - emit(Fd, " if (oe_temp > ~s)\n",[Length]), - emit(Fd, " return -1;\n\n") - end - end, - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); - _ -> - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) - end, - ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - case CalcType of - generator -> - emit(Fd, " oe_malloc_size = ~s;\n\n", - [ic_util:mk_align("oe_malloc_size + " ++ Tname ++"+1")]); - _ -> - emit(Fd, " oe_malloc_size = ~s;\n\n", - [ic_util:mk_align("oe_malloc_size + oe_temp+1")]) - end; -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, - CalcType) when is_record(T, wstring) -> - Tname = mk_variable_name(op_variable_count), - store_tmp_decl(" int ~s = 0;\n",[Tname]), - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ei_get_type(~s, " - "oe_size_count_index, &oe_type, &~s)) < 0) {\n", - [InBuffer, Tname]); - _ -> - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_temp = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ei_get_type(~s, " - "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", - [InBuffer]) - end, - ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - if - T#wstring.length == 0 -> - ok; - true -> - Length = ic_util:eval_c(G, N, T#wstring.length), - case CalcType of - generator -> - emit(Fd, " if (~s > ~s)\n",[Tname, Length]), - emit(Fd, " return -1;\n\n"); - _ -> - emit(Fd, " if (oe_temp > ~s)\n",[Length]), - emit(Fd, " return -1;\n\n") - end - end, - case CalcType of - generator -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); - _ -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " - "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) - end, - ?emit_c_dec_rpt(Fd, " ", "oe_ei_decode_wstring", []), - emit(Fd, " return oe_error_code;\n }\n"), - case CalcType of - generator -> - emit(Fd, " oe_malloc_size =\n ~s;\n\n", - [ic_util:mk_align("oe_malloc_size + ((" - ++ Tname - ++"+ 1) * __OE_WCHAR_SIZE_OF__)")]); - _ -> - emit(Fd, " oe_malloc_size =\n ~s;\n\n", - [ic_util:mk_align("oe_malloc_size + ((" - "oe_temp + 1) * __OE_WCHAR_SIZE_OF__)")]) - end; -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, Align, CalcType) -> - case Align of - 0 -> - emit(Fd, " oe_malloc_size += sizeof(~s);\n\n", - [mk_c_type(G, N, T)]); - _ -> - ok - end, - case normalize_type(T) of - {basic, Type} -> - emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); - {void, _} -> - ok; - {sequence, _, _} -> - ok; - {_, {array, SId, _}} -> - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(SId)]), - ?emit_c_dec_rpt(Fd, " ", "array1", []), - emit(Fd, " return oe_error_code;\n\n"); - _ -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(SId)]), - ?emit_c_dec_rpt(Fd, " ", "array2", []), - emit(Fd, " return oe_error_code;\n\n") - end; - {union, UId, _, _, _} -> - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(UId)]), - ?emit_c_dec_rpt(Fd, " ", "union1", []), - emit(Fd, " return oe_error_code;\n\n"); - _ -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(UId)]), - ?emit_c_dec_rpt(Fd, " ", "union2", []), - emit(Fd, " return oe_error_code;\n\n") - end; - {struct, UId, _, _} -> %% Struct as a member in struct ! - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(UId)]), - ?emit_c_dec_rpt(Fd, " ", "struct1", []), - emit(Fd, " return oe_error_code;\n\n"); - _ -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(UId)]), - ?emit_c_dec_rpt(Fd, " ", "struct2", []), - emit(Fd, " return oe_error_code;\n\n") - end; - {any, _} -> %% Fix for any type - emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " - "oe_size_count_index, NULL)) < 0) {\n", - [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "any", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%%------------------------------------------------------------ - -emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer) -> - {Pre, DecType} = - case Type of - ushort -> {"", "ulong"}; - ulong -> {"", "ulong"}; - ulonglong -> {"oe_", "ulonglong"}; - short -> {"", "long"}; - long -> {"", "long"}; - longlong -> {"oe_", "longlong"}; - float -> {"", "double"}; - double -> {"", "double"}; - boolean -> {"", "atom"}; - char -> {"", "char"}; - wchar -> {"oe_", "wchar"}; - octet -> {"", "char"}; - any -> {"", "long"} - end, - Fmt = - " if ((oe_error_code = ~sei_decode_~s(~s, oe_size_count_index, " - "NULL)) < 0) {\n", - emit(Fd, Fmt, [Pre, DecType, InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "~s", [DecType]), - emit(Fd, " return oe_error_code;\n }\n"). - -%%------------------------------------------------------------ -%% DECODING -%%------------------------------------------------------------ - -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, - NextPos, DecType) -> - emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, - NextPos, DecType, []). - -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos, - DecType, AllocedPars) when element(1, T) == scoped_id -> - Fmt = - " if ((oe_error_code = ei_decode_~s(~s, &oe_env->_iin, ~s~s)) < 0)" - " {\n", - Emit = fun(Type) -> - emit(Fd, Fmt, [Type, InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n") - end, - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - Emit("pid"); - "erlang_port" -> - Emit("port"); - "erlang_ref" -> - Emit("ref"); - "ETERM*" -> - Emit("term"); - {enum, FSN} -> - emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, - Align, NextPos, DecType, AllocedPars); - FSN -> - emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, - Align, NextPos, DecType, AllocedPars) - end; - -%% XXX T is a string -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, - DecType, AllocedPars) when is_list(T) -> - %% Already a fullscoped name - Type = ictype:name2type(G,T), - case ictype:isBasicType(Type) of - true -> - emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, - LName, AllocedPars); - false -> - case DecType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, " - "~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - caller -> %% No malloc used, define oe_first - emit(Fd, " {\n"), - emit(Fd, " void *oe_first = NULL;\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - caller_dyn -> %% Malloc used - emit(Fd, " {\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - array_dyn -> %% Malloc used - emit(Fd, " {\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - array_fix_ret -> - emit(Fd, " {\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s,*~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - array_fix_out -> %% No malloc used, define oe_first - emit(Fd, " {\n"), - emit(Fd, " void *oe_first = NULL;\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n") - end - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - DecType, AllocedPars) when is_record(T, string) -> - case DecType of - caller_dyn -> - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - _ -> - emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", - [IndOp, LName]), - emit(Fd, " {\n"), - emit(Fd, " int oe_type=0;\n"), - emit(Fd, " int oe_string_ctr=0;\n\n"), - - emit(Fd, " (int) ei_get_type(~s, " - "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", - [InBuffer]), - - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *oe_outindex = ~s;\n", - [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), - emit(Fd, " }\n\n") - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - DecType, AllocedPars) when is_record(T, wstring) -> - case DecType of - caller_dyn -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }/* --- */\n"); % XXX - _ -> - emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", - [IndOp, LName]), - - emit(Fd, " {\n"), - emit(Fd, " int oe_type=0;\n"), - emit(Fd, " int oe_string_ctr=0;\n\n"), - emit(Fd, " (int) ei_get_type(~s, " - "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", - [InBuffer]), - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *oe_outindex = ~s;\n", - [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), - emit(Fd, " }\n") - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, - _DecType, AllocedPars) -> - case normalize_type(T) of - {basic, Type} -> - emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, - LName, AllocedPars); - {void, _} -> - emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " - "&oe_env->_iin, NULL)) < 0) {\n", - [InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - {sequence, _, _} -> - ok; - {_, {array, SId, Dims}} -> - AName = ic_forms:get_id2({array, SId, Dims}), - Ptr = "oe_out->"++AName, - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - ic_forms:get_id2(SId), - NextPos, Ptr]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - {struct, _, _, _} -> %% Struct as a member in struct ! - ok; - _ -> - %%io:format("3 ------------> ~p~n", [T]), - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%% XXX DecType used in two senses in this file. -emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, - LName, AllocedPars) -> - Fmt = - " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, " - "~s~s)) < 0) {\n", - Ret = - " return oe_error_code;\n" - "}\n", - - {Pre, DecType} = - case Type of - ushort -> {"", "ulong"}; - ulong -> {"", "ulong"}; - ulonglong -> {"oe_", "ulonglong"}; - short -> {"", "long"}; - long -> {"", "long"}; - longlong -> {"oe_", "longlong"}; - float -> {"", "double"}; - double -> {"", "double"}; - boolean -> {"", "atom"}; - char -> {"", "char"}; - wchar -> {"oe_", "wchar"}; - octet -> {"", "char"}; - any -> {"", "long"} - end, - case Type of - ushort -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, " - "&oe_env->_iin, &oe_ulong)) < 0) {\n", - [InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, "}\n"), - emit(Fd, " *(~s) = (unsigned short) oe_ulong;\n\n", - [LName]), - emit(Fd, " if (*(~s) != oe_ulong){\n", - [LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n\n"); - short -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " - "&oe_env->_iin, &oe_long)) < 0){\n", - [InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n\n"), - emit(Fd, "}\n"), - emit(Fd, " *(~s) = (short) oe_long;\n\n",[LName]), - emit(Fd, " if (*(~s) != oe_long){\n", [LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - float -> - emit(Fd, " {\n"), - emit(Fd, " double oe_double;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_double(~s, " - "&oe_env->_iin, &oe_double)) < 0){\n", - [InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n\n"), - emit(Fd, "}\n"), - emit(Fd, " *(~s) = (float) oe_double;\n",[LName]), - emit(Fd, " }\n"); - boolean -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " - "&oe_env->_iin, oe_bool)) < 0){\n",[InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, "}\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " *(~s) = 0;\n",[LName]), - emit(Fd, " }\n"), - emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0)" - " {\n"), - emit(Fd, " *(~s) = 1;\n",[LName]), - emit(Fd, " }\n"), - emit(Fd, " else {\n"), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - _ -> - emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - emit(Fd, Ret) - end. - -%%------------------------------------------------------------ -%% -%%------------------------------------------------------------ -emit_dealloc_stmts(Fd, Prefix, AllocedPars) -> - Fmt = Prefix ++ "CORBA_free(~s);\n", - lists:foreach( - fun(Par) -> emit(Fd, Fmt, [Par]) end, - AllocedPars). - - -%%------------------------------------------------------------ -%% -%%------------------------------------------------------------ - -mk_variable_name(Var) -> - Nr = get(Var), - put(Var, Nr + 1), - "oe_tmp" ++ integer_to_list(Nr). - -%% IDL to C type conversion -%%------------------------------------------------------------ -mk_c_type(G, N, S) -> - mk_c_type(G, N, S, evaluate). - -mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - {enum, Type} -> - mk_c_type(G, N, Type, evaluate); - Type -> - mk_c_type(G, N, Type, evaluate) - end; - -mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - Type -> - Type - end; -mk_c_type(_G, _N, S, _) when is_list(S) -> - S; -mk_c_type(_G, _N, S, _) when is_record(S, string) -> - "CORBA_char *"; -mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> - "CORBA_wchar *"; -mk_c_type(_G, _N, {boolean, _}, _) -> - "CORBA_boolean"; -mk_c_type(_G, _N, {octet, _}, _) -> - "CORBA_octet"; -mk_c_type(_G, _N, {void, _}, _) -> - "void"; -mk_c_type(_G, _N, {unsigned, U}, _) -> - case U of - {short,_} -> - "CORBA_unsigned_short"; - {long,_} -> - "CORBA_unsigned_long"; - {'long long',_} -> - "CORBA_unsigned_long_long" - end; - -mk_c_type(_G, _N, {'long long', _}, _) -> - "CORBA_long_long"; - -mk_c_type(_G, _N, S, _) when is_record(S, union)-> - ic_forms:get_id2(S); - -mk_c_type(_G, N, S, _) when is_record(S, struct) -> %% Locally defined member - Fullname = [ic_forms:get_id2(S) | N], - ic_util:to_undersc(Fullname); - -mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type - "CORBA_long"; - -mk_c_type(_G, _N, {T, _}, _) -> - "CORBA_" ++ atom_to_list(T). - -%%------------------------------------------------------------------- -%% IDL to C type conversion used by the emit_c_*_rpt macros. -%%------------------------------------------------------------------- -mk_c_type2(G, N, S) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - {enum, Type} -> - mk_c_type2(G, N, Type); - Type -> - mk_c_type2(G, N, Type) - end; - -mk_c_type2(_G, _N, S) when is_list(S) -> - S; -mk_c_type2(_G, _N, S) when is_record(S, string) -> - "CORBA_char *"; -mk_c_type2(_G, _N, S) when is_record(S, wstring) -> - "CORBA_wchar *"; -mk_c_type2(_G, _N, {boolean, _}) -> - "CORBA_boolean"; -mk_c_type2(_G, _N, {octet, _}) -> - "CORBA_octet"; -mk_c_type2(_G, _N, {void, _}) -> - "void"; -mk_c_type2(_G, _N, {unsigned, U}) -> - case U of - {short,_} -> - "CORBA_unsigned_short"; - {long,_} -> - "CORBA_unsigned_long"; - {'long long',_} -> - "CORBA_unsigned_long_long" - end; - -mk_c_type2(_G, _N, {'long long', _}) -> - "CORBA_long_long"; - -mk_c_type2(_G, _N, S) when is_record(S, union)-> - ic_forms:get_id2(S); - -mk_c_type2(_G, N, S) when is_record(S, struct) -> - Fullname = [ic_forms:get_id2(S) | N], - ic_util:to_undersc(Fullname); - -mk_c_type2(_G, _N, S) when is_record(S, sequence) -> - mk_c_type2(_G, _N, S#sequence.type); - -mk_c_type2(_G, _N, {'any', _}) -> %% Fix for any type - "CORBA_long"; - -mk_c_type2(_G, _N, {T, _}) -> - "CORBA_" ++ atom_to_list(T). - -%%----- - -is_variable_size_rec(Es) -> - lists:any( - fun({_N, T}) -> is_variable_size(T); - ({_, _N, T}) -> is_variable_size(T) - end, Es). - -is_variable_size({'tk_struct', _IFRId, "port", _ElementList}) -> - false; -is_variable_size({'tk_struct', _IFRId, "pid", _ElementList}) -> - false; -is_variable_size({'tk_struct', _IFRId, "ref", _ElementList}) -> - false; -is_variable_size({'tk_struct', _IFRId, "term", _ElementList}) -> - false; -is_variable_size({'tk_struct', _IFRId, _Name, ElementList}) -> - is_variable_size_rec(ElementList); -is_variable_size({'tk_array', ElemTC, _Length}) -> - is_variable_size(ElemTC); -is_variable_size({'tk_string', _}) -> - true; -is_variable_size({'tk_wstring', _}) -> - true; -is_variable_size({'tk_sequence', _ElemTC, _MaxLsextractength}) -> - true; -is_variable_size({'tk_union', _IFRId, _Name, _, _, ElementList}) -> - is_variable_size_rec(ElementList); -is_variable_size(_Other) -> - false. - - -is_variable_size(_G, _N, T) when is_record(T, string) -> - true; -is_variable_size(_G, _N, T) when is_record(T, wstring) -> - true; -is_variable_size(_G, _N, T) when is_record(T, sequence) -> - true; -is_variable_size(G, N, T) when is_record(T, union) -> - %%io:format("~n~p = ~p~n",[ic_forms:get_id2(T),ictype:fetchTk(G, N, T)]), - is_variable_size(ictype:fetchTk(G, N, T)); -is_variable_size(G, N, T) when is_record(T, struct) -> - is_variable_size(ictype:fetchTk(G, N, T)); -is_variable_size(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, TK, _} -> - is_variable_size(TK); - _ -> - ic_error:fatal_error(G, {name_not_found, T}) - end; -is_variable_size(_G, _N, _Other) -> - false. - -%% mk_dim produces -mk_dim([Arg | Args]) -> - "[" ++ Arg ++ "]" ++ mk_dim(Args); -mk_dim([]) -> []. - -mk_slice_dim(Args) -> - mk_dim(tl(Args)). - - -emit_tmp_variables(Fd) -> - DeclList = get(tmp_declarations), - emit_tmp_variables(Fd, DeclList), - ok. - -emit_tmp_variables(Fd, [Decl |Rest]) -> - emit_tmp_variables(Fd, Rest), - emit(Fd, "~s", [Decl]); -emit_tmp_variables(_Fd, []) -> - ok. - -store_tmp_decl(Format, Args) -> - Decl = io_lib:format(Format, Args), - DeclList = get(tmp_declarations), - put(tmp_declarations, [Decl |DeclList]). - -%%------------------------------------------------------------ -%% -%% Parser utilities -%% -%% Called from the yecc parser. Expands the identifier list of an -%% attribute so that the attribute generator never has to handle -%% lists. -%% -%%------------------------------------------------------------ - -extract_info(_G, N, X) when is_record(X, op) -> - Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - Args = X#op.params, - ArgNames = mk_c_vars(Args), - TypeList = {ic_forms:get_type(X), - lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args), - [] - }, - {Name, ArgNames, TypeList}; -extract_info(_G, N, X) -> - Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - {Name, [], []}. - - - -%% Usefull functions -get_param_tk(Name, Op) -> - case get_param(Name, Op) of - error -> - error; - Param -> - ic_forms:get_tk(Param) - end. - -get_param(Name, Op) when is_record(Op, op) -> - get_param_loop(Name, Op#op.params); -get_param(_Name, _Op) -> - error. - -get_param_loop(Name,[Param|Params]) -> - case ic_forms:get_id2(Param) of - Name -> - Param; - _ -> - get_param_loop(Name,Params) - end; -get_param_loop(_Name, []) -> - error. - - -%% Input is a list of parameters (in parse form) and output is a list -%% of parameter attribute and variable names. -mk_c_vars(Params) -> - lists:map(fun(P) -> {A, _} = P#param.inout, - {A, ic_forms:get_id(P#param.id)} - end, - Params). - -normalize_type({unsigned, {short, _}}) -> {basic, ushort}; -normalize_type({unsigned, {long, _}}) -> {basic, ulong}; -normalize_type({unsigned, {'long long', _}}) -> {basic, ulonglong}; -normalize_type({short,_}) -> {basic, short}; -normalize_type({long, _}) -> {basic, long}; -normalize_type({'long long', _}) -> {basic, longlong}; -normalize_type({float,_}) -> {basic, float}; -normalize_type({double, _}) -> {basic, double}; -normalize_type({boolean, _}) -> {basic, boolean}; -normalize_type({char, _}) -> {basic, char}; -normalize_type({wchar, _}) -> {basic, wchar}; -normalize_type({octet, _}) -> {basic, octet}; -normalize_type({any, _}) -> {basic, any}; -normalize_type(tk_ushort) -> {basic, ushort}; -normalize_type(tk_ulong) -> {basic, ulong}; -normalize_type(tk_ulonglong) -> {basic, ulonglong}; -normalize_type(tk_short) -> {basic, short}; -normalize_type(tk_long) -> {basic, long}; -normalize_type(tk_longlong) -> {basic, longlong}; -normalize_type(tk_float) -> {basic, float}; -normalize_type(tk_double) -> {basic, double}; -normalize_type(tk_boolean) -> {basic, boolean}; -normalize_type(tk_char) -> {basic, char}; -normalize_type(tk_wchar) -> {basic, wchar}; -normalize_type(tk_octet) -> {basic, octet}; -normalize_type(tk_any) -> {basic, any}; -normalize_type(ushort) -> {basic, ushort}; -normalize_type(ulong) -> {basic, ulong}; -normalize_type(ulonglong) -> {basic, ulonglong}; -normalize_type(short) -> {basic, short}; -normalize_type(long) -> {basic, long}; -normalize_type(longlong) -> {basic, longlong}; -normalize_type(float) -> {basic, float}; -normalize_type(double) -> {basic, double}; -normalize_type(boolean) -> {basic, boolean}; -normalize_type(char) -> {basic, char}; -normalize_type(wchar) -> {basic, wchar}; -normalize_type(octet) -> {basic, octet}; -normalize_type(any) -> {basic, any}; -normalize_type(Type) -> Type. - diff --git a/lib/ic/src/ic_cclient.erl b/lib/ic/src/ic_cclient.erl deleted file mode 100644 index 8591acf33f..0000000000 --- a/lib/ic/src/ic_cclient.erl +++ /dev/null @@ -1,1210 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-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% -%% -%% --module(ic_cclient). - -%% This module implements generation of C client code, where the -%% client acts as an Erlang C-node, and where the communication thus -%% is according to the Erlang distribution protocol. -%% - --export([do_gen/3]). - -%%------------------------------------------------------------ -%% IMPLEMENTATION CONVENTIONS -%%------------------------------------------------------------ -%% Functions: -%% -%% mk_* returns things to be used. No side effects. -%% emit_* Writes to file. Has Fd in arguments. -%% gen_* Same, but has no Fd. Usually for larger things. -%% -%% Terminology for generating C: -%% -%% par_list list of identifiers with types, types only, or with -%% parameters (arguments) only. -%% arg_list list of identifiers only (for function calls) -%% - -%%------------------------------------------------------------ -%% Internal stuff -%%------------------------------------------------------------ - --import(lists, [foreach/2, foldl/3, foldr/3]). --import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). - --include("icforms.hrl"). --include("ic.hrl"). --include_lib("stdlib/include/erl_compile.hrl"). - --define(IC_HEADER, "ic.h"). --define(ERL_INTERFACEHEADER, "erl_interface.h"). --define(EICONVHEADER, "ei.h"). --define(ERLANGATOMLENGTH, "256"). - - -%%------------------------------------------------------------ -%% ENTRY POINT -%%------------------------------------------------------------ -do_gen(G, File, Form) -> - OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))), - G2 = ic_file:filename_push(G, [], OeName, c), - gen_headers(G2, [], Form), - R = gen(G2, [], Form), - ic_file:filename_pop(G2, c), - R. - -remove_ext(File) -> - filename:rootname(filename:basename(File)). - -%%------------------------------------------------------------ -%% -%% Generate client side C stubs. -%% -%% - each module definition results in a separate file. -%% - each interface definition results in a separate file. -%% -%% G = record(genobj) (see ic.hrl) -%% N = scoped names in reverse -%% X = current form to consider. -%%------------------------------------------------------------ - -gen(G, N, [X| Xs]) when is_record(X, preproc) -> - G1 = change_file_stack(G, N, X), - gen(G1, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, module) -> - CD = ic_code:codeDirective(G, X), - G2 = ic_file:filename_push(G, N, X, CD), - N2 = [ic_forms:get_id2(X)| N], - gen_headers(G2, N2, X), - gen(G2, N2, ic_forms:get_body(X)), - G3 = ic_file:filename_pop(G2, CD), - gen(G3, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, interface) -> - - G2 = ic_file:filename_push(G, N, X, c), - N2 = [ic_forms:get_id2(X)| N], - - %% Sets the temporary variable counter. - put(op_variable_count, 0), - put(tmp_declarations, []), - - gen_headers(G2, N2, X), - - gen(G2, N2, ic_forms:get_body(X)), - - lists:foreach( - fun({_Name, Body}) -> - gen(G2, N2, Body) end, - X#interface.inherit_body), - - %% Generate Prototypes - gen_prototypes(G2, N2, X), - - %% Generate generic preparation for decoding - gen_receive_info(G2, N2, X), - - G3 = ic_file:filename_pop(G2, c), - - gen(G3, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, const) -> - emit_constant(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, op) -> - {OpName, ArgNames, RetParTypes} = ic_cbe:extract_info(G, N, X), - %% XXX Note: N is the list of scoped ids of the *interface*. - gen_operation(G, N, X, OpName, ArgNames, RetParTypes), - gen_encoder(G, N, X, OpName, ArgNames, RetParTypes), - gen_decoder(G, N, X, OpName, ArgNames, RetParTypes), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, attr) -> - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, enum) -> - icenum:enum_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, typedef) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, struct) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, union) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [_X| Xs]) -> - %% XXX Should have debug message here. - gen(G, N, Xs); - -gen(_G, _N, []) -> - ok. - -%%------------------------------------------------------------ -%% Change file stack -%%------------------------------------------------------------ - -change_file_stack(G, _N, X) when X#preproc.cat == line_nr -> - Id = ic_forms:get_id2(X), - Flags = X#preproc.aux, - case Flags of - [] -> - ic_genobj:push_file(G, Id); - _ -> - foldr( - fun({_, _, "1"}, G1) -> - ic_genobj:push_file(G1, Id); - ({_, _, "2"}, G1) -> - ic_genobj:pop_file(G1, Id); - ({_, _, "3"}, G1) -> - ic_genobj:sys_file(G1, Id) - end, G, Flags) - end; -change_file_stack(G, _N, _X) -> - G. - -%%------------------------------------------------------------ -%% Generate headers in stubfiles and header files -%%------------------------------------------------------------ - -gen_headers(G, N, X) when is_record(X, interface) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - %% Set the temporary variable counter - put(op_variable_count, 0), - put(tmp_declarations, []), - HFd = ic_genobj:hrlfiled(G), - IncludeFileStack = ic_genobj:include_file_stack(G), - L = length(N), - Filename = - if - L < 2 -> - lists:nth(L + 1, IncludeFileStack); - true -> - lists:nth(2, IncludeFileStack) - end, - emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), - ic_code:gen_includes(HFd, G, X, c_client), - - IfName = ic_util:to_undersc(N), - IfNameUC = ic_util:to_uppercase(IfName), - emit(HFd, "\n#ifndef __~s__\n", [IfNameUC]), - emit(HFd, "#define __~s__\n", [IfNameUC]), - LCmt = io_lib:format("Interface object definition: ~s", [IfName]), - ic_codegen:mcomment_light(HFd, [LCmt], c), - case get_c_timeout(G, "") of - "" -> - ok; - {SendTmo, RecvTmo} -> - emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n", - [IfNameUC, SendTmo]), - emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n", - [IfNameUC, RecvTmo]), - emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"), - emit(HFd, "#error Functions for send and receive with " - "timeout not defined in erl_interface\n"), - emit(HFd, "#endif\n\n") - end, - - emit(HFd, "typedef CORBA_Object ~s;\n", [IfName]), - emit(HFd, "#endif\n\n"); - - false -> ok - end, - case ic_genobj:is_stubfile_open(G) of - true -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:nl(Fd), - emit(Fd, "#include <stdlib.h>\n"), - emit(Fd, "#include <string.h>\n"), - case ic_options:get_opt(G, c_report) of - true -> - emit(Fd, "#ifndef OE_C_REPORT\n"), - emit(Fd, "#define OE_C_REPORT\n"), - emit(Fd, "#include <stdio.h>\n"), - emit(Fd, "#endif\n"); - _ -> - ok - end, - emit(Fd, "#include \"~s\"\n", [?IC_HEADER]), - emit(Fd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), - emit(Fd, "#include \"~s\"\n", [?EICONVHEADER]), - emit(Fd, "#include \"~s\"\n", - [filename:basename(ic_genobj:include_file(G))]), - ic_codegen:nl(Fd), ic_codegen:nl(Fd), - Fd; % XXX ?? - false -> - ok - end; - -%% Some items have extra includes -gen_headers(G, N, X) when is_record(X, module) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - HFd = ic_genobj:hrlfiled(G), - IncludeFileStack = ic_genobj:include_file_stack(G), - Filename = lists:nth(length(N) + 1, IncludeFileStack), - emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), - ic_code:gen_includes(HFd, G, X, c_client); - false -> ok - end; -gen_headers(G, [], _X) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - HFd = ic_genobj:hrlfiled(G), - case ic_options:get_opt(G, c_report) of - true -> - emit(HFd, "#ifndef OE_C_REPORT\n"), - emit(HFd, "#define OE_C_REPORT\n"), - emit(HFd, "#include <stdio.h>\n"), - emit(HFd, "#endif\n"); - _ -> - ok - end, - emit(HFd, "#include \"~s\"\n", [?IC_HEADER]), - emit(HFd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), - emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]), - ic_code:gen_includes(HFd, G, c_client); - false -> ok - end; -gen_headers(_G, _N, _X) -> - ok. - - -%%------------------------------------------------------------ -%% Generate all prototypes (for interface) -%%------------------------------------------------------------ -gen_prototypes(G, N, X) -> - case ic_genobj:is_hrlfile_open(G) of - false -> - ok; - true -> - HFd = ic_genobj:hrlfiled(G), - IfName = ic_util:to_undersc(N), - - %% Emit generated function prototypes - emit(HFd, "\n/* Operation functions */\n"), - lists:foreach(fun({_Name, Body}) -> - emit_operation_prototypes(G, HFd, N, Body) - end, [{x, ic_forms:get_body(X)}| - X#interface.inherit_body]), - - UserProto = get_user_proto(G, false), - %% Emit generic function prototypes - case UserProto of - false -> - ok; - UserProto -> - emit(HFd, - "\n/* Generic user defined encoders */\n"), - emit(HFd, - "int ~s_prepare_notification_encoding(" - "CORBA_Environment*);" - "\n", [UserProto]), - emit(HFd, - "int ~s_prepare_request_encoding(CORBA_Environment*);" - "\n", [UserProto]) - end, - %% Emit encoding function prototypes - emit(HFd, "\n/* Input encoders */\n"), - lists:foreach(fun({_Name, Body}) -> - emit_encoder_prototypes(G, HFd, N, Body) - end, - [{x, ic_forms:get_body(X)}| - X#interface.inherit_body]), - - %% Emit generic function prototypes - emit(HFd, "\n/* Generic decoders */\n"), - emit(HFd, "int ~s__receive_info(~s, CORBA_Environment*);\n", - [IfName, IfName]), - - case UserProto of - false -> - ok; - UserProto -> - emit(HFd, "\n/* Generic user defined decoders */\n"), - emit(HFd, - "int ~s_prepare_reply_decoding(CORBA_Environment*);" - "\n", [UserProto]) - end, - %% Emit decode function prototypes - emit(HFd, "\n/* Result decoders */\n"), - lists:foreach(fun({_Name, Body}) -> - emit_decoder_prototypes(G, HFd, N, Body) - end, [{x, ic_forms:get_body(X)}| - X#interface.inherit_body]), - case UserProto of - false -> - ok; - UserProto -> - %% Emit generic send and receive_prototypes - {Sfx, TmoType} = case get_c_timeout(G, "") of - "" -> - {"", ""}; - _ -> - {"_tmo", ", unsigned int"} - end, - emit(HFd, - "\n/* Generic user defined send and receive " - "functions */\n"), - emit(HFd, - "int ~s_send_notification~s(CORBA_Environment*~s);\n", - [UserProto, Sfx, TmoType]), - emit(HFd, - "int ~s_send_request_and_receive_reply~s(" - "CORBA_Environment*~s~s);\n", - [UserProto, Sfx, TmoType, TmoType]) - end - end. - -%%------------------------------------------------------------ -%% Generate receive_info() (generic part for message reception) -%% (for interface). For backward compatibility only. -%%------------------------------------------------------------ - -gen_receive_info(G, N, _X) -> - case ic_genobj:is_stubfile_open(G) of - false -> - ok; - true -> - Fd = ic_genobj:stubfiled(G), - IfName = ic_util:to_undersc(N), - UserProto = get_user_proto(G, oe), - Code = - " -/* - * Generic function, used to return received message information. - * Not used by oneways. Always generated. For backward compatibility only. - */ - -int ~s__receive_info(~s oe_obj, CORBA_Environment *oe_env) -{ - return ~s_prepare_reply_decoding(oe_env); -}\n", - emit(Fd, Code, [IfName, IfName, UserProto]) -end. - -%%------------------------------------------------------------ -%% Emit constant -%%------------------------------------------------------------ - -emit_constant(G, N, ConstRecord) -> - case ic_genobj:is_hrlfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:hrlfiled(G), - CName = ic_util:to_undersc( - [ic_forms:get_id(ConstRecord#const.id)| N]), - UCName = ic_util:to_uppercase(CName), - - emit(Fd, "\n#ifndef __~s__\n", [UCName]), - emit(Fd, "#define __~s__\n", [UCName]), - - emit(Fd, "/* Constant: ~s */\n", [CName]), - - if is_record(ConstRecord#const.type, wstring) -> - %% If wstring, add 'L' - emit(Fd, "#define ~s L~p\n", - [CName, ConstRecord#const.val]); - true -> - emit(Fd, "#define ~s ~p\n", - [CName, ConstRecord#const.val]) - end, - emit(Fd, "#endif\n\n") - end. - -%%------------------------------------------------------------ -%% Generate operation (for interface) -%%------------------------------------------------------------ - -%% N is the list of scoped ids of the *interface*. -%% X is the operation -gen_operation(G, N, X, OpName, ArgNames, RetParTypes) -> - case ic_genobj:is_stubfile_open(G) of - true -> - do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes); - false -> - ok - end. - -do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes) -> - Fd = ic_genobj:stubfiled(G), - IfName = ic_util:to_undersc(N), - IfNameUC = ic_util:to_uppercase(IfName), - - {R, ParTypes, _} = RetParTypes, - - IsOneway = ic_forms:is_oneway(X), - - emit(Fd, "\n" - "/***\n" - " *** Operation function \"~s\" ~s\n" - " ***/\n\n", - [OpName, ifelse(IsOneway, "(oneway)", "")]), - - RV = element(1, R), - Ret = case IsOneway of - false -> - if RV /= void -> - mk_ret_type(G, N, R); - true -> - "void" - end; - true -> - "void" - end, - ParListStr = ic_util:chain(mk_par_type_list(G, N, X, [in, out], - [types, args], - ParTypes, ArgNames), ", "), - emit(Fd, - "~s ~s(~s, ~sCORBA_Environment *oe_env)\n{\n", - [Ret, OpName, [IfName, " ", "oe_obj"], ParListStr]), - - case IsOneway of - true -> - ok; - false -> - case ictype:isArray(G, N, R) of - true -> - emit(Fd, " ~s oe_return = NULL;\n\n", - [mk_ret_type(G, N, R)]); - false -> - if RV /= void -> - emit(Fd, " ~s oe_return;\n\n", - [Ret]); - true -> - ok - end - end, - emit(Fd, - " /* Initiating the message reference */\n" - " ic_init_ref(oe_env, &oe_env->_unique);\n") - end, - - emit(Fd, - " /* Initiating exception indicator */ \n" - " oe_env->_major = CORBA_NO_EXCEPTION;\n"), - - %% XXX Add pointer checks: checks of in-parameter - %% pointers, and non-variable out-parameter pointers. - - emit(Fd," /* Creating ~s message */ \n", - [ifelse(IsOneway, "cast", "call")]), - - EncParListStr = ic_util:chain(mk_arg_list_for_encoder(G, N, X, - ParTypes, ArgNames), - ", "), - emit(Fd, - " if (~s__client_enc(oe_obj, ~s""oe_env) < 0) {\n", - [OpName, EncParListStr]), - emit(Fd, - " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "DATA_CONVERSION, \"Cannot encode message\");\n"), - - RetVar = ifelse(RV /= void, " oe_return", ""), - emit_c_enc_rpt(Fd, " ", "client operation ~s\\n====\\n", [OpName]), - - emit(Fd, " return~s;\n }\n", [RetVar]), - - emit(Fd," /* Sending ~s message */ \n", - [ifelse(IsOneway, "cast", "call")]), - - UserProto = get_user_proto(G, oe), - {Sfx, SendTmo, RecvTmo} = case get_c_timeout(G, "") of - "" -> - {"", "", ""}; - _ -> - {"_tmo", - [", OE_", IfNameUC, "_SEND_TIMEOUT"], - [", OE_", IfNameUC, "_RECV_TIMEOUT"]} - end, - - case IsOneway of - true -> - emit(Fd, - " if (~s_send_notification~s(oe_env~s) < 0)\n" - " return~s;\n", [UserProto, Sfx, SendTmo, RetVar]); - false -> - emit(Fd, - " if (~s_send_request_and_receive_reply~s(oe_env~s~s) < 0)\n" - " return~s;\n", - [UserProto, Sfx, SendTmo, RecvTmo, RetVar]), - - DecParList0 = mk_arg_list_for_decoder(G, N, X, - ParTypes, ArgNames), - DecParList1 = case mk_ret_type(G, N, R) of - "void" -> - DecParList0; - _ -> - ["&oe_return"| DecParList0] - end, - - DecParListStr = ic_util:chain(DecParList1, ", "), - %% YYY Extracting results - emit(Fd, - " /* Extracting result value(s) */ \n" - " if (~s__client_dec(oe_obj, ~s""oe_env) < 0) {\n", - [OpName, DecParListStr]), - emit(Fd, - " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " - "\"Bad result value(s)\");\n"), - emit_c_dec_rpt(Fd, " ", "client operation ~s\\n=====\\n", [OpName]), - emit(Fd, - " return~s;\n" - " }\n", [RetVar]) - end, - emit(Fd, " return~s;\n", [RetVar]), - emit(Fd, "}\n\n\n"). - -%%------------------------------------------------------------ -%% Generate encoder -%%------------------------------------------------------------ -%% N is the list of scoped ids of the *interface*. -%% X is the operation -gen_encoder(G, N, X, OpName, ArgNames, RetParTypes)-> - case ic_genobj:is_stubfile_open(G) of - true -> - Fd = ic_genobj:stubfiled(G), - IfName = ic_util:to_undersc(N), - {_R, ParTypes, _} = RetParTypes, - TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), - emit(Fd, "/*\n * Encode operation input for \"~s\"\n */\n\n", - [OpName]), - ParList = ic_util:chain( - mk_par_type_list(G, N, X, [in], [types, args], - ParTypes, ArgNames), ", "), - emit(Fd, - "int ~s__client_enc(~s oe_obj, ~s" - "CORBA_Environment *oe_env)\n{\n", - [OpName, IfName, ParList]), - - InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true; - ({_, _, _}) -> false - end, TypeAttrArgs), - case InTypeAttrArgs of - [] -> - ok; - _ -> - emit(Fd, - " int oe_error_code = 0;\n\n") - end, - - emit_encodings(G, N, Fd, X, InTypeAttrArgs, - ic_forms:is_oneway(X)), - emit(Fd, " return 0;\n}\n\n"), - ok; - - false -> - ok - end. - -%%------------------------------------------------------------ -%% Generate decoder -%%------------------------------------------------------------ -%% N is the list of scoped ids of the *interface*. -%% X is the operation -gen_decoder(G, N, X, OpName, ArgNames, RetParTypes)-> - case ic_forms:is_oneway(X) of - true -> - ok; - false -> - case ic_genobj:is_stubfile_open(G) of - true -> - Fd = ic_genobj:stubfiled(G), - IfName = ic_util:to_undersc(N), - {R, ParTypes, _} = RetParTypes, - TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), - emit(Fd, "/*\n * Decode operation results for " - "\"~s\"\n */\n\n", [OpName]), - ParList0 = mk_par_type_list(G, N, X, [out], - [types, args], - ParTypes, ArgNames), - PARLIST = case mk_ret_type(G, N, R) of - "void" -> - ParList0; - Else -> - [Else ++ "* oe_return"| ParList0] - end, - PLFCD = ic_util:chain(PARLIST, ", "), - emit(Fd, - "int ~s__client_dec(~s oe_obj, ~s" - "CORBA_Environment *oe_env)\n{\n", - [OpName, IfName, PLFCD]), - emit(Fd, " int oe_error_code = 0;\n"), - OutTypeAttrArgs = lists:filter(fun({_, out, _}) -> true; - ({_, _, _}) -> false - end, TypeAttrArgs), - emit_decodings(G, N, Fd, R, OutTypeAttrArgs), - emit(Fd, " return 0;\n}\n\n"), - ok; - - false -> - ok - end - end. - -%%------------------------------------------------------------ -%% EMIT ENCODINGS/DECODINGS -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Emit encodings -%%------------------------------------------------------------ -%% N is the list of scoped ids of the *interface*. -%% X is the operation -%% emit_encodings(G, N, Fd, X, TypeAttrArgs, IsOneWay) -%% -emit_encodings(G, N, Fd, X, TypeAttrArgs, true) -> - %% Cast - UserProto = get_user_proto(G, oe), - emit(Fd, - " if (~s_prepare_notification_encoding(oe_env) < 0)\n" - " return -1;\n", [UserProto]), - emit_encodings_1(G, N, Fd, X, TypeAttrArgs); -emit_encodings(G, N, Fd, X, TypeAttrArgs, false) -> - %% Call - UserProto = get_user_proto(G, oe), - emit(Fd, - " if (~s_prepare_request_encoding(oe_env) < 0)\n" - " return -1;\n", [UserProto]), - emit_encodings_1(G, N, Fd, X, TypeAttrArgs). - -emit_encodings_1(G, N, Fd, X, TypeAttrArgs) -> - {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), - Name = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ScopedName; - false -> - ic_forms:get_id2(X) - end, - if - TypeAttrArgs /= [] -> - emit(Fd, " if (oe_ei_encode_tuple_header(oe_env, ~p) < 0) {\n", - [length(TypeAttrArgs) + 1]), - emit_c_enc_rpt(Fd, " ", "ei_encode_tuple_header", []), - emit(Fd, " return -1;\n }\n"); - true -> - ok - end, - emit(Fd, " if (oe_ei_encode_atom(oe_env, ~p) < 0) {\n", [Name]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return -1;\n }\n"), - - foreach(fun({{'void', _}, _, _}) -> - ok; - ({T1, A1, N1}) -> - IndOp = mk_ind_op(A1), - emit_coding_comment(G, N, Fd, "Encode", IndOp, - T1, N1), - ic_cbe:emit_encoding_stmt(G, N, X, Fd, T1, IndOp ++ N1, - "oe_env->_outbuf") - end, TypeAttrArgs), - ok. - -%%------------------------------------------------------------ -%% Emit dedodings -%%------------------------------------------------------------ -%% XXX Unfortunately we have to retain the silly `oe_first' variable, -%% since its name is hardcoded in other modules (icstruct, icunion, -%% etc). -%% N is the list of scoped ids of the *interface*. -%% X is the operation -emit_decodings(G, N, Fd, RetType, TypeAttrArgs) -> - if - TypeAttrArgs /= [] -> - %% Only if there are out parameters - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(" - "oe_env->_inbuf, &oe_env->_iin, " - "&oe_env->_received)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - Len = length(TypeAttrArgs) + 1, - emit(Fd, " if (oe_env->_received != ~p) {\n", [Len]), - emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Len]), - emit(Fd, " return -1;\n }\n"); - true -> - ok - end, - - %% Fetch the return value - emit_coding_comment(G, N, Fd, "Decode return value", "*", RetType, "oe_return"), - APars = - case ic_cbe:is_variable_size(G, N, RetType) of - true -> - emit(Fd, - " {\n" - " int oe_size_count_index = oe_env->_iin;\n" - " int oe_malloc_size = 0;\n" - " void *oe_first = NULL;\n"), - ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, - "oe_env->_inbuf", - 1, caller), - %% XXX Add malloc prefix from option - emit(Fd, - " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" - " if ((*oe_return = oe_first = " - "malloc(oe_malloc_size)) == NULL) {\n" - " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "NO_MEMORY, \"Cannot malloc\");\n" - " return -1;\n" - " }\n"), - Pars = ["*oe_return"], - DecType = case ictype:isArray(G, N, RetType) of - true -> array_dyn; - false -> caller_dyn - end, - ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, - "(*oe_return)", - "", "oe_env->_inbuf", 1, - "&oe_outindex", DecType, - Pars), - emit(Fd, " }\n"), - Pars; - false -> - case ictype:isArray(G, N, RetType) of - true -> - Pars = ["*oe_return"], - emit(Fd, - " {\n" - " int oe_size_count_index = oe_env->_iin;\n" - " int oe_malloc_size = 0;\n" - " void *oe_first = NULL;\n"), - ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, - "oe_env->_inbuf", - 1, caller), - %% XXX Add malloc prefix from option - emit(Fd, - " OE_MALLOC_SIZE_CHECK(oe_env, " - "oe_malloc_size);\n" - " if ((*oe_return = oe_first = " - "malloc(oe_malloc_size)) == NULL) {\n" - " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, NO_MEMORY, " - "\"Cannot malloc\");\n" - " return -1;" - " }\n"), - ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, - "oe_return", "", - "oe_env->_inbuf", 1, - "&oe_outindex", - array_fix_ret, - Pars), - emit(Fd, " }\n"), - Pars; - false -> - Pars = [], - %% The last parameter "oe_outindex" is not interesting - %% in the static case. - ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, - "oe_return", "", - "oe_env->_inbuf", 1, - "&oe_outindex", - caller, Pars), - ic_codegen:nl(Fd), - Pars - end - end, - - foldl(fun({{'void', _}, _, _}, Acc) -> - Acc; - ({T, A, N1}, Acc) -> - emit_one_decoding(G, N, Fd, T, A, N1, Acc) - end, APars, TypeAttrArgs), - ok. - -emit_one_decoding(G, N, Fd, T, A, N1, Acc) -> - IndOp = mk_ind_op(A), - case ic_cbe:is_variable_size(G, N, T) of - true -> - emit_coding_comment(G, N, Fd, "Decode", IndOp, - T, N1), - emit(Fd, - " {\n" - " int oe_size_count_index = oe_env->_iin;\n" - " int oe_malloc_size = 0;\n" - " void *oe_first = NULL;\n"), - ic_cbe:emit_malloc_size_stmt(G, N, Fd, T, - "oe_env->_inbuf", - 1, caller), - %% XXX Add malloc prefix from option - emit(Fd, - " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" - " if ((~s~s = oe_first = " - "malloc(oe_malloc_size)) == NULL) {\n", [IndOp, N1]), - ic_cbe:emit_dealloc_stmts(Fd, " ", Acc), - emit(Fd, - " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "NO_MEMORY, \"Cannot malloc\");\n" - " return -1;\n" - " }\n"), - NAcc = [IndOp ++ N1| Acc], - DecType = case ictype:isArray(G, N, T) of - true -> - array_dyn; - false -> - caller_dyn - end, - ic_cbe:emit_decoding_stmt(G, N, Fd, T, - "(" ++ IndOp - ++ N1 ++ ")", "", - "oe_env->_inbuf", 1, - "&oe_outindex", - DecType, NAcc), - emit(Fd, " }\n"), - NAcc; - false -> - case ictype:isArray(G, N, T) of - true -> - emit_coding_comment(G, N, Fd, "Decode", "", - T, N1), - ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, - "", "oe_env->_inbuf", - 1, "&oe_outindex", - array_fix_out, Acc), - ic_codegen:nl(Fd), - [N1| Acc]; - false -> - %% The last parameter "oe_outindex" is - %% not interesting in the static case, but - %% must be present anyhow. - emit_coding_comment(G, N, Fd, "Decode", - IndOp, T, N1), - ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, - "", "oe_env->_inbuf", - 1, "&oe_outindex", - caller, Acc), - ic_codegen:nl(Fd), - Acc - end - end. - -%%------------------------------------------------------------ -%% GENERATE PROTOTYPES -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Generate operation prototypes -%%------------------------------------------------------------ -emit_operation_prototypes(G, Fd, N, Xs) -> - lists:foreach( - fun(X) when is_record(X, op) -> - {ScopedName, ArgNames, RetParTypes} = - ic_cbe:extract_info(G, N, X), - {R, ParTypes, _} = RetParTypes, - IfName = ic_util:to_undersc(N), - RT = mk_ret_type(G, N, R), - ParList = - ic_util:chain( - mk_par_type_list(G, N, X, [in, out], [types], - ParTypes, ArgNames), - ", "), - emit(Fd, "~s ~s(~s, ~sCORBA_Environment*);\n", - [RT, ScopedName, IfName, ParList]); - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% Generate encoder prototypes -%%------------------------------------------------------------ -emit_encoder_prototypes(G, Fd, N, Xs) -> - lists:foreach( - fun(X) when is_record(X, op) -> - {ScopedName, ArgNames, RetParTypes} = - ic_cbe:extract_info(G, N, X), - {_R, ParTypes, _} = RetParTypes, - IfName = ic_util:to_undersc(N), - ParList = ic_util:chain( - mk_par_type_list(G, N, X, [in], [types], - ParTypes, ArgNames), - ", "), - emit(Fd, "int ~s__client_enc(~s, ~sCORBA_Environment*);\n", - [ScopedName, IfName, ParList]); - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% Generate decoder prototypes -%%------------------------------------------------------------ -emit_decoder_prototypes(G, Fd, N, Xs) -> - lists:foreach( - fun(X) when is_record(X, op) -> - case ic_forms:is_oneway(X) of - true -> - true; - false -> - IfName = ic_util:to_undersc(N), - {ScopedName, ArgNames, RetParTypes} = - ic_cbe:extract_info(G, N, X), - {R, ParTypes, _} = RetParTypes, - ParList0 = - mk_par_type_list(G, N, X, [out], [types], - ParTypes, ArgNames), - PARLIST = case mk_ret_type(G, N, R) of - "void" -> - ParList0; - Else -> - [Else ++ "*"| ParList0] - end, - ParList = ic_util:chain(PARLIST, ", "), - emit(Fd, "int ~s__client_dec(~s, ~s" - "CORBA_Environment*);\n", - [ScopedName, IfName, ParList]) - end; - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% PARAMETER TYPE LISTS -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Make parameter type list -%% -%% InOrOut = in | out | [in | out] -%% TypesOrArgs = types | args | [types | args] -%%------------------------------------------------------------ -mk_par_type_list(G, N, X, InOrOut, TypesOrArgs, Types, Args) -> - TypeAttrArgs = - filterzip( - fun(_, {inout, Arg}) -> - ic_error:error(G, {inout_spec_for_c, X, Arg}), - false; - (Type, {Attr, Arg}) -> - case lists:member(Attr, InOrOut) of - true -> - {true, {Type, Attr, Arg}}; - false -> - false - end - end, Types, Args), - lists:map( - fun({Type, Attr, Arg}) -> - Ctype = ic_cbe:mk_c_type(G, N, Type), - IsArray = ictype:isArray(G, N, Type), - IsStruct = ictype:isStruct(G, N, Type), - IsUnion = ictype:isUnion(G, N, Type), - Dyn = - case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> ""; - Ctype == "CORBA_char *" -> ""; - is_record(Type, wstring) -> ""; - Ctype == "CORBA_wchar *" -> ""; - true -> - case IsArray of - true -> - "_slice*"; - false -> - "*" - end - end; - false -> - if - Attr == in, Ctype == "erlang_pid" -> - "*"; - Attr == in, Ctype == "erlang_port" -> - "*"; - Attr == in, Ctype == "erlang_ref" -> - "*"; - Attr == in, IsStruct == true -> - "*"; - Attr == in, IsUnion == true -> - "*"; - Attr == in, IsArray == true -> - "_slice*"; - Attr == out, IsArray == true -> - "_slice"; - true -> - "" - end - end, - IndOp = mk_ind_op(Attr), - case {lists:member(types, TypesOrArgs), - lists:member(args, TypesOrArgs)} of - {true, true} -> - Ctype ++ Dyn ++ IndOp ++ " " ++ Arg; - {true, false} -> - Ctype ++ Dyn ++ IndOp; - {false, true} -> - Arg; - {false, false} -> - "" - end - end, TypeAttrArgs). - -%%------------------------------------------------------------ -%% ENCODER ARG LIST -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Make encoder argument list XXX -%%------------------------------------------------------------ -mk_arg_list_for_encoder(G, _N, X, Types, Args) -> - filterzip( - fun(_, {out, _}) -> - false; - (_, {inout, Arg}) -> - ic_error:error(G, {inout_spec_for_c, X, Arg}), - false; - (_Type, {in, Arg}) -> - {true, Arg} - end, Types, Args). - -%%------------------------------------------------------------ -%% DECODER ARG LIST -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Make decoder argument list XXX -%%------------------------------------------------------------ -mk_arg_list_for_decoder(G, _N, X, Types, Args) -> - filterzip(fun(_, {in, _}) -> - false; - (_, {inout, Arg}) -> - ic_error:error(G, {inout_spec_for_c, X, Arg}), - false; - (_, {out, Arg}) -> - {true, Arg} - end, Types, Args). - -%%------------------------------------------------------------ -%% MISC -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Make list of {Type, Attr, Arg} -%%------------------------------------------------------------ -mk_type_attr_arg_list(Types, Args) -> - filterzip(fun(Type, {Attr, Arg}) -> - {true, {Type, Attr, Arg}} - end, Types, Args). - -%%------------------------------------------------------------ -%% Make return type -%%------------------------------------------------------------ -mk_ret_type(G, N, Type) -> - Ctype = ic_cbe:mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - ""; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> - ""; - Ctype == "CORBA_wchar *" -> - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - "_slice*"; - false -> - "*" - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - "_slice*"; - false -> - "" - end - end, - Ctype ++ Dyn. - - -%%------------------------------------------------------------ -%% Make indirection operator (to "*" or not to "*"). -%%------------------------------------------------------------ -mk_ind_op(in) -> - ""; -mk_ind_op(inout) -> - error; -mk_ind_op(out) -> - "*". - -%%------------------------------------------------------------ -%% Emit encoding/decoding comment -%%------------------------------------------------------------ -emit_coding_comment(G, N, Fd, String, RefOrVal, Type, Name) -> - emit(Fd, " /* ~s parameter: ~s~s ~s */\n", - [String, ic_cbe:mk_c_type(G, N, Type), RefOrVal, Name]). - -%%------------------------------------------------------------ -%% User protocol prefix for generic functions -%%------------------------------------------------------------ -get_user_proto(G, Default) -> - case ic_options:get_opt(G, user_protocol) of - false -> - Default; - Pfx -> - Pfx - end. - -%%------------------------------------------------------------ -%% Timeout. Returns a string (or Default). -%%------------------------------------------------------------ -get_c_timeout(G, Default) -> - case ic_options:get_opt(G, c_timeout) of - Tmo when is_integer(Tmo) -> - TmoStr = integer_to_list(Tmo), - {TmoStr, TmoStr}; - {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) -> - {integer_to_list(SendTmo), integer_to_list(RecvTmo)}; - false -> - Default - end. - -%%------------------------------------------------------------ -%% ZIPPERS (merging of successive elements of two lists). -%%------------------------------------------------------------ - -%% zip([H1| T1], [H2| T2]) -> -%% [{H1, H2}| zip(T1, T2)]; -%% zip([], []) -> -%% []. - -filterzip(F, [H1| T1], [H2| T2]) -> - case F(H1, H2) of - false -> - filterzip(F, T1, T2); - {true, Val} -> - [Val| filterzip(F, T1, T2)] - end; -filterzip(_, [], []) -> - []. - - -ifelse(true, A, _) -> - A; -ifelse(false, _, B) -> - B. diff --git a/lib/ic/src/ic_code.erl b/lib/ic/src/ic_code.erl deleted file mode 100644 index 98d57db93b..0000000000 --- a/lib/ic/src/ic_code.erl +++ /dev/null @@ -1,585 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_code). - - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([get_basetype/2, insert_typedef/3, codeDirective/2]). --export([gen_includes/3, gen_includes/4, mk_list/1]). - --export([type_expand_op/4, type_expand_handle_op/4]). --export([ type_expand_op_exec/4, type_expand_all/6, type_expand/7]). - --export([type_expand_null/3, type_expand_void/3, type_expand_float/3, type_expand_double/3]). --export([type_expand_short/3, type_expand_ushort/3, type_expand_long/3, type_expand_ulong/3]). --export([type_expand_longlong/3, type_expand_ulonglong/3]). --export([type_expand_char/3, type_expand_wchar/3, type_expand_boolean/3]). --export([type_expand_octet/3, type_expand_any/3, type_expand_wstring/3]). --export([type_expand_object/3, type_expand_string/3, type_expand_struct/7, type_expand_union/7]). --export([type_expand_enum/4, type_expand_sequence/7, type_expand_array/7, type_expand_error/3]). - --export([type_expand_struct_rule/3, type_expand_union_rule/2, type_expand_enum_rule/4]). --export([type_expand_enum_elements/3, type_expand_longdouble/3, type_expand_typecode/3]). --export([type_expand_principal/3, type_expand_exception/7]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%------------------------------------------------------------------------------------- -%% -%% Trackrecording of generated sequence type structs, thist is just used for C today. -%% -%%------------------------------------------------------------------------------------- - -get_basetype(G, MyId) -> - case ?lookup(ic_genobj:typedeftab(G), MyId) of - [] -> - MyId; - X -> - get_basetype(G, X) - end. - -insert_typedef(_G, "erlang_term", _) -> - ok; -insert_typedef(G, MyId, DefinedAsId) -> - ?insert(ic_genobj:typedeftab(G), MyId, DefinedAsId). - -codeDirective(G,X) -> - case produceCode(X) of - true -> - case ic_options:get_opt(G, be) of - c_genserv -> - c; - c_client -> - c; - c_server -> - c_server; - _ -> - erlang - end; - false -> - case ic_options:get_opt(G, be) of - c_genserv -> - c_no_stub; - c_client -> - c_no_stub; - c_server -> - c_server_no_stub; - _ -> - erlang_no_stub - end - end. - -%% Checks if X should produce code -produceCode(X) when is_record(X, module) -> - case ic_forms:get_body(X) of - [] -> - true; - List -> - produceModuleCode(List) - end; -produceCode(_X) -> - false. - -produceModuleCode([]) -> - false; -produceModuleCode([X|_Xs]) when is_record(X, const) -> - true; -produceModuleCode([_X|Xs]) -> - produceModuleCode(Xs). - -%% Includes needed c file headers for included idl files -gen_includes(Fd,G,Type) -> - case Type of - c_client -> - IncludeList = - ic_pragma:get_included_c_headers(G), - gen_includes_loop(Fd,IncludeList,Type); - c_server -> - IncludeList = - ic_pragma:get_included_c_headers(G), - gen_includes_loop(Fd,IncludeList,Type); - _ -> - ok - end, - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, "#ifdef __cplusplus\n"), - ic_codegen:emit(Fd, "extern \"C\" {\n"), - ic_codegen:emit(Fd, "#endif\n\n"). - - -%% Includes needed c file headers for local interfaces -gen_includes(Fd,G,X,Type) -> - case Type of - c_client -> - IncludeList = - ic_pragma:get_local_c_headers(G,X), - gen_includes_loop(Fd,IncludeList,Type); - c_server -> - IncludeList = - ic_pragma:get_local_c_headers(G,X), - gen_includes_loop(Fd,IncludeList,Type); - _ -> - ok - end, - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, "#ifdef __cplusplus\n"), - ic_codegen:emit(Fd, "extern \"C\" {\n"), - ic_codegen:emit(Fd, "#endif\n\n"). - - -gen_includes_loop(_,[],_) -> - ok; -gen_includes_loop(Fd,[I|Is],Type) -> - L = string:tokens(I,"/"), - File = lists:last(L), - case File of - "erlang" -> % Erlang is NOT generated that way ! - gen_includes_loop(Fd,Is,Type); - "oe_erlang" -> % Erlang is NOT generated that way ! - gen_includes_loop(Fd,Is,Type); - _ -> - case Type of - c_client -> - ic_codegen:emit(Fd, "#include \"~s.h\"\n", [File]); - c_server -> - ic_codegen:emit(Fd, "#include \"~s__s.h\"\n", [File]) - end, - gen_includes_loop(Fd,Is,Type) - end. - - - - -%% -%% Used in NOC only -%% - - -%% -%% Type expand on function head comments -%% -type_expand_op(G,N,X,Fd) -> - case catch type_expand_op_exec(G,N,X,Fd) of - {'EXIT',_Reason} -> - ic_codegen:nl(Fd), - ic_codegen:emit(Fd,"%% Error under type expansion, does not affect generated code.~n",[]), - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]); - _ -> - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]) - end. - - -type_expand_op_exec(G,N,X,Fd) -> - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - ParamNr = length(InArgs)+1, - Tabs = "", - - ic_codegen:nl(Fd), - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]), - - case ic_forms:is_oneway(X) of - false -> - ic_codegen:emit(Fd,"%% Operation: ~s/~p~n",[ic_forms:get_id2(X),ParamNr]); - true -> - ic_codegen:emit(Fd,"%% Operation: ~s/~p (oneway)~n",[ic_forms:get_id2(X),ParamNr]) - end, - - if X#op.raises == [] -> []; - true -> - ic_codegen:emit(Fd,"%%~n",[]), - RaisesList=["%% Raises: " ++ - mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, - X#op.raises))], - ic_codegen:emit(Fd,RaisesList,[]), - ic_codegen:nl(Fd) - end, - - %% Print argument names - ic_codegen:emit(Fd,"%%\n",[]), - InArgNames = ["OE_Ref"]++[ic_util:mk_var(ic_forms:get_id(InArg#param.id)) || InArg <- InArgs ], - OutArgNames = ["Ret"]++[ic_util:mk_var(ic_forms:get_id(OutArg#param.id)) || OutArg <- OutArgs ], - case length(InArgNames) > 1 of - true -> - ic_codegen:emit(Fd,"%% Input value(s) : ~s~n",[mk_list(InArgNames)]); - false -> - ic_codegen:emit(Fd,"%% Input value : ~s~n",[mk_list(InArgNames)]) - end, - case length(OutArgNames) > 1 of - true -> - ic_codegen:emit(Fd,"%% Return value(s) : ~s~n",[mk_list(OutArgNames)]); - false -> - ic_codegen:emit(Fd,"%% Return value : ~s~n",[mk_list(OutArgNames)]) - end, - ic_codegen:emit(Fd,"%%\n",[]), - - InArgsTypeList = - [{ic_util:mk_var(ic_forms:get_id(InArg#param.id)),ic_forms:get_tk(InArg)} || InArg <- InArgs ], - case InArgsTypeList of - [] -> %% no input parameters - ok; - _ -> - ic_codegen:emit(Fd,"%% --input-params-~n",[]), - type_expand_all(G,N,X,Fd,Tabs,InArgsTypeList) - end, - - ReturnTypeList =[{"Ret",X#op.tk}], - ic_codegen:emit(Fd,"%% --return-value-~n",[]), - type_expand_all(G,N,X,Fd,Tabs,ReturnTypeList), - - OutArgsTypeList = - [{ic_util:mk_var(ic_forms:get_id(OutArg#param.id)),ic_forms:get_tk(OutArg)} || OutArg <- OutArgs ], - case OutArgsTypeList of - [] -> %% no input parameters - ok; - _ -> - ic_codegen:emit(Fd,"%% -output-values-~n",[]), - type_expand_all(G,N,X,Fd,Tabs,OutArgsTypeList) - end. - - - - -type_expand_handle_op(G,N,X,Fd) -> - case catch type_expand_handle_op_exec(G,N,X,Fd) of - {'EXIT',_Reason} -> - ic_codegen:nl(Fd), - ic_codegen:emit(Fd,"%% Error under type expansion, does not affect generated code.~n",[]), - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]); - _ -> - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]) - end. - - -type_expand_handle_op_exec(_G,_N,X,Fd) -> - InArgs = ic:filter_params([in,inout], X#op.params), - ParamNr = length(InArgs)+1, - - ic_codegen:nl(Fd), - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]), - - case ic_forms:is_oneway(X) of - false -> - ic_codegen:emit(Fd,"%% Handle operation: handle_call/3~n",[]); - true -> - ic_codegen:emit(Fd,"%% Handle operation: handle_cast/3~n",[]) - end, - ic_codegen:emit(Fd,"%%~n",[]), - ic_codegen:emit(Fd,"%% Used for operation ~s/~p implementation~n",[ic_forms:get_id2(X),ParamNr]). - - - -type_expand_all(_G,_N,_X,_Fd,_Tabs,[]) -> - ok; -type_expand_all(G,N,X,Fd,Tabs,[{ArgName,Type}|Rest]) -> - type_expand(G,N,X,Fd,Tabs,ArgName,Type), - type_expand_all(G,N,X,Fd,Tabs,Rest); -type_expand_all(G,N,X,Fd,Tabs,[{default,_ArgName,Type}|Rest]) -> - type_expand(G,N,X,Fd,Tabs,"Def",Type), - type_expand_all(G,N,X,Fd,Tabs,Rest); -type_expand_all(G,N,X,Fd,Tabs,[{LabelNr,_ArgName,Type}|Rest]) when is_integer(LabelNr) -> - type_expand(G,N,X,Fd,Tabs,"V" ++ integer_to_list(LabelNr),Type), - type_expand_all(G,N,X,Fd,Tabs,Rest); -type_expand_all(G,N,X,Fd,Tabs,[{Label,_ArgName,Type}|Rest]) -> - type_expand(G,N,X,Fd,Tabs,Label,Type), - type_expand_all(G,N,X,Fd,Tabs,Rest). - - - -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_null) -> - type_expand_null(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_void) -> - type_expand_void(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_float) -> - type_expand_float(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_double) -> - type_expand_double(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_longdouble) -> - type_expand_longdouble(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_short) -> - type_expand_short(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ushort) -> - type_expand_ushort(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_long) -> - type_expand_long(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_longlong) -> - type_expand_longlong(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ulong) -> - type_expand_ulong(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ulonglong) -> - type_expand_ulonglong(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_char) -> - type_expand_char(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_wchar) -> - type_expand_wchar(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_boolean) -> - type_expand_boolean(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_octet) -> - type_expand_octet(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_any) -> - type_expand_any(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_TypeCode) -> - type_expand_typecode(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_Principal) -> - type_expand_principal(Fd,Tabs,Name); -type_expand(G, N, X,Fd,Tabs,Name, {tk_except, Id, ExcName, ElementList}) -> - type_expand_exception(G, N, X, Fd,Tabs,Name, - {tk_except, Id, ExcName, ElementList}); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_fixed, _Digits, _Scale}) -> - type_expand_fixed(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_objref, _IFRId, _ObjTabs, _ObjName}) -> - type_expand_object(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_objref, _IFRId, _ObjName}) -> - type_expand_object(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_string, _Length}) -> - type_expand_string(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_wstring, _Length}) -> - type_expand_wstring(Fd,Tabs,Name); -type_expand(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, DNr, LblList}) -> - type_expand_union(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, DNr, LblList}); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_enum, IFRId, EnumName, ElemNameList}) -> - type_expand_enum(Fd,Tabs,Name,{tk_enum, IFRId, EnumName, ElemNameList}); -type_expand(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, Length}) -> - type_expand_sequence(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, Length}); -type_expand(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, Length}) -> - type_expand_array(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, Length}); -type_expand(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}) -> - type_expand_struct(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}); -type_expand(_G,_N,_X,Fd,Tabs,Name,_) -> - type_expand_error(Fd,Tabs,Name). - - -%% Basic OMG IDL types - -type_expand_null(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = null()~n",[Tabs,Name]). - -type_expand_void(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = void()~n",[Tabs,Name]). - -type_expand_float(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = float()~n",[Tabs,Name]). - -type_expand_double(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = double()~n",[Tabs,Name]). - -type_expand_longdouble(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = long_double()~n",[Tabs,Name]). - -type_expand_short(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = short()~n",[Tabs,Name]). - -type_expand_ushort(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = unsigned_Short()~n",[Tabs,Name]). - -type_expand_long(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = long()~n",[Tabs,Name]). - -type_expand_longlong(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = long_Long()~n",[Tabs,Name]). - -type_expand_ulong(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = unsigned_Long()~n",[Tabs,Name]). - -type_expand_ulonglong(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = unsigned_Long_Long()~n",[Tabs,Name]). - -type_expand_char(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = char()~n",[Tabs,Name]). - -type_expand_wchar(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = wchar()~n",[Tabs,Name]). - -type_expand_boolean(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = boolean()~n",[Tabs,Name]). - -type_expand_octet(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = octet()~n",[Tabs,Name]). - -type_expand_any(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = any()~n",[Tabs,Name]). - -type_expand_typecode(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = TypeCode()~n",[Tabs,Name]). - -type_expand_principal(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = principal()~n",[Tabs,Name]). - - -type_expand_fixed(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = fixed()~n",[Tabs,Name]). - -type_expand_object(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = Object_Ref()~n",[Tabs,Name]). - - -%% Constructed OMG IDL types - -type_expand_string(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = String()~n",[Tabs,Name]). - -type_expand_wstring(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = WString()~n",[Tabs,Name]). - -type_expand_exception(G, N, X, Fd, Tabs, Name, {tk_except, Id, ExcName, ElementList}) -> - ScopedStructName = getScopedName(G, N, ExcName, Id), - ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs, Name]), - type_expand_exception_rule(Fd, ScopedStructName, ElementList), - type_expand_all(G, N, X, Fd, Tabs, ElementList). - -type_expand_struct(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}) -> - ScopedStructName = getScopedName(G,N,StructName,IFRId), - ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs,Name]), - type_expand_struct_rule(Fd,ScopedStructName,TcList), - type_expand_all(G,N,X,Fd,Tabs,TcList). - -type_expand_union(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, _DNr, LblList}) -> - ScopedUnionName = getScopedName(G,N,UnionName,IFRId), - ic_codegen:emit(Fd,"%%~s ~s = #'~s'{label, value}\n",[Tabs,Name,ScopedUnionName]), - type_expand(G,N,X,Fd,Tabs,"label",DTC), - ic_codegen:emit(Fd,"%%~s value = ",[Tabs]), - type_expand_union_rule(Fd,LblList), - type_expand_all(G,N,X,Fd,Tabs,LblList). - -type_expand_enum(Fd,Tabs,Name,{tk_enum, _IFRId, EnumName, ElemNameList}) -> - ic_codegen:emit(Fd,"%%~s ~s = ~s~n",[Tabs,Name,EnumName]), - type_expand_enum_rule(Fd,Tabs,EnumName,ElemNameList). - -type_expand_sequence(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, _Length}) -> - ic_codegen:emit(Fd,"%%~s ~s = [ ~sElem ]~n",[Tabs,Name,Name]), - type_expand(G,N,X,Fd,Tabs,Name++"Elem",ElemTC). - -type_expand_array(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, _Length}) -> - ic_codegen:emit(Fd,"%%~s ~s = { ~sElem[,..~sElem] }~n",[Tabs,Name,Name,Name]), - type_expand(G,N,X,Fd,Tabs,Name++"Elem",ElemTC). - -type_expand_error(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = ????~n",[Tabs,Name]). - - -type_expand_exception_rule(Fd,_Name,[]) -> - ic_codegen:emit(Fd," ???? "); -type_expand_exception_rule(Fd,Name,TcList) -> - ic_codegen:emit(Fd,"#'~s'{",[Name]), - type_expand_exception_rule(Fd,TcList). - -type_expand_exception_rule(Fd,[{Name,_TC}]) -> - ic_codegen:emit(Fd,"~s}~n",[Name]); -type_expand_exception_rule(Fd,[{Name,_TC}|Rest]) -> - ic_codegen:emit(Fd,"~s,",[Name]), - type_expand_exception_rule(Fd,Rest). - -type_expand_struct_rule(Fd,_Name,[]) -> - ic_codegen:emit(Fd," ???? "); -type_expand_struct_rule(Fd,Name,TcList) -> - ic_codegen:emit(Fd,"#'~s'{",[Name]), - type_expand_struct_rule(Fd,TcList). - -type_expand_struct_rule(Fd,[{Name,_TC}]) -> - ic_codegen:emit(Fd,"~s}~n",[Name]); -type_expand_struct_rule(Fd,[{Name,_TC}|Rest]) -> - ic_codegen:emit(Fd,"~s,",[Name]), - type_expand_struct_rule(Fd,Rest). - - -type_expand_union_rule(Fd,[]) -> - ic_codegen:emit(Fd," ????"); -type_expand_union_rule(Fd,[{default,_Name,_TC}]) -> - ic_codegen:emit(Fd,"Def~n",[]); -type_expand_union_rule(Fd,[{LNr,_Name,_TC}]) when is_integer(LNr)-> - ic_codegen:emit(Fd,"V~p~n",[LNr]); -type_expand_union_rule(Fd,[{Label,_Name,_TC}]) -> - ic_codegen:emit(Fd,"~s~n",[Label]); -type_expand_union_rule(Fd,[{default,_Name,_TC}|Rest]) -> - ic_codegen:emit(Fd,"Default | "), - type_expand_union_rule(Fd,Rest); -type_expand_union_rule(Fd,[{LNr,_Name,_TC}|Rest]) when is_integer(LNr) -> - ic_codegen:emit(Fd,"V~p | ",[LNr]), - type_expand_union_rule(Fd,Rest); -type_expand_union_rule(Fd,[{Label,_Name,_TC}|Rest]) -> - ic_codegen:emit(Fd,"~s | ",[Label]), - type_expand_union_rule(Fd,Rest). - - -type_expand_enum_rule(Fd,Tabs,Name,[]) -> - ic_codegen:emit(Fd,"%%~s ~s = ????",[Tabs,Name]); -type_expand_enum_rule(Fd,Tabs,Name,ElList) -> - ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs,Name]), - type_expand_enum_rule(Fd,ElList). - -type_expand_enum_rule(Fd,[ElName]) -> - ic_codegen:emit(Fd,"'~s' ~n",[ElName]); -type_expand_enum_rule(Fd,[First|Rest]) -> - ic_codegen:emit(Fd,"'~s' | ",[First]), - type_expand_enum_rule(Fd,Rest). - -type_expand_enum_elements(_Fd,_Tabs,[]) -> - ok; -type_expand_enum_elements(Fd,Tabs,[Elem|Elems]) -> - ic_codegen:emit(Fd,"%%~s ~s = Atom()~n",[Tabs,Elem]), - type_expand_enum_elements(Fd,Tabs,Elems). - - - -%% Returns the right scoped name to be used -%% along with the expansion comments -getScopedName(G,N,Name,IfrId) -> - PTab = ic_genobj:pragmatab(G), - case ets:match(PTab,{alias,'$0',IfrId}) of - [] -> %% No Alias - should never happen - ic_util:to_undersc(ic_pragma:mk_scope(IfrId)); - [[[_S|N]]] -> %% An alias - ic_util:to_undersc([Name|N]); - [[[S|FoundScope]]] -> %% Maybe inherited - case ic_pragma:is_inherited_by(FoundScope,N,PTab) of - false -> %% Not inherited - ic_util:to_undersc([S|FoundScope]); - true -> %% inherited - ic_util:to_undersc([Name|N]) - end - end. - - -%% mk_list produces a nice comma separated -%% string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - - - diff --git a/lib/ic/src/ic_codegen.erl b/lib/ic/src/ic_codegen.erl deleted file mode 100644 index a3f141f606..0000000000 --- a/lib/ic/src/ic_codegen.erl +++ /dev/null @@ -1,423 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_codegen). - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([emit/2, emit/3]). --export([emit_c_enc_rpt/4, emit_c_dec_rpt/4]). --export([comment/2, comment/3, comment/4, comment_inlined/5, comment_prefixed/4]). --export([mcomment/2, mcomment/3, mcomment_inlined/5, mcomment_prefixed/3]). --export([mcomment_light/2, mcomment_light/3, mcomment_light_inlined/5, mcomment_light_prefixed/3]). --export([nl/1, export/2]). --export([record/5]). --export([emit_stub_head/4, emit_hrl_head/4, emit_hrl_foot/2]). -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% Emit output as a formatted string, (old emit) -%%-------------------------------------------------------------------- -emit(nil, _) -> ok; -emit(Fd, Str) -> - file:write(Fd, Str). - -emit(nil, _, _) -> ok; -emit(Fd, Fmt, Args) -> - file:write(Fd, io_lib:format(Fmt, Args)). - -emit_c_enc_rpt(Fd, Prefix, Fmt, Args) -> - emit(Fd, Prefix ++ "OE_RPT_ERR(\"Encode error: " ++ Fmt ++ "\");\n", Args). - -emit_c_dec_rpt(Fd, Prefix, Fmt, Args) -> - emit(Fd, Prefix ++ "OE_RPT_ERR(\"Decode error: " ++ Fmt ++ "\");\n", Args). - -%%-------------------------------------------------------------------- -%% Emit comments -%%-------------------------------------------------------------------- -comment(Fd, C) -> - comment_prefixed(Fd, C, [], "%%"). - -comment(Fd, C, A) -> - comment_prefixed(Fd, C, A, "%%"). - -comment(Fd, C, A, c) -> - comment_inlined(Fd, C, A, "/*", "*/"); -comment(Fd, C, A, erl) -> - comment_prefixed(Fd, C, A, "%%"); -comment(Fd, C, A, java) -> - comment_prefixed(Fd, C, A, "//"); -%% Should be removed after a check if it's used !!!!! (LTH) -comment(Fd, C, A, CommentSequence) when is_list(CommentSequence) -> - comment_prefixed(Fd, C, A, CommentSequence). - -comment_inlined(Fd, C, A, Start, End) -> - emit(Fd, Start ++ " " ++ C ++ " " ++ End ++"\n", A). - -comment_prefixed(Fd, C, A, Prefix) -> - emit(Fd, Prefix ++ " " ++ C ++ "\n", A). - -%%-------------------------------------------------------------------- -%% Emit multiline comments with nice delimiters -%%-------------------------------------------------------------------- -mcomment(Fd, List) -> - mcomment_prefixed(Fd, List, "%%"). - -mcomment(Fd, List, c) -> - mcomment_inlined(Fd, List, "/*", "*/", " *"); -mcomment(Fd, List, erl) -> - mcomment_prefixed(Fd, List, "%%"); -mcomment(Fd, List, java) -> - mcomment_prefixed(Fd, List, "//"). - -mcomment_inlined(Fd, List, Start, End, Intermediate) -> - emit(Fd, Start ++ - "------------------------------------------------------------\n"), - emit(Fd, Intermediate ++ "\n"), - lists:foreach(fun(C) -> comment(Fd, C, [], Intermediate) end, List), - emit(Fd, Intermediate ++ "\n"), - emit(Fd, Intermediate ++ - "------------------------------------------------------------" ++ End ++ "\n"), - ok. -mcomment_prefixed(Fd, List, Prefix) -> - emit(Fd, Prefix ++ - "------------------------------------------------------------\n"), - emit(Fd, Prefix ++ "\n"), - lists:foreach(fun(C) -> comment(Fd, C, [], Prefix) end, List), - emit(Fd, Prefix ++ "\n"), - emit(Fd, Prefix ++ - "------------------------------------------------------------\n"), - ok. - - -%%-------------------------------------------------------------------- -%% Emit multiline comments with nice delimiters as above but a -%% little lighter -%%-------------------------------------------------------------------- -mcomment_light(Fd, List) -> - mcomment_light_prefixed(Fd, List, "%%"). - -mcomment_light(Fd, List, c) -> - mcomment_light_inlined(Fd, List, "/*", " */", " *"); -mcomment_light(Fd, List, erl) -> - mcomment_light_prefixed(Fd, List, "%%"); -mcomment_light(Fd, List, java) -> - mcomment_light_prefixed(Fd, List, "//"); -%% Should be removed after a check if it's used !!!!! (LTH) -mcomment_light(Fd, List, Prefix) when is_list(Prefix) -> - mcomment_light_prefixed(Fd, List, Prefix). - -mcomment_light_inlined(Fd, List, Start, End, Intermediate) -> - emit(Fd, "\n" ++ Start ++ "\n"), - lists:foreach(fun(C) -> comment(Fd, C, [], Intermediate) end, List), - emit(Fd, End ++ "\n"), - ok. - -mcomment_light_prefixed(Fd, List, Prefix) -> - emit(Fd, Prefix), - lists:foreach(fun(C) -> comment(Fd, C, [], Prefix) end, List), - emit(Fd, Prefix ++ "\n"), - ok. - -%%-------------------------------------------------------------------- -%% New line -%%-------------------------------------------------------------------- -nl(Fd) -> - emit(Fd, "\n"). - - -%%-------------------------------------------------------------------- --define(IFRIDFIELD(G), ic_util:mk_name(G, "ID")). - -%%-------------------------------------------------------------------- -%% Emit record definitions for erlang -%%-------------------------------------------------------------------- -record(G, X, Name, _IFRID, Recs) when is_record(X, struct) -> - F = ic_genobj:hrlfiled(G), - emit(F, "-record(~p, {~p", [ic_util:to_atom(Name),hd(Recs)]), - lists:foreach(fun(Y) -> emit(F, ", ~p", [Y]) end, tl(Recs)), - emit(F, "}).\n"); -record(G, X, Name, _IFRID, _Recs) when is_record(X, union) -> - F = ic_genobj:hrlfiled(G), - emit(F, "-record(~p, {label, value}).\n",[ic_util:to_atom(Name)]); -record(G, _X, Name, IFRID, Recs) when length(Recs) > 3 -> - F = ic_genobj:hrlfiled(G), - emit(F, "-record(~p,~n {~p=~p", - [ic_util:to_atom(Name), ic_util:to_atom(?IFRIDFIELD(G)), IFRID]), - rec2(F, "", ", ", Recs), - emit(F, "}).\n"); -record(G, _X, Name, IFRID, Recs) -> - F = ic_genobj:hrlfiled(G), - emit(F, "-record(~p, {~p=~p", [ic_util:to_atom(Name), - ic_util:to_atom(?IFRIDFIELD(G)), - IFRID]), - lists:foreach(fun(Y) -> emit(F, ", ~p", [Y]) end, Recs), - emit(F, "}).\n"). - - -rec2(F, Align, Delim, [M1 , M2, M3 | Ms]) -> - emit(F, "~s~s~p, ~p, ~p", [Delim, Align, M1, M2, M3]), - rec2(F, " ", ",\n", Ms); -rec2(F, Align, Delim, [M1 , M2]) -> - emit(F, "~s~s~p, ~p", [Delim, Align, M1, M2]); -rec2(F, Align, Delim, [M]) -> - emit(F, "~s~s~p", [Delim, Align, M]); -rec2(_F, _Align, _Delim, []) -> - ok. - - -%%-------------------------------------------------------------------- -%% Emit export lists for erlang -%%-------------------------------------------------------------------- -export(F, [E1, E2, E3 | Exports]) -> - emit(F, "-export([~s]).\n", [exp_list([E1, E2, E3])]), - export(F, Exports); -export(_F, []) -> ok; -export(F, Exports) -> - emit(F, "-export([~s]).\n", [exp_list(Exports)]). - -exp_list([E1 | L]) -> - exp_to_string(E1) ++ - lists:map(fun(E) -> ", " ++ exp_to_string(E) end, L). - - -exp_to_string({F,N}) -> io_lib:format("~p/~p", [ic_util:to_atom(F), N]). - - -%%-------------------------------------------------------------------- -%% Emit Stub file header -%%-------------------------------------------------------------------- -emit_stub_head(_G, ignore, _Name, _) -> ignore; -emit_stub_head(G, F1, Name, erlang) -> - comment(F1, " coding: latin-1", []), - mcomment(F1, stub_header(G, Name)), - nl(F1), - emit(F1, "-module(~p).\n", [list_to_atom(Name)]), - emit(F1, "-ic_compiled(~p).\n", [compiler_vsn(?COMPILERVSN)]), - emit(F1, "\n\n"), F1; -emit_stub_head(G, F1, Name, erlang_template) -> - comment(F1, " coding: latin-1", []), - ic_erl_template:emit_header(G, F1, Name), - F1; -emit_stub_head(_G, F1, _Name, erlang_template_no_gen) -> - F1; -emit_stub_head(G, F1, Name, c) -> - mcomment(F1, stub_header(G, Name), c), - emit(F1, "int ic_compiled_~s_~s;\n", [compiler_vsn(?COMPILERVSN), Name]), - emit(F1, "\n\n"), F1; -emit_stub_head(G, F1, Name, c_server) -> - CSName = [Name, "__s"], - mcomment(F1, stub_header(G, CSName), c), - emit(F1, "int ic_compiled_~s_~s;\n", [compiler_vsn(?COMPILERVSN), CSName]), - emit(F1, "\n\n"), F1; -emit_stub_head(G, F1, Name, java) -> - mcomment(F1, stub_header(G, Name), java), - emit(F1, "\n\n"), F1. - -stub_header(G, Name) -> - ["Implementation stub file", - "", - io_lib:format("Target: ~ts", [Name]), - io_lib:format("Source: ~ts", [ic_genobj:idlfile(G)]), - io_lib:format("IC vsn: ~s", [?COMPILERVSN]), - "", - "This file is automatically generated. DO NOT EDIT IT."]. - -compiler_vsn(Vsn) -> - lists:map(fun($.) -> $_; - (C) -> C - end, Vsn). - -%%-------------------------------------------------------------------- -%% Emit include file header -%%-------------------------------------------------------------------- -%% Name is Fully scoped (undescore) name of interface or module -emit_hrl_head(_G, ignore, _Name, _) -> ignore; -emit_hrl_head(G, Fd, Name, erlang) -> - comment(Fd, " coding: latin-1", []), - mcomment(Fd, ["Erlang header file" | - hrl_header(G, Name)]), - nl(Fd), - nl(Fd), - IfdefName = ic_util:to_uppercase(Name++"_HRL"), - emit(Fd, "-ifndef(~s).~n", [IfdefName]), - emit(Fd, "-define(~s, true).~n", [IfdefName]), - nl(Fd), - nl(Fd), - Fd; -emit_hrl_head(G, Fd, Name, c) -> - mcomment(Fd, ["C header file" | - hrl_header(G, Name)], c), - nl(Fd), - nl(Fd), - IfdefName = ic_util:to_uppercase(Name++"_H"), - emit(Fd, "#ifndef ~s~n", [IfdefName]), - emit(Fd, "#define ~s ~n", [IfdefName]), - nl(Fd), - nl(Fd), - Fd; -emit_hrl_head(G, Fd, Name, c_server) -> - mcomment(Fd, ["C header file" | - hrl_header(G, [Name, "__s"])], c), - nl(Fd), - nl(Fd), - IfdefName = ic_util:to_uppercase(Name++"__S_H"), - emit(Fd, "#ifndef ~s~n", [IfdefName]), - emit(Fd, "#define ~s ~n", [IfdefName]), - nl(Fd), - nl(Fd), - Fd. - -hrl_header(G, Name) -> - ["", - io_lib:format("Target: ~ts", [Name]), - io_lib:format("Source: ~ts", [ic_genobj:idlfile(G)]), - io_lib:format("IC vsn: ~s", [?COMPILERVSN]), - "", - "This file is automatically generated. DO NOT EDIT IT."]. - - - - -%%-------------------------------------------------------------------- -%% Emit include file footer -%%-------------------------------------------------------------------- -emit_hrl_foot(_G, erlang_template) -> - ok; -emit_hrl_foot(_G, erlang_template_no_gen) -> - ok; -emit_hrl_foot(G, erlang) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "-endif.\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, erlang_no_stub) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "-endif.\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, c) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "#ifdef __cplusplus\n"), - emit(Fd, "}\n"), - emit(Fd, "#endif\n"), - nl(Fd), - emit(Fd, "#endif\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, c_server) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "#ifdef __cplusplus\n"), - emit(Fd, "}\n"), - emit(Fd, "#endif\n"), - nl(Fd), - emit(Fd, "#endif\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, c_no_stub) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "#ifdef __cplusplus\n"), - emit(Fd, "}\n"), - emit(Fd, "#endif\n"), - nl(Fd), - emit(Fd, "#endif\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, c_server_no_stub) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "#ifdef __cplusplus\n"), - emit(Fd, "}\n"), - emit(Fd, "#endif\n"), - nl(Fd), - emit(Fd, "#endif\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end. - - - - - - - - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_constant_java.erl b/lib/ic/src/ic_constant_java.erl deleted file mode 100644 index 49150f96ac..0000000000 --- a/lib/ic/src/ic_constant_java.erl +++ /dev/null @@ -1,100 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% --module(ic_constant_java). - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: gen/3 -%%----------------------------------------------------------------- -gen(G, N, X) when is_record(X, const) -> - ConstantName = ic_forms:get_java_id(X), - case inInterface(G, N) of - true -> - emit_constant(G, N, X, ConstantName); - false -> - emit_constant_interface(G, N, X, ConstantName) - end; -gen(_G, _N, _X) -> - ok. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: emit_constant/4 -%%----------------------------------------------------------------- -emit_constant(G, N, X, ConstantName) -> - Fd = ic_genobj:interfacefiled(G), - %%?PRINTDEBUG2("~p", [Fd]), - Type = ic_java_type:getType(G, N, ic_forms:get_type(X)), - ic_codegen:emit(Fd, " public static final ~s ~s = (~s) ~p;\n", - [Type, ConstantName, Type, X#const.val]), - ic_codegen:nl(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_constant_interface/4 -%%----------------------------------------------------------------- -emit_constant_interface(G, N, X, ConstantName) -> - {Fd, _} = ic_file:open_java_file(G, N, ConstantName), - - ic_codegen:emit(Fd, "final public class ~s {\n",[ConstantName]), - - Type = ic_java_type:getType(G, N, ic_forms:get_type(X)), - ic_codegen:emit(Fd, " public static final ~s value = (~s) ~p;\n", - [Type, Type, X#const.val]), - ic_codegen:emit(Fd, "}\n", []), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_constant_interface/4 -%%----------------------------------------------------------------- -inInterface(_G, []) -> % Global constant - false; -inInterface(G, N) -> - [N1 |Ns] = N, - {_FullScopedName, T, _TK, _} = - ic_symtab:get_full_scoped_name(G, Ns, ic_symtab:scoped_id_new(N1)), - case T of - interface -> % Constant declare in an interface - true; - _ -> % Constant declared in a module - false - end. - diff --git a/lib/ic/src/ic_cserver.erl b/lib/ic/src/ic_cserver.erl deleted file mode 100644 index 7c7506367e..0000000000 --- a/lib/ic/src/ic_cserver.erl +++ /dev/null @@ -1,2420 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% --module(ic_cserver). - -%% This module implements generation of C server code, where the -%% server acts as an Erlang C-node, where the functionality is that of -%% a gen_server (in C), and where the communication thus is according -%% to the Erlang distribution protocol. -%% - --export([do_gen/3]). - -%% Silly dialyzer. --export([filterzip/3]). - -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --import(lists, [foreach/2, foldl/3, foldr/3, map/2]). --import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). - --include("icforms.hrl"). --include("ic.hrl"). --include_lib("stdlib/include/erl_compile.hrl"). - --define(IC_HEADER, "ic.h"). --define(ERL_INTERFACEHEADER, "erl_interface.h"). --define(EICONVHEADER, "ei.h"). --define(OE_MSGBUFSIZE, "OE_MSGBUFSIZE"). --define(ERLANGATOMLENGTH, "256"). - -%%------------------------------------------------------------ -%% -%% Entry point -%% -%%------------------------------------------------------------ -do_gen(G, File, Form) -> - OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))), - G2 = ic_file:filename_push(G, [], OeName, c_server), - gen_headers(G2, [], Form), - R = gen(G2, [], Form), - ic_file:filename_pop(G2, c), - R. - -remove_ext(File) -> - filename:rootname(filename:basename(File)). - -%%------------------------------------------------------------ -%% -%% Generate the server side C stub and header files. -%% -%% For each module a separate file is generated. -%% -%% -%%------------------------------------------------------------ - -gen(G, N, [X| Xs]) when is_record(X, preproc) -> - NewG = change_file_stack(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, module) -> - CD = ic_code:codeDirective(G, X), - G2 = ic_file:filename_push(G, N, X, CD), - N2 = [ic_forms:get_id2(X)| N], - gen_headers(G2, N2, X), - gen(G2, N2, ic_forms:get_body(X)), - G3 = ic_file:filename_pop(G2, CD), - gen(G3, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, interface) -> - G2 = ic_file:filename_push(G, N, X, c_server), - N2 = [ic_forms:get_id2(X)| N], - gen_prototypes(G2, N2, X), - gen_serv(G2, N2, X), - G3 = ic_file:filename_pop(G2, c), - gen(G3, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, const) -> - emit_constant(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, op) -> - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, attr) -> - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, enum) -> - icenum:enum_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, typedef) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, struct) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, union) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [_| Xs]) -> - gen(G, N, Xs); - -gen(_G, _N, []) -> - ok. - -%%------------------------------------------------------------ -%% Change file stack -%%------------------------------------------------------------ - -change_file_stack(G, _N, line_nr, X) -> - Id = ic_forms:get_id2(X), - Flags = X#preproc.aux, - case Flags of - [] -> ic_genobj:push_file(G, Id); - _ -> - foldr( - fun({_, _, "1"}, G1) -> ic_genobj:push_file(G1, Id); - ({_, _, "2"}, G1) -> ic_genobj:pop_file(G1, Id); - ({_, _, "3"}, G1) -> ic_genobj:sys_file(G1, Id) - end, G, Flags) - end; -change_file_stack(G, _N, _Other, _X) -> - G. - -%%------------------------------------------------------------ -%% Generate headers -%%------------------------------------------------------------ - -%% Some items have extra includes -gen_headers(G, N, X) when is_record(X, module) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - HFd = ic_genobj:hrlfiled(G), - IncludeFileStack = ic_genobj:include_file_stack(G), - Filename = lists:nth(length(N) + 1, IncludeFileStack), - emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), - ic_code:gen_includes(HFd, G, X, c_server); - false -> ok - end; -gen_headers(G, [], _X) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - HFd = ic_genobj:hrlfiled(G), - emit(HFd, "#include <stdlib.h>\n"), - case ic_options:get_opt(G, c_report) of - true -> - emit(HFd, "#ifndef OE_C_REPORT\n"), - emit(HFd, "#define OE_C_REPORT\n"), - emit(HFd, "#include <stdio.h>\n"), - emit(HFd, "#endif\n"); - _ -> - ok - end, - emit(HFd, "#include \"~s\"\n", [?IC_HEADER]), - emit(HFd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), - emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]), - ic_code:gen_includes(HFd, G, c_server); - false -> ok - end; -gen_headers(_G, _N, _X) -> - ok. - -%%------------------------------------------------------------ -%% Generate prototypes -%%------------------------------------------------------------ - -gen_prototypes(G, N, X) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - HFd = ic_genobj:hrlfiled(G), - IncludeFileStack = ic_genobj:include_file_stack(G), - L = length(N), - Filename = - if - L < 2 -> - lists:nth(L + 1, IncludeFileStack); - true -> - lists:nth(2, IncludeFileStack) - end, - - IName = ic_util:to_undersc(N), - INameUC = ic_util:to_uppercase(IName), - - emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), - ic_code:gen_includes(HFd, G, X, c_server), - ic_codegen:nl(HFd), - - emit(HFd, "\n#ifndef __~s__\n", [ic_util:to_uppercase(IName)]), - emit(HFd, "#define __~s__\n", [ic_util:to_uppercase(IName)]), - ic_codegen:mcomment_light(HFd, - [io_lib:format("Interface " - "object " - "definition: ~s", - [IName])], c), - case get_c_timeout(G, "") of - "" -> - ok; - {SendTmo, RecvTmo} -> - emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n", - [INameUC, SendTmo]), - emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n", - [INameUC, RecvTmo]), - emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"), - emit(HFd, "#error Functions for send and receive with " - "timeout not defined in erl_interface\n"), - emit(HFd, "#endif\n\n") - end, - - emit(HFd, "typedef CORBA_Object ~s;\n\n", [IName]), - emit(HFd, "#endif\n\n"), - - Bodies = [{N, ic_forms:get_body(X)}| X#interface.inherit_body], - - emit(HFd, "\n/* Structure definitions */\n", []), - foreach(fun({N2, Body}) -> - emit_structs_inside_module(G, HFd, N2, Body) end, - Bodies), - - emit(HFd, "\n/* Switch and exec functions */\n", []), - emit(HFd, "int ~s__switch(~s oe_obj, CORBA_Environment " - "*oe_env);\n", [IName, IName]), - foreach(fun({_N2, Body}) -> - emit_exec_prototypes(G, HFd, N, Body) end, - Bodies), - - emit(HFd, "\n/* Generic decoder */\n", []), - emit(HFd, "int ~s__call_info(~s oe_obj, CORBA_Environment " - "*oe_env);\n", [IName, IName]), - - emit(HFd, "\n/* Restore function typedefs */\n", []), - foreach(fun({_N2, Body}) -> - emit_restore_typedefs(G, HFd, N, Body) end, - Bodies), - - emit(HFd, "\n/* Callback functions */\n", []), - foreach(fun({_N2, Body}) -> - emit_callback_prototypes(G, HFd, N, Body) end, - Bodies), - - emit(HFd, "\n/* Parameter decoders */\n", []), - foreach(fun({_N2, Body}) -> - emit_decoder_prototypes(G, HFd, N, Body) end, - Bodies), - - emit(HFd, "\n/* Message encoders */\n", []), - foreach(fun({_N2, Body}) -> - emit_encoder_prototypes(G, HFd, N, Body) end, - Bodies), - - %% Emit operation mapping structures - emit_operation_mapping_declaration(G, HFd, N, Bodies), - - ok; - - false -> - ok - end. - -%%------------------------------------------------------------ -%% Generate the server encoding/decoding function -%%------------------------------------------------------------ - - -gen_serv(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - Fd = ic_genobj:stubfiled(G), - - emit_switch(G, Fd, N, X), - emit_server_generic_decoding(G, Fd, N), - - %% Sets the temporary variable counter. - put(op_variable_count, 0), - put(tmp_declarations, []), - - %% Generate exec, decode and encoding functions, and - %% table of exec functions. - Bodies = [{N, ic_forms:get_body(X)}| - X#interface.inherit_body], - - foreach(fun({_N2, Body}) -> - emit_dispatch(G, Fd, N, Body) end, - Bodies), - emit_operation_mapping(G, Fd, N, Bodies); - false -> - ok - end. - -%%------------------------------------------------------------ -%% Emit structs inside module -%%------------------------------------------------------------ - -emit_structs_inside_module(G, _Fd, N, Xs)-> - lists:foreach( - fun(X) when is_record(X, enum) -> - icenum:enum_gen(G, N, X, c); - (X) when is_record(X, typedef) -> - icstruct:struct_gen(G, N, X, c); - (X) when is_record(X, struct) -> - icstruct:struct_gen(G, N, X, c); - (X) when is_record(X, union) -> - icstruct:struct_gen(G, N, X, c); - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% Emit exec prototypes -%%------------------------------------------------------------ - -emit_exec_prototypes(G, Fd, N, Xs) -> - lists:foreach( - fun(X) when is_record(X, op) -> - {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), - emit(Fd, - "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env);\n", - [ScopedName, ic_util:to_undersc(N)]); - (X) when is_record(X, const) -> - emit_constant(G, N, X); - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% Emit restore typedefs -%%------------------------------------------------------------ - -emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_record(X, op) -> - %% Check if to use scoped call names - {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), - {RetType, ParTypes, _} = Types, - TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), - RT = mk_c_ret_type(G, N, RetType), - - PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X, - TypeAttrArgs)), - RPL = case PL of - "" -> - ""; - _PL -> - ", " ++ PL - end, - - case RT of - "void" -> - case PL of - "" -> - emit(Fd, "typedef void (*~s__rs(~s oe_obj, " - "CORBA_Environment *oe_env));\n", - [ScopedName, ic_util:to_undersc(N)]); - _ -> - emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s, " - "CORBA_Environment *oe_env));\n", - [ScopedName, ic_util:to_undersc(N), PL]) - end; - - "erlang_port*" -> - emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, " - "CORBA_Environment *oe_env));\n", - [ScopedName, ic_util:to_undersc(N), RT, RPL]); - - "erlang_pid*" -> - emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, " - "CORBA_Environment *oe_env));\n", - [ScopedName, ic_util:to_undersc(N), RT, RPL]); - - "erlang_ref*" -> - emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, " - "CORBA_Environment *oe_env));\n", - [ScopedName, ic_util:to_undersc(N), RT, RPL]); - - _ -> - case ictype:isArray(G, N, RetType) of - true -> - emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, " - "CORBA_Environment *oe_env));\n", - [ScopedName, ic_util:to_undersc(N), RT, RPL]); - false -> - emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s*~s, " - "CORBA_Environment *oe_env));\n", - [ScopedName, ic_util:to_undersc(N), RT, RPL]) - end - end, - emit_restore_typedefs(G, Fd, N, Xs); -emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_record(X, attr) -> - emit_restore_typedefs(G, Fd, N, Xs); -emit_restore_typedefs(G, Fd, N, [_X| Xs]) -> - emit_restore_typedefs(G, Fd, N, Xs); -emit_restore_typedefs(_G, _Fd, _N, []) -> ok. - - -%%------------------------------------------------------------ -%% Emit call-back prototypes -%%------------------------------------------------------------ - -emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) -> - %% Check scoped names XXX - {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), - {RetType, ParTypes, _} = Types, - TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), - RT = mk_c_ret_type(G, N, RetType), - - PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X, - TypeAttrArgs)), - CBPL = case PL of - "" -> - ""; - _PL -> - ", " ++ PL - end, - case RT of - "void" -> - case PL of - "" -> - emit(Fd, "~s__rs* ~s__cb(~s oe_obj, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ScopedName, ic_util:to_undersc(N)]); - _ -> - emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ScopedName, ic_util:to_undersc(N), PL]) - end; - "erlang_port*" -> - emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]); - - "erlang_pid*" -> - emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]); - - "erlang_ref*" -> - emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]); - - _ -> - case ictype:isArray(G, N, RetType) of - true -> - emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ScopedName, ic_util:to_undersc(N), RT, - CBPL]); - false -> - emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s*~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ScopedName, ic_util:to_undersc(N), RT, - CBPL]) - end - end, - emit_callback_prototypes(G, Fd, N, Xs); -emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) -> - emit_callback_prototypes(G, Fd, N, Xs); -emit_callback_prototypes(G, Fd, N, [_X| Xs]) -> - emit_callback_prototypes(G, Fd, N, Xs); -emit_callback_prototypes(_G, _Fd, _N, []) -> ok. - -%%------------------------------------------------------------ -%% Emit decoder prototypes -%%------------------------------------------------------------ - -emit_decoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) -> - %% Check if to use scoped call names - {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), - {_RetType, ParTypes, _} = Types, - TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), - case ic_util:mk_list(mk_par_list_for_decoder_prototypes(G, N, X, - TypeAttrArgs)) of - "" -> - ok; - PLFDP -> - emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment " - "*oe_env);\n", - [ScopedName, ic_util:to_undersc(N), PLFDP]) - end, - emit_decoder_prototypes(G, Fd, N, Xs); -emit_decoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) -> - emit_decoder_prototypes(G, Fd, N, Xs); -emit_decoder_prototypes(G, Fd, N, [_X| Xs]) -> - emit_decoder_prototypes(G, Fd, N, Xs); -emit_decoder_prototypes(_G, _Fd, _N, []) -> ok. - - -%%------------------------------------------------------------ -%% Emit encoder prototypes -%%------------------------------------------------------------ - -emit_encoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) -> - case ic_forms:is_oneway(X) of - true -> - emit_encoder_prototypes(G, Fd, N, Xs); - false -> - %% Check if to use scoped call names - {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), - {RetType, ParTypes, _} = Types, - TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), - RType = mk_c_ret_type(G, N, RetType), - case ic_util:mk_list(mk_par_list_for_encoder_prototypes( - G, N, X, TypeAttrArgs)) of - "" -> - case RType of - "void" -> - emit(Fd, "int ~s__enc(~s oe_obj, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ic_util:to_undersc(N)]); - _ -> - emit(Fd, "int ~s__enc(~s oe_obj, ~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ic_util:to_undersc(N), RType]) - end; - PLFEP -> - case RType of - "void" -> - emit(Fd, "int ~s__enc(~s oe_obj, ~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ic_util:to_undersc(N), PLFEP]); - _ -> - emit(Fd, "int ~s__enc(~s oe_obj, ~s, ~s, " - "CORBA_Environment *oe_env);\n", - [ScopedName, ic_util:to_undersc(N), RType, - PLFEP]) - end - end, - emit_encoder_prototypes(G, Fd, N, Xs) - end; -emit_encoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) -> - emit_encoder_prototypes(G, Fd, N, Xs); -emit_encoder_prototypes(G, Fd, N, [_X| Xs]) -> - emit_encoder_prototypes(G, Fd, N, Xs); -emit_encoder_prototypes(_G, _Fd, _N, []) -> ok. - -%%------------------------------------------------------------ -%% Emit operation mapping declaration -%%------------------------------------------------------------ - -emit_operation_mapping_declaration(G, Fd, N, Bodies) -> - Interface = ic_util:to_undersc(N), - Length = erlang:length(get_all_opnames(G, N, Bodies)), - emit(Fd, "\n/* Operation mapping */\n", []), - emit(Fd, "extern oe_map_t oe_~s_map;\n", [Interface]), - emit(Fd, "/* For backward compatibility */\n"), - emit(Fd, "#define ___~s_map___ oe_~s_map\n", - [Interface, Interface]), - case Length of - 0 -> - ok; - _ -> - emit(Fd, "extern oe_operation_t oe_~s_operations[];\n", - [Interface]), - emit(Fd, "/* For backward compatibility */\n"), - emit(Fd, "#define ___~s_operations___ oe_~s_operations\n", - [Interface, Interface]) - end. - - -%% Returns a list of {OpName, ScopedOpName} for all operations, where -%% OpName == ScopedOpName in case the `scoped_op_calls' option has -%% been set. -%% -get_all_opnames(G, N, Bodies) -> - ScNF = fun(X) -> - {ScName, _, _} = ic_cbe:extract_info(G, N, X), - ScName - end, - NF = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ScNF; - false -> - fun(X) -> ic_forms:get_id2(X) end - end, - Filter = fun(X) when is_record(X, op) -> - {true, {NF(X), ScNF(X)}}; - (_) -> - false - end, - %% zf == filtermap - lists:flatmap(fun({_, Xs}) -> lists:zf(Filter, Xs) end, Bodies). - -%%------------------------------------------------------------ -%% Emit switch -%%------------------------------------------------------------ - -emit_switch(G, Fd, N, _X) -> - emit(Fd, "#include <string.h>\n"), - case ic_options:get_opt(G, c_report) of - true -> - emit(Fd, "#ifndef OE_C_REPORT\n"), - emit(Fd, "#define OE_C_REPORT\n"), - emit(Fd, "#include <stdio.h>\n"), - emit(Fd, "#endif\n"); - _ -> - ok - end, - StartCode = - "#include \"ic.h\"\n" - "#include \"erl_interface.h\"\n" - "#include \"ei.h\"\n" - "#include \"~s__s.h\"\n\n" - "/*\n" - " * Main switch\n" - " */\n\n" - "int ~s__switch(~s oe_obj, CORBA_Environment *oe_env)\n" - "{\n" - " return oe_exec_switch(oe_obj, oe_env, &oe_~s_map);\n" - "}\n\n", - ScopedName = ic_util:to_undersc(N), - emit(Fd, StartCode, [ScopedName, ScopedName, ScopedName, ScopedName]). - -%%------------------------------------------------------------ -%% Emit server generic decoding. -%%------------------------------------------------------------ - -emit_server_generic_decoding(G, Fd, N) -> - UserProto = get_user_proto(G, oe), - Code = - "/*\n" - " * Returns call identity (left only for backward compatibility)\n" - " */\n\n" - "int ~s__call_info(~s oe_obj, CORBA_Environment *oe_env)\n" - "{\n" - " return ~s_prepare_request_decoding(oe_env);\n" - "}\n\n", - IName = ic_util:to_undersc(N), - emit(Fd, Code, [IName, IName, UserProto]). - -%%------------------------------------------------------------ -%% Emit dispatch -%%------------------------------------------------------------ - -emit_dispatch(G, Fd, N, Xs) -> - lists:foreach( - fun(X) when is_record(X, op) -> - {Name, ArgNames, Types} = ic_cbe:extract_info(G, N, X), - {RetType, ParTypes, _} = Types, - TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), - emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs), - emit_parameter_decoder(G, Fd, N, X, Name, RetType, TypeAttrArgs), - emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs); - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% Emit operation mapping -%%------------------------------------------------------------ - -emit_operation_mapping(G, Fd, N, Bodies) -> - OpNames = get_all_opnames(G, N, Bodies), - Interface = ic_util:to_undersc(N), - Length = erlang:length(OpNames), - emit(Fd, "\n/* Operation mapping */\n\n", []), - case Length of - 0 -> - emit(Fd, "oe_map_t oe_~s_map = { 0, NULL };\n\n", [Interface]); - _ -> - emit(Fd, "\noe_operation_t oe_~s_operations[~p] = {\n", - [Interface, Length]), - Members = lists:map( - fun({OpN, ScOpN}) -> - Name = ic_util:to_undersc([OpN]), - ScName = ic_util:to_undersc([ScOpN]), - io_lib:fwrite(" {~p, ~p, ~s__exec}", - [Interface, Name, ScName]) - end, OpNames), - emit(Fd, ic_util:join(Members, ",\n")), - emit(Fd, "};\n\n", []), - emit(Fd, "oe_map_t oe_~s_map = " - "{~p, oe_~s_operations};\n\n", - [Interface, Length, Interface]) - end. - -%%------------------------------------------------------------ -%% Emit constant -%%------------------------------------------------------------ - -emit_constant(G, N, ConstRecord) -> - case ic_genobj:is_hrlfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:hrlfiled(G), - CName = ic_util:to_undersc( - [ic_forms:get_id(ConstRecord#const.id)| N]), - UCName = ic_util:to_uppercase(CName), - - emit(Fd, "\n#ifndef __~s__\n", [UCName]), - emit(Fd, "#define __~s__\n\n", [UCName]), - - emit(Fd, "/* Constant: ~s */\n", [CName]), - - if is_record(ConstRecord#const.type, wstring) -> - %% If wstring, add 'L' - emit(Fd, "#define ~s L~p\n\n", [CName, - ConstRecord#const.val]); - true -> - emit(Fd, "#define ~s ~p\n\n", [CName, - ConstRecord#const.val]) - end, - - emit(Fd, "#endif\n\n") - end. - -%%------------------------------------------------------------ -%% Emit exec function -%%------------------------------------------------------------ - -emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs) -> - %% Decoding operation specific part - InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true; - ({_, _, _}) -> false - end, TypeAttrArgs), - ic_codegen:nl(Fd), - - emit(Fd, - "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env)\n" - "{\n", - [Name, ic_util:to_undersc(N)]), - - emit(Fd, " if (oe_env->_received != ~p) {\n", [length(InTypeAttrArgs)]), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, BAD_PARAM, " - "\"Wrong number of operation parameters\");\n"), - emit_c_dec_rpt(Fd, " ", "wrong number of parameters", []), - emit_c_dec_rpt(Fd, " ", "server exec ~s\\n====\\n", [Name]), - emit(Fd, " return -1;\n", []), - emit(Fd, " }\n"), - emit(Fd, " else {\n", []), - - case InTypeAttrArgs of - [] -> - true; - _ -> - emit(Fd, " int oe_error_code = 0;\n") - end, - - %% Callback variable definition - emit_variable_defs(G, Fd, N, X, Name, RetType, TypeAttrArgs), - - %% Call to parameter decoder - emit_parameter_decoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs), - - %% Callback to user code - emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs), - - %% Call to return message encoder - case ic_forms:is_oneway(X) of - true -> - true; - false -> - emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs) - end, - - %% Restore function call - emit_restore(G, Fd, N, X, Name, RetType, TypeAttrArgs), - - emit(Fd, " }\n return 0;\n}\n\n"). - -%%------------------------------------------------------------ -%% Emit parameter decoder -%%------------------------------------------------------------ - -emit_parameter_decoder(G, Fd, N, X, Name, _RetType, TypeAttrArgs) -> - %% Decoding operation specific part - InTypeAttrArgs = - lists:filter(fun({_, in, _}) -> true; - ({_, _, _}) -> false - end, TypeAttrArgs), - case InTypeAttrArgs of - [] -> - ok; - _ -> - case ic_util:mk_list(mk_par_list_for_decoder(G, N, X, - TypeAttrArgs)) of - "" -> - emit(Fd, "int ~s__dec(~s oe_obj, CORBA_Environment " - "*oe_env)\n{\n int oe_error_code;\n\n", - [Name, ic_util:to_undersc(N)]); - PLFD -> - emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment " - "*oe_env)\n{\n", - [Name, ic_util:to_undersc(N), PLFD]), - emit(Fd, " int oe_error_code;\n\n") - end, - - APars = [], % XXX Alloced parameters - foldl( - fun({{'void', _}, _, _}, _Acc) -> - ok; - ({T1, A1, N1}, Acc) -> - emit_one_decoding(G, N, Fd, T1, A1, N1, Acc) - end, APars, InTypeAttrArgs), - - emit(Fd, " return 0;\n}\n\n") - end. - -%%------------------------------------------------------------ -%% Emit one decoding -%%------------------------------------------------------------ - -emit_one_decoding(G, N, Fd, T1, A1, N1, AllocedPars) -> - IndOp = mk_ind_op(A1), - case ic_cbe:is_variable_size(G, N, T1) of - false -> - %% The last parameter "oe_outindex" is not used in - %% the static case but must be there anyhow. - emit_decoding_stmt(G, N, Fd, T1, - N1, "", "oe_env->_inbuf", 1, "&oe_outindex", - caller, AllocedPars), - ic_codegen:nl(Fd), - AllocedPars; - true -> - emit_encoding_comment(G, N, Fd, "Decode", IndOp, T1, N1), - emit(Fd, " {\n"), - emit(Fd, " int oe_size_count_index = oe_env->_iin;\n"), - emit(Fd, " int oe_malloc_size = 0;\n"), - emit(Fd, " void *oe_first = NULL;\n"), - ic_cbe:emit_malloc_size_stmt(G, N, Fd, T1, - "oe_env->_inbuf", 1, caller), - %% This is the only malloc call in this file - emit(Fd, - " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" - " if ((*~s = oe_first = " - "malloc(oe_malloc_size)) == NULL) {\n", [N1]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit(Fd, - " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "NO_MEMORY, \"Cannot malloc\");\n" - " return -1;\n" - " }\n"), - ParName = "*" ++ N1, % XXX Why not IndOp? - NAllocedPars = [ParName| AllocedPars], - case ictype:isArray(G, N, T1) of - true -> - emit_decoding_stmt(G, N, Fd, T1, - "(*" ++ IndOp ++ N1 ++ ")", "", - "oe_env->_inbuf", 1, "&oe_outindex", - array_dyn, NAllocedPars); - false -> - emit_decoding_stmt(G, N, Fd, T1, - "(*" ++ IndOp ++ N1 ++ ")", "", - "oe_env->_inbuf", 1, "&oe_outindex", - caller_dyn, NAllocedPars) - end, - emit(Fd, " }\n\n"), - NAllocedPars - end. - -%%------------------------------------------------------------ -%% Emit message encoder -%%------------------------------------------------------------ - -emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs) -> - case ic_forms:is_oneway(X) of - false -> - %% Encoding operation specific part - emit(Fd, - "\nint ~s__enc(~s oe_obj", - [Name, ic_util:to_undersc(N)]), - RType = mk_c_ret_type(G, N, RetType), - ParList = mk_par_list_for_encoder(G, N, X, TypeAttrArgs), - case ic_util:mk_list(ParList) of - "" -> - case RType of - "void" -> - emit(Fd, ", CORBA_Environment *oe_env)\n{"); - _ -> - emit(Fd, ", ~s oe_return, CORBA_Environment " - "*oe_env)\n{", [RType]) - end; - PLFD -> - case RType of - "void" -> - emit(Fd, ", ~s, CORBA_Environment " - "*oe_env)\n{", [PLFD]); - _ -> - emit(Fd, ", ~s oe_return~s, CORBA_Environment " - "*oe_env)\n{", [RType, ", " ++ PLFD]) - end - end, - - - emit(Fd, "\n"), - emit(Fd, " int oe_error_code;\n\n"), - UserProto = get_user_proto(G, oe), - emit(Fd, " ~s_prepare_reply_encoding(oe_env);\n", [UserProto]), - - OutTypeAttrArgs = - lists:filter(fun({_, out, _}) -> true; - ({_, _, _}) -> false - end, TypeAttrArgs), - - OutLength = length(OutTypeAttrArgs), - case OutLength > 0 of - false -> - ic_codegen:nl(Fd); - true -> - emit(Fd, " oe_ei_encode_tuple_header(oe_env, ~p);\n\n", - [OutLength+1]) - - end, - - emit_encoding_comment(G, N, Fd, "Encode", "", RetType, - "oe_return"), - emit_encoding_stmt(G, N, X, Fd, RetType, "oe_return"), - - foreach(fun({T1, _A1, N1}) -> - case T1 of - {'void', _} -> - ok; - _ -> - emit_encoding_comment(G, N, Fd, "Encode", - "", T1, N1), - emit_encoding_stmt(G, N, X, Fd, T1, N1) - end - end, OutTypeAttrArgs), - emit(Fd, " return 0;\n}\n\n"); - _ -> - %% Oneway - ok - end. - -%%------------------------------------------------------------ -%% Emit message encoder call -%%------------------------------------------------------------ - -emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs) -> - emit(Fd, " /* Encoding reply message */\n"), - RType = mk_c_ret_type(G, N, RetType), - case ic_util:mk_list(mk_enc_par_list(G, N, X, TypeAttrArgs)) of - "" -> - case RType of - "void" -> - emit(Fd, " ~s(oe_obj, oe_env);\n", - [Name ++ "__enc"]); - "erlang_pid*" -> - emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n", - [Name ++ "__enc"]); - "erlang_port*" -> - emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n", - [Name ++ "__enc"]); - "erlang_ref*" -> - emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n", - [Name ++ "__enc"]); - _ -> - emit(Fd, " ~s(oe_obj, oe_return, oe_env);\n", - [Name ++ "__enc"]) - end; - - PLFE -> - case RType of - "void" -> - emit(Fd, " ~s(oe_obj, ~s, oe_env);\n", - [Name ++ "__enc", PLFE]); - "erlang_pid*" -> - emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n", - [Name ++ "__enc", PLFE]); - "erlang_port*" -> - emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n", - [Name ++ "__enc", PLFE]); - "erlang_ref*" -> - emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n", - [Name ++ "__enc", PLFE]); - _ -> - emit(Fd, " ~s(oe_obj, oe_return, ~s, oe_env);\n", - [Name ++ "__enc", PLFE]) - end - end, - ic_codegen:nl(Fd). - -%%------------------------------------------------------------ -%% Emit parameter decoding call -%%------------------------------------------------------------ - -emit_parameter_decoder_call(G, Fd, N, X, Name, _R, TypeAttrArgs) -> - case ic_util:mk_list(mk_dec_par_list(G, N, X, TypeAttrArgs)) of - "" -> %% No parameters ! skip it ! - ok; - PLFDC -> - ParDecName = Name ++ "__dec", - emit(Fd, - " /* Decode parameters */\n" - " if((oe_error_code = ~s(oe_obj, ~s, oe_env)) < 0) {\n", - [ParDecName, PLFDC]), - emit_c_dec_rpt(Fd, " ", "parmeters", []), - emit(Fd, - " if(oe_env->_major == CORBA_NO_EXCEPTION)\n" - " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad parameter on decode\");\n" - " return oe_error_code;\n }\n\n") - end. - -%%------------------------------------------------------------ -%% Emit call-back -%%------------------------------------------------------------ - -emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs) -> - CallBackName = Name ++ "__cb", - emit(Fd, " /* Callback function call */\n"), - PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)), - case ic_forms:is_oneway(X) of - true -> - case PL of - "" -> - emit(Fd, " oe_restore = ~s(oe_obj, oe_env);\n\n", - [CallBackName]); - _ -> - emit(Fd, " oe_restore = ~s(oe_obj, ~s, oe_env);\n\n", - [CallBackName, PL]) - end; - false -> - CBPL = case PL of - "" -> - ""; - _PL -> - ", " ++ PL - end, - case mk_c_ret_type(G, N, RetType) of - "void" -> - case PL of - "" -> - emit(Fd, " oe_restore = ~s(oe_obj, oe_env);" - "\n\n", [CallBackName]); - _ -> - emit(Fd, " oe_restore = ~s(oe_obj, ~s, oe_env);" - "\n\n", [CallBackName, PL]) - end; - _ -> - case ictype:isArray(G, N, RetType) of - true -> - emit(Fd, - " oe_restore = ~s(oe_obj, oe_return~s, " - " oe_env);\n\n", [CallBackName, CBPL]); - false -> - emit(Fd, " oe_restore = ~s(oe_obj, " - "&oe_return~s, oe_env);\n\n", - [CallBackName, CBPL]) - end - end - end. - -%%------------------------------------------------------------ -%% Emit restore -%%------------------------------------------------------------ - -emit_restore(G, Fd, N, X, _Name, RetType, TypeAttrArgs) -> - emit(Fd, " /* Restore function call */\n"), - emit(Fd, " if (oe_restore != NULL)\n"), - PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)), - case ic_forms:is_oneway(X) of - true -> - case PL of - "" -> - emit(Fd, " (*oe_restore)(oe_obj, oe_env);\n\n"); - _ -> - emit(Fd, " (*oe_restore)(oe_obj, ~s, oe_env);\n\n", - [PL]) - end; - false -> - RPL = case PL of - "" -> - ""; - _PL -> - ", " ++ PL - end, - case mk_c_ret_type(G, N, RetType) of - "void" -> - case PL of - "" -> - emit(Fd, " (*oe_restore)(oe_obj, oe_env);" - "\n\n"); - _ -> - emit(Fd, " (*oe_restore)(oe_obj, ~s, oe_env);" - "\n\n", [PL]) - end; - _ -> - case ictype:isArray(G, N, RetType) of - true -> - emit(Fd, - " (*oe_restore)(oe_obj, oe_return~s, " - " oe_env);\n\n", [RPL]); - false -> - emit(Fd, " (*oe_restore)(oe_obj, " - "&oe_return~s, oe_env);\n\n", [RPL]) - end - end - end. - -%%------------------------------------------------------------ -%% Emit variable defs -%%------------------------------------------------------------ - -emit_variable_defs(G, Fd, N, X, _Name, RetType, TypeAttrArgs) -> - {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), - emit(Fd, " ~s__rs* oe_restore = NULL;\n", [ScopedName]), - RestVars = mk_var_list(mk_var_decl_list(G, N, X, TypeAttrArgs)), - case ic_forms:is_oneway(X) of - true -> - emit(Fd, "~s\n\n", [RestVars]); - false -> - RType = mk_c_ret_type(G, N, RetType), - case RType of - "void" -> - emit(Fd, "~s\n\n", [RestVars]); - "CORBA_unsigned_long" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_unsigned_long_long" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_unsigned_short" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_short" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_long" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_long_long" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_float" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_double" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_char" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_wchar" -> %% WCHAR - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_boolean" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - "CORBA_octet" -> - emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]); - _ -> - case ic_cbe:is_variable_size(G, N, RetType) of - true -> - emit(Fd, "~s ~s oe_return;\n\n", - [RestVars, RType]); - false -> - TK = ic_forms:get_tk(X), - case TK of - {tk_enum, _, _, _List} -> - emit(Fd, "~s ~s oe_return;\n\n", - [RestVars, RType]); - _ -> - case RType of - "erlang_binary*" -> - emit(Fd, "~s erlang_binary " - "oe_return;\n\n", [RestVars]); - "erlang_pid*" -> - emit(Fd, "~s erlang_pid " - "oe_return;\n\n", [RestVars]); - "erlang_port*" -> - emit(Fd, "~s erlang_port " - "oe_return;\n\n", [RestVars]); - "erlang_ref*" -> - emit(Fd, "~s erlang_ref " - "oe_return;\n\n", [RestVars]); - _ -> - %% Structures are - %% initiated by memset - emit(Fd, "~s ~s " - "oe_return;\n\n", - [RestVars, RType]) - end, - emit(Fd, " memset(&oe_return, 0, " - "sizeof(oe_return));\n\n") - end - end - end - end. - -%%------------------------------------------------------------ -%% Make variable list -%%------------------------------------------------------------ - -%% XXX Modify -mk_var_list([]) -> - ""; -mk_var_list([Arg| Args]) -> - " " ++ Arg ++ ";\n" ++ mk_var_list(Args). - -%%------------------------------------------------------------ -%% Make return type -%%------------------------------------------------------------ - -mk_c_ret_type(G, N, Type) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "*"; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> %% WSTRING - "*"; - Ctype == "CORBA_wchar *" -> %% WSTRING - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" - end - end; - false -> - if - Ctype == "erlang_pid" -> - "*"; - Ctype == "erlang_port" -> - "*"; - Ctype == "erlang_ref" -> - "*"; - true -> - "" - end - end, - Ctype ++ Dyn. - -%%------------------------------------------------------------ -%% Make call-back parameter list -%%------------------------------------------------------------ - -mk_cb_par_list(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], TypeAttrArgs0), - lists:map( - fun({Type, Attr, Arg}) -> - case ic_cbe:is_variable_size(G, N, Type) of - true -> - case Attr of - in -> - Arg; - out -> - case ictype:isArray(G, N, Type) of - true -> - Arg; - _ -> - "&" ++ Arg - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - Arg; - _ -> - "&" ++ Arg - end - end - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make decoder parameter list -%%------------------------------------------------------------ - -mk_dec_par_list(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], - TypeAttrArgs0), - lists:map( - fun({Type, _Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "&" ++ Arg; - Ctype == "CORBA_char *" -> - Arg; - is_record(Type, wstring) -> - "&" ++ Arg; - Ctype == "CORBA_wchar *" -> - Arg; - true -> - "&" ++ Arg - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - Arg; - _ -> - "&" ++ Arg - end - end - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make encoder parameter list -%%------------------------------------------------------------ - -mk_enc_par_list(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], - TypeAttrArgs0), - lists:map( - fun({Type, _Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - case Ctype of - "erlang_pid" -> - "&" ++ Arg; - "erlang_port" -> - "&" ++ Arg; - "erlang_ref" -> - "&" ++ Arg; - _ -> - Arg - end - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make type argument list -%%------------------------------------------------------------ - -mk_type_attr_arg_list(Types, Args) -> - filterzip( - fun(Type, {Attr, Arg}) -> - {true, {Type, Attr, Arg}} - end, Types, Args). - -%%------------------------------------------------------------ -%% Filter type argument list -%%------------------------------------------------------------ - -filter_type_attr_arg_list(G, X, InOrOut, TypeAttrArgs) -> - lists:filter( - - fun({_Type, inout, Arg}) -> - ic_error:error(G, {inout_spec_for_c, X, Arg}), - false; - ({_Type, Attr, _Arg}) -> - lists:member(Attr, InOrOut) - end, TypeAttrArgs). - -%%------------------------------------------------------------ -%% Make indirection operator -%%------------------------------------------------------------ - -mk_ind_op(in) -> - ""; -mk_ind_op(inout) -> - error; -mk_ind_op(_) -> - "*". - -%%------------------------------------------------------------ -%% Make parameter list for decoder -%%------------------------------------------------------------ - -mk_par_list_for_decoder(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0), - lists:map( - fun({Type, Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "**"; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> %% WSTRING - "**"; - Ctype == "CORBA_wchar *" -> %% WSTRING - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - slice(Attr) ++ "*"; - _ -> - "**" - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" - end - end, - Ctype ++ Dyn ++ " " ++ Arg - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make parameter list for encoder -%%------------------------------------------------------------ - -mk_par_list_for_encoder(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0), - lists:map( - fun({Type, _Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "*"; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> %% WSTRING - "*"; - Ctype == "CORBA_wchar *" -> %% WSTRING - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" - end - end; - false -> - if - Ctype == "erlang_pid" -> - "*"; - Ctype == "erlang_port" -> - "*"; - Ctype == "erlang_ref" -> - "*"; - true -> - "" - end - end, - Ctype ++ " " ++ Dyn ++ Arg - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make parameter list for decoder prototypes -%%------------------------------------------------------------ - -mk_par_list_for_decoder_prototypes(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0), - lists:map( - fun({Type, Attr, _Arg}) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "**"; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> %% WSTRING - "**"; - Ctype == "CORBA_wchar *" -> %% WSTRING - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - slice(Attr) ++ "*"; - _ -> - "**" - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" - end - end, - Ctype ++ Dyn - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make parameter list for encoder prototypes -%%------------------------------------------------------------ - -mk_par_list_for_encoder_prototypes(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0), - lists:map( - fun({Type, _Attr, _Arg}) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "*"; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> %% WSTRING - "*"; - Ctype == "CORBA_wchar *" -> %% WSTRING - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" - end - end; - false -> - if - Ctype == "erlang_pid" -> - "*"; - Ctype == "erlang_port" -> - "*"; - Ctype == "erlang_ref" -> - "*"; - true -> - "" - end - end, - Ctype ++ Dyn - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make parameter list for call-back prototypes -%%------------------------------------------------------------ - -mk_par_list_for_callback_prototypes(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], - TypeAttrArgs0), - lists:map( - fun({Type, Attr, _Arg}) -> - IndOp = mk_ind_op(Attr), - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "*" ++ IndOp; - Ctype == "CORBA_char *" -> - "" ++ IndOp; - is_record(Type, wstring) -> %% WSTRING - "*" ++ IndOp; - Ctype == "CORBA_wchar *" -> %% WSTRING - "" ++ IndOp; - true -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" ++ IndOp - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - case Attr of %% Should just be IndOp - in -> - "*" ++ IndOp; - out -> - IndOp - end - end - end, - Ctype ++ Dyn - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make variable declaration list -%%------------------------------------------------------------ - -mk_var_decl_list(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], - TypeAttrArgs0), - lists:map( - fun({Type, Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - VarDecl = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - Ctype ++ "* " ++ Arg ++ " = NULL"; - Ctype == "CORBA_char *" -> - Ctype ++ " " ++ Arg ++ " = NULL"; - is_record(Type, wstring) -> %% WSTRING - Ctype ++ "* " ++ Arg ++ " = NULL"; - Ctype == "CORBA_wchar *" -> %% WSTRING - Ctype ++ " " ++ Arg ++ " = NULL"; - true -> - case ictype:isArray(G, N, Type) of - true -> - Ctype ++ slice(Attr) ++ " " ++ - Arg; - _ -> - Ctype ++ "* " ++ Arg - end - end; - false -> - Ctype ++ " " ++ Arg - end, - - VarDecl - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Slice -%%------------------------------------------------------------ - -slice(in) -> - "_slice*"; -slice(_) -> - "". - -%%------------------------------------------------------------ -%% Special comment functions -%%------------------------------------------------------------ - -emit_encoding_comment(G, N, F, String, RefOrVal, Type, Name) -> - emit(F, [io_lib:format(" /* ~s parameter: ~s~s ~s */\n", - [String, mk_c_type(G, N, Type), - RefOrVal, Name])]). - - -%%------------------------------------------------------------ -%% Make C type -%%------------------------------------------------------------ - -%% -%% Warning this is NOT identical to mk_c_type in ic_cbe.erl -%% -mk_c_type(G, N, S) -> - mk_c_type(G, N, S, evaluate). - -mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - {enum, Type} -> - mk_c_type(G, N, Type, evaluate); - Type -> - mk_c_type(G, N, Type, evaluate) - end; -mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - Type -> - Type - end; -mk_c_type(_G, _N, S, _) when is_list(S) -> - S; -mk_c_type(_G, _N, S, _) when is_record(S, string) -> - "CORBA_char"; -mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> %% WSTRING - "CORBA_wchar"; -mk_c_type(_G, _N, {boolean, _}, _) -> - "CORBA_boolean"; -mk_c_type(_G, _N, {octet, _}, _) -> - "CORBA_octet"; -mk_c_type(_G, _N, {void, _}, _) -> - "void"; -mk_c_type(_G, _N, {unsigned, U}, _) -> - case U of - {short, _} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_unsigned_long"; - {'long long', _} -> - "CORBA_unsigned_long_long" - end; -mk_c_type(_G, _N, {'long long', _}, _) -> - "CORBA_long_long"; -mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type - "CORBA_long"; -mk_c_type(_G, _N, {T, _}, _) -> - "CORBA_" ++ atom_to_list(T). - -%%------------------------------------------------------------ -%% Emit encoding statement -%%------------------------------------------------------------ - -%% emit_encoding_stmt(G, N, X, Fd, T, LName) -%% -%% -emit_encoding_stmt(G, N, X, Fd, T, LName) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", - [LName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", - [LName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", - [LName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", - [LName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []), - emit(Fd, " return oe_error_code;\n }\n"); - {enum, FSN} -> - emit_encoding_stmt(G, N, X, Fd, FSN, LName); - FSN -> - emit_encoding_stmt(G, N, X, Fd, FSN, LName) - end; -emit_encoding_stmt(G, N, X, Fd, T, LName) when is_list(T) -> - %% Already a fullscoped name - case get_param_tk(LName, X) of - error -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), T, LName]); - ParamTK -> - case ic_cbe:is_variable_size(ParamTK) of - true -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0)" - " {\n", - [ic_util:mk_oe_name(G, "encode_"), T, LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");" - "\n"), - ?emit_c_enc_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n }\n\n"); - false -> - if is_atom(ParamTK) -> - case ParamTK of - tk_ushort -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulong(oe_env, " - "(unsigned long) ~s)) < 0) {\n", - [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "ushort", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_ulong -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulong(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "ulong", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_ulonglong -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulonglong(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "ulonglong", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_short -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, " - "(long) ~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "short", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_long -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "long", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_longlong -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_longlong(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "longlong", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_float -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_double(oe_env, " - "(double) ~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "float", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_double -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_double(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "double", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_boolean -> - emit(Fd, " switch(~s) {\n", [LName]), - emit(Fd, " case 0 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, " - "\"false\")) < 0) {\n"), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " return " - "oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, " - "\"true\")) < 0) {\n"), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " return " - "oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default :\n"), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n\n"); - tk_char -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_char(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "char", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_wchar -> %% WCHAR - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_wchar(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "wchar", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_octet -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_char(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "octet", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_any -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "any", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - _ -> - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "tk_unknown", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"), - ok - end; - true -> - case element(1, ParamTK) of - tk_enum -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "enum", []); - tk_array -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "array", []); - _ -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, &~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "", []) - end, - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n") - end - end - end; -emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, string) -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_string(oe_env, (const char*) ~s)) < 0) {\n", - [LName]), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Cannot encode string\");\n"), - ?emit_c_enc_rpt(Fd, " ", "string", []), - emit(Fd, " return oe_error_code;\n }\n\n"); -emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, wstring) -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "wstring", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Cannot encode string\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); -emit_encoding_stmt(G, N, _X, Fd, T, LName) -> - case T of - {unsigned, {short, _}} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulong(oe_env, (unsigned long) ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "ushort", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {unsigned, {long, _}} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulong(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "ulong", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {unsigned, {'long long', _}} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulonglong(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "ulonglong", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {short, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, (long) ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "short", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {long, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "long", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {'long long', _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_longlong(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "longlong", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {float, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_double(oe_env, (double) ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "float", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {double, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_double(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "double", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {boolean, _} -> - emit(Fd, " switch(~s) {\n", [LName]), - emit(Fd, " case 0 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default :\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n\n"); - {char, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_char(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "char", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {wchar, _} -> %% WCHAR - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_wchar(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "wchar", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {octet, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_char(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "octet", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {void, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, \"void\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "void", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {sequence, _, _} -> - ?emit_c_enc_rpt(Fd, " ", "sequence", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {any, _} -> %% Fix for any type - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "any", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%%------------------------------------------------------------ -%% Get type kind parameter -%%------------------------------------------------------------ - -%% Useful functions -get_param_tk("oe_return", Op) -> - ic_forms:get_tk(Op); -get_param_tk(Name, Op) -> - case get_param(Name, Op) of - error -> - error; - Param -> - ic_forms:get_tk(Param) - end. - -%%------------------------------------------------------------ -%% Get parameter (for what? XXX) -%%------------------------------------------------------------ - -get_param(Name, Op) when is_record(Op, op) -> - get_param_loop(Name, Op#op.params); -get_param(_Name, _Op) -> - error. - -get_param_loop(_Name, []) -> - error; -get_param_loop(Name, [Param| Params]) -> - case ic_forms:get_id2(Param) of - Name -> - Param; - _ -> - get_param_loop(Name, Params) - end. - -%%------------------------------------------------------------ -%% Emit decoding statement -%%------------------------------------------------------------ - -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos, - DecType, AllocedPars) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = ei_decode_port(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n\n"); - "ETERM*" -> - emit(Fd, " if ((oe_error_code = ei_decode_term(~s, " - "&oe_env->_iin, (void**)~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n\n"); - {enum, FSN} -> - emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, - InBuffer, Align, NextPos, DecType, AllocedPars); - FSN -> - emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, - InBuffer, Align, NextPos, DecType, AllocedPars) - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, - DecType, AllocedPars) when is_list(T) -> - %% Already a fullscoped name - Type = ictype:name2type(G, T), - case ictype:isBasicType(Type) of - true -> - emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, - LName, AllocedPars); - false -> - emit(Fd, " {\n"), - case DecType of - caller -> %% No malloc used, define oe_first anyhow. - emit(Fd, " void *oe_first = NULL;\n"), - emit(Fd, " int oe_outindex = 0;\n\n"); - array_dyn -> %% Malloc used - emit(Fd, " int oe_outindex = 0;\n\n"); - %% [ic_util:mk_align(io_lib:format("sizeof(~s)", [T]))]); - caller_dyn -> %% Malloc used - emit(Fd, " int oe_outindex = 0;\n\n") - end, - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, " - "~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n") - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - _DecType, AllocedPars) when is_record(T, string) -> - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - _DecType, AllocedPars) when is_record(T, wstring) -> - %% WSTRING - emit(Fd, " if ((oe_error_code = " - "oe_ei_decode_wstring(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n\n"), - emit(Fd, " }\n"); -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - _DecType, AllocedPars) -> - case ic_cbe:normalize_type(T) of - {basic, Type} -> - emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, - LName, AllocedPars); - _ -> - case T of - {void, _} -> - emit(Fd, - " if ((oe_error_code = ei_decode_atom(~s, " - "&oe_env->_iin, 0)) < 0) {\n", - [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - {sequence, _, _} -> - %% XXX XXX Why? - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n\n"); - {any, _} -> %% Fix for any type - emit(Fd, - " if ((oe_error_code = ei_decode_long(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n\n"), - emit(Fd, " }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end - end. - -emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, - LName, AllocedPars) -> - Fmt = - " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, " - "~s~s)) < 0) {\n", - Ret = - " return oe_error_code;\n" - "}\n", - - {Pre, DecType} = - case Type of - ushort -> {"", "ulong"}; - ulong -> {"", "ulong"}; - ulonglong -> {"oe_", "ulonglong"}; - short -> {"", "long"}; - long -> {"", "long"}; - longlong -> {"oe_", "longlong"}; - float -> {"", "double"}; - double -> {"", "double"}; - boolean -> {"", "atom"}; - char -> {"", "char"}; - wchar -> {"oe_", "wchar"}; - octet -> {"", "char"}; - any -> {"", "long"} - end, - case Type of - ushort -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, " - "&oe_env->_iin, &oe_ulong)) < 0) {\n", [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "ushort", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *~s = (unsigned short) oe_ulong;\n", [LName]), - emit(Fd, " }\n\n"); - short -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " - "&oe_env->_iin, &oe_long)) < 0) {\n", [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "short", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *~s = (short) oe_long;\n", [LName]), - emit(Fd, " }\n\n"); - float -> - emit(Fd, " {\n"), - emit(Fd, " double oe_double;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_double(~s, " - "&oe_env->_iin, &oe_double)) < 0) {\n", [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "float", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *~s = (float) oe_double;\n", [LName]), - emit(Fd, " }\n\n"); - boolean -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " - "&oe_env->_iin, oe_bool)) < 0) {\n", [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "boolean", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " *(~s) = 0;\n", [LName]), - emit(Fd, " }\n"), - emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " *(~s) = 1;\n", [LName]), - emit(Fd, " } else {\n"), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "boolean", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n\n"); - _ -> - emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit(Fd, Ret) - end. - - -%%------------------------------------------------------------ -%% Prefix for generic functions -%%------------------------------------------------------------ -get_user_proto(G, Default) -> - case ic_options:get_opt(G, user_protocol) of - false -> - Default; - Pfx -> - Pfx - end. - -%%------------------------------------------------------------ -%% Timeout. Returns a string (or Default). -%%------------------------------------------------------------ -get_c_timeout(G, Default) -> - case ic_options:get_opt(G, c_timeout) of - Tmo when is_integer(Tmo) -> - TmoStr = integer_to_list(Tmo), - {TmoStr, TmoStr}; - {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) -> - {integer_to_list(SendTmo), integer_to_list(RecvTmo)}; - false -> - Default - end. - -%%------------------------------------------------------------ -%% ZIPPERS (merging of successive elements of two lists). -%%------------------------------------------------------------ - -%% zip([H1| T1], [H2| T2]) -> -%% [{H1, H2}| zip(T1, T2)]; -%% zip([], []) -> -%% []. - -filterzip(F, [H1| T1], [H2| T2]) -> - case F(H1, H2) of - false -> - filterzip(F, T1, T2); - {true, Val} -> - [Val| filterzip(F, T1, T2)] - end; -filterzip(_, [], []) -> - []. - - diff --git a/lib/ic/src/ic_debug.hrl b/lib/ic/src/ic_debug.hrl deleted file mode 100644 index 97a56743d8..0000000000 --- a/lib/ic/src/ic_debug.hrl +++ /dev/null @@ -1,38 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - -%%---------------------------------------------------------------------- -%% Debug macro -%%---------------------------------------------------------------------- --ifndef(ic_debug_hrl). --define(ic_debug_hrl, true). - --ifdef(debug). - -define(PRINTDEBUG(Msg), - io:format("~p :~p ~p~n", [Msg, ?FILE, ?LINE])). - -define(PRINTDEBUG2(F, A), - io:format(F ++ ":~p ~p~n", A ++ [?FILE, ?LINE])). --else. - -define(PRINTDEBUG(Msg), ok). - -define(PRINTDEBUG2(F, A), ok). --endif. - --endif. diff --git a/lib/ic/src/ic_enum_java.erl b/lib/ic/src/ic_enum_java.erl deleted file mode 100644 index dbfa110089..0000000000 --- a/lib/ic/src/ic_enum_java.erl +++ /dev/null @@ -1,313 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - --module(ic_enum_java). - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: gen/3 -%%----------------------------------------------------------------- -gen(G, N, X) when is_record(X, enum) -> - %%?PRINTDEBUG2("enum: ~p", [X]), - EnumName = ic_forms:get_java_id(X), - N2 = ["_" ++ EnumName |N], - ic_jbe:gen(G, N2, ic_forms:get_body(X)), - - emit_enum_class(G, N, X, EnumName), - emit_holder_class(G, N, X, EnumName), - emit_helper_class(G, N, X, EnumName); -gen(_G, _N, _X) -> - ok. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: emit_enum_class/4 -%%----------------------------------------------------------------- -emit_enum_class(G, N, X, EnumName) -> - {Fd, _} = ic_file:open_java_file(G, N, EnumName), - - EList = enum_member_name_list(G, N, X), - %%?PRINTDEBUG2("EList: ~p", [EList]), - ic_codegen:emit(Fd, ["final public class ",EnumName," {\n\n" - - " // instance variables\n"]), - - emit_enum_member_int_values_initialization(G, N, X, Fd, EList), - emit_enum_public_instance_variables(G, N, X, Fd, EnumName, EList), - - ic_codegen:emit(Fd, [" private int _value;\n\n" - - " // constructors\n" - " private ",EnumName,"(int __value) {\n" - " _value = __value;\n" - " }\n\n" - - " // methods\n" - " public int value() {\n" - " return _value;\n" - " }\n"]), - - emit_enum_from_int_function(G, N, X, Fd, EnumName, EList), - - ic_codegen:emit(Fd, "\n}\n"), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, _X, EnumName) -> - EName = string:concat(EnumName, "Holder"), - {Fd, _} = ic_file:open_java_file(G, N, EName), - - ic_codegen:emit(Fd, ["final public class ",EnumName,"Holder {\n\n" - - " // instance variables\n" - " public ",EnumName," value;\n\n" - - " // constructors\n" - " public ",EnumName,"Holder() {}\n\n" - - " public ",EnumName,"Holder(",EnumName," initial) {\n" - " value = initial;\n" - " }\n\n" - - " // methods\n" - " public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception {\n" - " ",EnumName,"Helper.marshal(out, value);\n" - " }\n\n" - - " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" - " value = ",EnumName,"Helper.unmarshal(in);\n" - " }\n\n" - "}\n"]), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_helper_class/4 -%%----------------------------------------------------------------- -emit_helper_class(G, N, X, EnumName) -> - EName = string:concat(EnumName, "Helper"), - WEList = enum_member_atom_list(G, N, X), - {Fd, _} = ic_file:open_java_file(G, N, EName), - - ic_codegen:emit(Fd, ["public class ",EnumName,"Helper {\n\n" - - " // constructors\n" - " private ",EnumName,"Helper() {}\n\n" - - " // methods\n" - - " public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",EnumName," _value)\n" - " throws java.lang.Exception {\n\n"]), - - emit_enum_write_function(G, N, X, Fd, EnumName), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static ",EnumName," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in)\n" - " throws java.lang.Exception {\n\n"]), - - emit_enum_read_function(G, N, X, Fd, EnumName), - - ic_codegen:emit(Fd, "\n }\n\n"), - - emit_enum_private_member_variables(Fd, WEList), - - ic_codegen:emit(Fd, ["\n // Get integer value of enum from string\n" - " private static int _getIntFromName(String name) throws java.lang.Exception {\n" - " for(int i = 0; i < _memberCount; i++) {\n" - " if (name.equals(_members[i]))\n" - " return i;\n" - " }\n" - " throw new java.lang.Exception(\"\");\n" - " }\n\n" - - " public static String id() {\n" - " return \"",ictk:get_IR_ID(G, N, X),"\";\n" - " }\n\n" - - " public static String name() {\n" - " return \"",EnumName,"\";\n" - " }\n\n"]), - - ic_jbe:emit_type_function(G, N, X, Fd), - - ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",EnumName," _this)\n" - " throws java.lang.Exception {\n\n" - - " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" - " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" - - " _any.type(type());\n" - " marshal(_os, _this);\n" - " _any.insert_Streamable(_os);\n" - " }\n\n" - - " public static ",EnumName," extract(",?ICPACKAGE,"Any _any)\n" - " throws java.lang.Exception {\n\n" - - " return unmarshal(_any.extract_Streamable());\n" - " }\n\n" - - "}\n"]), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_enum_public_instance_variables/6 -%%----------------------------------------------------------------- -emit_enum_public_instance_variables(_G, _N, _X, _Fd, _EnumName, []) -> - ok; -emit_enum_public_instance_variables(G, N, X, Fd, EnumName, [Enumerator |EList]) -> - ic_codegen:emit(Fd, [" public static final ",EnumName," ",Enumerator," = new ",EnumName,"(_",Enumerator,");\n"]), - emit_enum_public_instance_variables(G, N, X, Fd, EnumName, EList). - -%%----------------------------------------------------------------- -%% Func: emit_enum_member_int_values_initialization/5 -%%----------------------------------------------------------------- -emit_enum_member_int_values_initialization(G, N, X, Fd, EList) -> - InitString = emit_enum_member_int_values_initialization_1(G, N, X, Fd, EList, 0), - ic_codegen:emit(Fd, [" public static final int ",InitString,";\n"]). - - -%%----------------------------------------------------------------- -%% Func: emit_enum_member_int_values_initialization_1/6 -%%----------------------------------------------------------------- -emit_enum_member_int_values_initialization_1(_G, _N, _X, _Fd, [Enumerator], Num) -> - " _" ++ Enumerator ++ " = " ++ ic_util:to_list(Num); -emit_enum_member_int_values_initialization_1(G, N, X, Fd, [Enumerator |EList], Num) -> - Spaces = if - Num == 0 -> - ""; - true -> - " " - end, - Spaces ++ "_" ++ Enumerator ++ " = " ++ ic_util:to_list(Num) ++ ",\n" ++ - emit_enum_member_int_values_initialization_1(G, N, X, Fd, EList, Num + 1). - -%%----------------------------------------------------------------- -%% Func: emit_enum_from_int_function/6 -%%----------------------------------------------------------------- -emit_enum_from_int_function(_G, _N, _X, Fd, EnumName, EList) -> - ic_codegen:emit(Fd, - [" public static final ",EnumName," from_int(int __value) throws java.lang.Exception {\n" - " switch (__value) {\n"]), - emit_enum_from_int_function_switchbody(Fd, EList), - ic_codegen:emit(Fd, [" }\n" - " }\n"]). - -%%----------------------------------------------------------------- -%% Func: emit_enum_from_int_function_switchbody/2 -%%----------------------------------------------------------------- -emit_enum_from_int_function_switchbody(Fd, []) -> - ic_codegen:emit(Fd, [" default:\n" - " throw new java.lang.Exception(\"\");\n"]); -emit_enum_from_int_function_switchbody(Fd, [Enumerator |EList]) -> - ic_codegen:emit(Fd, [" case _",Enumerator,":\n" - " return ",Enumerator,";\n"]), - emit_enum_from_int_function_switchbody(Fd, EList). - -%%----------------------------------------------------------------- -%% Func: emit_enum_private_member_variables/2 -%%----------------------------------------------------------------- -emit_enum_private_member_variables(Fd, EList) -> - ic_codegen:emit(Fd, [" private static final int _memberCount = ",integer_to_list(length(EList)),";\n" - " private static String[] _members = {\n"]), - emit_enum_private_member_variables_1(Fd, EList), - ic_codegen:emit(Fd, " };\n"). - -%%----------------------------------------------------------------- -%% Func: emit_enum_private_member_variables_1/2 -%%----------------------------------------------------------------- -emit_enum_private_member_variables_1(Fd, [Enumerator]) -> - ic_codegen:emit(Fd, [" \"",Enumerator,"\"\n"]); -emit_enum_private_member_variables_1(Fd, [Enumerator |EList]) -> - ic_codegen:emit(Fd, [" \"",Enumerator,"\",\n"]), - emit_enum_private_member_variables_1(Fd, EList). - -%%----------------------------------------------------------------- -%% Func: emit_enum_read_function/5 -%%----------------------------------------------------------------- -emit_enum_read_function(_G, _N, _X, Fd, EnumName) -> - ic_codegen:emit(Fd, [" return ",EnumName,".from_int(_getIntFromName(_in.read_atom()));"]). - -%%----------------------------------------------------------------- -%% Func: emit_enum_write_function/5 -%%----------------------------------------------------------------- -emit_enum_write_function(_G, _N, _X, Fd, _EnumName) -> - ic_codegen:emit(Fd, " _out.write_atom(_members[_value.value()]);\n"). - - -%%----------------------------------------------------------------- -%% Func: enum_member_name_list/3 -%% -%% Note: The names generated are checked for name coalition -%% with java keywords. If so the name is always prefixed -%% by "_" -%%----------------------------------------------------------------- -enum_member_name_list(_G, _N, X) -> - lists:map( - fun(Enumerator) -> - ic_forms:get_java_id(Enumerator) - end, - ic_forms:get_body(X)). - -%%----------------------------------------------------------------- -%% Func: enum_member_atom_list/3 -%% -%% Note : Similar to the emit_member_list/3 but does not -%% solves name coalitions with java keywords. -%% Used for wire encoding only -%%----------------------------------------------------------------- -enum_member_atom_list(_G, _N, X) -> - lists:map( - fun(Enumerator) -> - ic_forms:get_id2(Enumerator) - end, - ic_forms:get_body(X)). - - - - - - - - diff --git a/lib/ic/src/ic_erl_template.erl b/lib/ic/src/ic_erl_template.erl deleted file mode 100644 index 0839577701..0000000000 --- a/lib/ic/src/ic_erl_template.erl +++ /dev/null @@ -1,640 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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% -%% -%% --module(ic_erl_template). - - --export([do_gen/3, emit_header/3]). - --import(ic_codegen, [emit/2, emit/3, nl/1]). - --include("icforms.hrl"). --include("ic.hrl"). - --include_lib("stdlib/include/erl_compile.hrl"). - --define(TAB, " "). --define(TAB2, "% "). - --define(TEMPLATE_1_A, - "%%----------------------------------------------------------------------\n" - "%% <LICENSE>\n" - "%% \n" - "%% $Id$\n" - "%%\n" - "%%----------------------------------------------------------------------\n" - "%% Module : ~s.erl\n" - "%% \n" - "%% Source : ~s\n" - "%% \n" - "%% Description : \n" - "%% \n" - "%% Creation date: ~s\n" - "%%\n" - "%%----------------------------------------------------------------------\n" - "-module(~p).\n\n"). - --define(TEMPLATE_1_B, - "%%----------------------------------------------------------------------\n" - "%% Internal Exports\n" - "%%----------------------------------------------------------------------\n" - "-export([init/1,\n" - " terminate/2,\n" - " code_change/3,\n" - " handle_info/2]).\n\n" - "%%----------------------------------------------------------------------\n" - "%% Include Files\n" - "%%----------------------------------------------------------------------\n" - "\n\n" - "%%----------------------------------------------------------------------\n" - "%% Macros\n" - "%%----------------------------------------------------------------------\n" - "\n\n" - "%%----------------------------------------------------------------------\n" - "%% Records\n" - "%%----------------------------------------------------------------------\n" - "-record(state, {}).\n\n" - "%%======================================================================\n" - "%% API Functions\n" - "%%======================================================================\n"). - --define(TEMPLATE_1_C, - "%%======================================================================\n" - "%% Internal Functions\n" - "%%======================================================================\n" - "%%----------------------------------------------------------------------\n" - "%% Function : init/1\n" - "%% Arguments : Env = term()\n" - "%% Returns : {ok, State} |\n" - "%% {ok, State, Timeout} |\n" - "%% ignore |\n" - "%% {stop, Reason}\n" - "%% Raises : -\n" - "%% Description: Initiates the server\n" - "%%----------------------------------------------------------------------\n" - "init(_Env) ->\n" - "\t{ok, #state{}}.\n\n\n" - "%%----------------------------------------------------------------------\n" - "%% Function : terminate/2\n" - "%% Arguments : Reason = normal | shutdown | term()\n" - "%% State = term()\n" - "%% Returns : ok\n" - "%% Raises : -\n" - "%% Description: Invoked when the object is terminating.\n" - "%%----------------------------------------------------------------------\n" - "terminate(_Reason, _State) ->\n" - "\tok.\n\n\n" - "%%----------------------------------------------------------------------\n" - "%% Function : code_change/3\n" - "%% Arguments : OldVsn = undefined | term()\n" - "%% State = NewState = term()\n" - "%% Extra = term()\n" - "%% Returns : {ok, NewState}\n" - "%% Raises : -\n" - "%% Description: Invoked when the object should update its internal state\n" - "%% due to code replacement.\n" - "%%----------------------------------------------------------------------\n" - "code_change(_OldVsn, State, _Extra) ->\n" - "\t{ok, State}.\n\n\n" - "%%----------------------------------------------------------------------\n" - "%% Function : handle_info/2\n" - "%% Arguments : Info = normal | shutdown | term()\n" - "%% State = NewState = term()\n" - "%% Returns : {noreply, NewState} |\n" - "%% {noreply, NewState, Timeout} |\n" - "%% {stop, Reason, NewState}\n" - "%% Raises : -\n" - "%% Description: Invoked when, for example, the server traps exits.\n" - "%%----------------------------------------------------------------------\n" - "handle_info(_Info, State) ->\n" - "\t{noreply, State}.\n\n\n"). - --define(TEMPLATE_2_A, - "%%% #0. BASIC INFORMATION\n" - "%%% ----------------------------------------------------------------------\n" - "%%% %CCaseFile : ~s.erl %\n" - "%%% Author : \n" - "%%% Description : \n" - "%%%\n" - "%%% Modules used: \n" - "%%%\n" - "%%%\n" - "%%% ----------------------------------------------------------------------\n" - "-module(~p).\n" - "-author('unknown').\n" - "-id('').\n" - "-vsn('').\n" - "-date('~s').\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% Template Id: <ID>\n" - "%%%\n" - "%%% #Copyright (C) 2004\n" - "%%% by <COMPANY>\n" - "%%% <ADDRESS>\n" - "%%% <OTHER INFORMATION>\n" - "%%% \n" - "%%% <LICENSE>\n" - "%%% \n" - "%%% \n" - "%%% ----------------------------------------------------------------------\n" - "%%% #1. REVISION LOG\n" - "%%% ----------------------------------------------------------------------\n" - "%%% Rev Date Name What\n" - "%%% ----- ------- -------- --------------------------\n" - "%%% \n" - "%%% ----------------------------------------------------------------------\n" - "%%%\n" - "%%% \n" - "%%% #2. EXPORT LISTS\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #2.1 EXPORTED INTERFACE FUNCTIONS\n" - "%%% ----------------------------------------------------------------------\n"). - --define(TEMPLATE_2_B, - "%%% ----------------------------------------------------------------------\n" - "%%% #2.2 EXPORTED INTERNAL FUNCTIONS\n" - "%%% ----------------------------------------------------------------------\n" - "-export([init/1,\n" - " terminate/2,\n" - " code_change/3,\n" - " handle_info/2]).\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #2.3 INCLUDE FILES\n" - "%%% ----------------------------------------------------------------------\n" - "\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #2.4 MACROS\n" - "%%% ----------------------------------------------------------------------\n" - "\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #2.5 RECORDS\n" - "%%% ----------------------------------------------------------------------\n" - "-record(state, {}).\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #3. CODE\n" - "%%% #---------------------------------------------------------------------\n" - "%%% #3.1 CODE FOR EXPORTED INTERFACE FUNCTIONS\n" - "%%% #---------------------------------------------------------------------\n"). - --define(TEMPLATE_2_C, - "%%% ----------------------------------------------------------------------\n" - "%%% #3.3 CODE FOR INTERNAL FUNCTIONS\n" - "%%% ----------------------------------------------------------------------\n" - "%%% ----------------------------------------------------------------------\n" - "%%% # init/1\n" - "%%% Input : Env = term()\n" - "%%% Output : {ok, State} |\n" - "%%% {ok, State, Timeout} |\n" - "%%% ignore |\n" - "%%% {stop, Reason}\n" - "%%% Exceptions : -\n" - "%%% Description: Initiates the server\n" - "%%% ----------------------------------------------------------------------\n" - "init(_Env) ->\n" - "\t{ok, #state{}}.\n\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% # terminate/2\n" - "%%% Input : Reason = normal | shutdown | term()\n" - "%%% State = term()\n" - "%%% Output : ok\n" - "%%% Exceptions : -\n" - "%%% Description: Invoked when the object is terminating.\n" - "%%% ----------------------------------------------------------------------\n" - "terminate(_Reason, _State) ->\n" - "\tok.\n\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% # code_change/3\n" - "%%% Input : OldVsn = undefined | term()\n" - "%%% State = NewState = term()\n" - "%%% Extra = term()\n" - "%%% Output : {ok, NewState}\n" - "%%% Exceptions : -\n" - "%%% Description: Invoked when the object should update its internal state\n" - "%%% due to code replacement.\n" - "%%% ----------------------------------------------------------------------\n" - "code_change(_OldVsn, State, _Extra) ->\n" - "\t{ok, State}.\n\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% # handle_info/2\n" - "%%% Input : Info = normal | shutdown | term()\n" - "%%% State = NewState = term()\n" - "%%% Output : {noreply, NewState} |\n" - "%%% {noreply, NewState, Timeout} |\n" - "%%% {stop, Reason, NewState}\n" - "%%% Exceptions : -\n" - "%%% Description: Invoked when, for example, the server traps exits.\n" - "%%% ----------------------------------------------------------------------\n" - "handle_info(_Info, State) ->\n" - "\t{noreply, State}.\n\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #4 CODE FOR TEMPORARY CORRECTIONS\n" - "%%% ----------------------------------------------------------------------\n\n"). - - -%%------------------------------------------------------------ -%% -%% Generate the client side Erlang stubs. -%% -%% Each module is generated to a separate file. -%% -%% Export declarations for all interface functions must be -%% generated. Each function then needs to generate a function head and -%% a body. IDL parameters must be converted into Erlang parameters -%% (variables, capitalised) and a type signature list must be -%% generated (for later encode/decode). -%% -%%------------------------------------------------------------ -do_gen(G, _File, Form) -> - gen_head(G, [], Form), - gen(G, [], Form). - - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = ic:handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); -gen(G, N, [X|Xs]) when is_record(X, module) -> - G2 = ic_file:filename_push(G, N, X, erlang_template_no_gen), - N2 = [ic_forms:get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, ic_forms:get_body(X)), - G3 = ic_file:filename_pop(G2, erlang_template_no_gen), - gen(G3, N, Xs); -gen(G, N, [X|Xs]) when is_record(X, interface) -> - G2 = ic_file:filename_push(G, N, X, erlang_template), - N2 = [ic_forms:get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, ic_forms:get_body(X)), - lists:foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, - X#interface.inherit_body), - Fd = ic_genobj:stubfiled(G2), - case get_template_version(G2) of - ?IC_FLAG_TEMPLATE_2 -> - emit(Fd, ?TEMPLATE_2_C, []); - _ -> - emit(Fd, ?TEMPLATE_1_C, []) - end, - G3 = ic_file:filename_pop(G2, erlang_template), - gen(G3, N, Xs); -gen(G, N, [X|Xs]) when is_record(X, op) -> - {Name, InArgNames, OutArgNames, Reply} = extract_info(X), - emit_function(G, N, X, ic_genobj:is_stubfile_open(G), - ic_forms:is_oneway(X), Name, InArgNames, OutArgNames, Reply), - gen(G, N, Xs); -gen(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, ic_genobj:is_stubfile_open(G), fun emit_function/9), - gen(G, N, Xs); -gen(G, N, [_X|Xs]) -> - gen(G, N, Xs); -gen(_G, _N, []) -> - ok. - -%% Module Header -emit_header(G, Fd, Name) -> - Date = get_date(), - case get_template_version(G) of - ?IC_FLAG_TEMPLATE_2 -> - emit(Fd, ?TEMPLATE_2_A, [Name, list_to_atom(Name), Date]); - _ -> - IDLFile = ic_genobj:idlfile(G), - emit(Fd, ?TEMPLATE_1_A, [Name, IDLFile, Date, list_to_atom(Name)]) - end. - - -emit_attr(G, N, X, Open, F) -> - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> - X2 = XX#id_of{id=Id}, - IsOneWay = ic_forms:is_oneway(X2), - {Get, Set} = mk_attr_func_names(N, ic_forms:get_id(Id)), - F(G, N, X2, Open, IsOneWay, Get, [], [], - [{ic_util:mk_var(ic_forms:get_id(Id)), - ic_forms:get_tk(X)}]), - case X#attr.readonly of - {readonly, _} -> - ok; - _ -> - F(G, N, X2, Open, IsOneWay, Set, - [{ic_util:mk_var(ic_forms:get_id(Id)), - ic_forms:get_tk(X)}], [], ["ok"]) - end - end, ic_forms:get_idlist(X)). - - -%% The automaticly generated get and set operation names for an -%% attribute. -mk_attr_func_names(_Scope, Name) -> - {"_get_" ++ Name, "_set_" ++ Name}. - - -extract_info(X) when is_record(X, op) -> - Name = ic_forms:get_id2(X), - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - Reply = case ic_forms:get_tk(X) of - tk_void -> - ["ok"]; - Type -> - [{"OE_Reply", Type}] - end, - InArgsTypeList = - [{ic_util:mk_var(ic_forms:get_id(InArg#param.id)), - ic_forms:get_tk(InArg)} || InArg <- InArgs ], - OutArgsTypeList = - [{ic_util:mk_var(ic_forms:get_id(OutArg#param.id)), - ic_forms:get_tk(OutArg)} || OutArg <- OutArgs ], - {Name, InArgsTypeList, OutArgsTypeList, Reply}. - -get_template_version(G) -> - case ic_options:get_opt(G, flags) of - Flags when is_integer(Flags) -> - case ?IC_FLAG_TEST(Flags, ?IC_FLAG_TEMPLATE_2) of - true -> - ?IC_FLAG_TEMPLATE_2; - false -> - ?IC_FLAG_TEMPLATE_1 - end; - _ -> - ?IC_FLAG_TEMPLATE_1 - end. - - -get_date() -> - {{Y,M,D}, _} = calendar:now_to_datetime(now()), - if - M < 10, D < 10 -> - lists:concat([Y, "-0", M, "-0",D]); - M < 10 -> - lists:concat([Y, "-0", M, "-", D]); - D < 10 -> - lists:concat([Y, "-", M, "-0", D]); - true -> - lists:concat([Y, "-", M, "-", D]) - end. - - -%%------------------------------------------------------------ -%% -%% Export stuff -%% -%% Gathering of all names that should be exported from a stub -%% file. -%% - - -gen_head_special(G, N, X) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - lists:foreach(fun({_Name, Body}) -> - ic_codegen:export(Fd, exp_top(G, N, Body, [])) - end, X#interface.inherit_body), - nl(Fd), - ok; -gen_head_special(_G, _N, _X) -> - ok. - - -%% Generate all export declarations -gen_head(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:export(Fd, exp_top(G, N, X, [])), - gen_head_special(G, N, X), - case get_template_version(G) of - ?IC_FLAG_TEMPLATE_2 -> - emit(Fd, ?TEMPLATE_2_B, []); - _ -> - emit(Fd, ?TEMPLATE_1_B, []) - end; - false -> - ok - end. - -exp_top(_G, _N, X, Acc) when element(1, X) == preproc -> - Acc; -exp_top(G, N, L, Acc) when is_list(L) -> - exp_list(G, N, L, Acc); -exp_top(G, N, M, Acc) when is_record(M, module) -> - exp_list(G, N, ic_forms:get_body(M), Acc); -exp_top(G, N, I, Acc) when is_record(I, interface) -> - exp_list(G, N, ic_forms:get_body(I), Acc); -exp_top(G, N, X, Acc) -> - exp3(G, N, X, Acc). - -exp3(G, N, Op, Acc) when is_record(Op, op) -> - FuncName = ic_forms:get_id(Op#op.id), - Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1 + - count_extras(G, N, Op), - [{FuncName, Arity} | Acc]; -exp3(G, N, A, Acc) when is_record(A, attr) -> - Extra = count_extras(G, N, A), - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], ic_forms:get_id(Id)), - case A#attr.readonly of - {readonly, _} -> - [{Get, 1 + Extra} | Acc2]; - _ -> - [{Get, 1 + Extra}, {Set, 2 + Extra} | Acc2] - end - end, Acc, ic_forms:get_idlist(A)); -exp3(_G, _N, _X, Acc) -> - Acc. - -exp_list(G, N, L, OrigAcc) -> - lists:foldr(fun(X, Acc) -> - exp3(G, N, X, Acc) - end, OrigAcc, L). - -count_extras(G, N, Op) -> - case {use_this(G, N, Op), use_from(G, N, Op)} of - {[], []} -> - 0; - {[], _} -> - 1; - {_, []} -> - 1; - _ -> - 2 - end. - -%%------------------------------------------------------------ -%% -%% Emit stuff -%% -%% Low level generation primitives -%% - -emit_function(_G, _N, _X, false, _, _, _, _, _) -> - ok; -emit_function(G, N, X, true, false, Name, InArgs, OutArgs, Reply) -> - Fd = ic_genobj:stubfiled(G), - This = use_this(G, N, Name), - From = use_from(G, N, Name), - State = ["State"], - Vers = get_template_version(G), - case OutArgs of - [] -> - ReplyString = create_string(Reply), - emit_function_header(G, Fd, X, N, Name, create_extra(This, From, Vers), - InArgs, length(InArgs), OutArgs, Reply, - ReplyString, Vers), - emit(Fd, "~p(~s) ->\n\t{reply, ~s, State}.\n\n", - [ic_util:to_atom(Name), create_string(This ++ From ++ State ++ InArgs), - ReplyString]); - _ -> - ReplyString = "{" ++ create_string(Reply ++ OutArgs) ++ "}", - emit_function_header(G, Fd, X, N, Name, create_extra(This, From, Vers), - InArgs, length(InArgs), OutArgs, Reply, - ReplyString, Vers), - emit(Fd, "~p(~s) ->\n\t{reply, ~s, State}.\n\n", - [ic_util:to_atom(Name), create_string(This ++ From ++ State ++ InArgs), - ReplyString]) - end; -emit_function(G, N, X, true, true, Name, InArgs, _OutArgs, _Reply) -> - Fd = ic_genobj:stubfiled(G), - This = use_this(G, N, Name), - State = ["State"], - Vers = get_template_version(G), - emit_function_header(G, Fd, X, N, Name, create_extra(This, [], Vers), - InArgs, length(InArgs), "", "", "", Vers), - emit(Fd, "~p(~s) ->\n\t{noreply, State}.\n\n", - [ic_util:to_atom(Name), create_string(This ++ State ++ InArgs)]). - -create_string([]) -> - ""; -create_string([{Name, _Type}|T]) -> - Name ++ create_string2(T); -create_string([Name|T]) -> - Name ++ create_string2(T). - -create_string2([{Name, _Type}|T]) -> - ", " ++ Name ++ create_string2(T); -create_string2([Name|T]) -> - ", " ++ Name ++ create_string2(T); -create_string2([]) -> - "". - -create_extra([], [], _Vers) -> - {"State - term()", 1}; -create_extra([], _From, ?IC_FLAG_TEMPLATE_2) -> - {"OE_From - term()\n%%% " ++ ?TAB ++ "State - term()", 2}; -create_extra([], _From, _Vers) -> - {"OE_From - term()\n%% " ++ ?TAB ++ "State - term()", 2}; -create_extra(_This, [], ?IC_FLAG_TEMPLATE_2) -> - {"OE_This - #objref{} (i.e., self())\n%%% " ++ ?TAB ++ "State - term()", 2}; -create_extra(_This, [], _Vers) -> - {"OE_This - #objref{} (i.e., self())\n%% " ++ ?TAB ++ "State - term()", 2}; -create_extra(_This, _From, ?IC_FLAG_TEMPLATE_2) -> - {"OE_This - #objref{} (i.e., self())\n%%% " ++ ?TAB ++ - "OE_From - term()\n%%% " ++ ?TAB ++ "State - term()", 3}; -create_extra(_This, _From, _Vers) -> - {"OE_This - #objref{} (i.e., self())\n%% " ++ ?TAB ++ - "OE_From - term()\n%% " ++ ?TAB ++ "State - term()", 3}. - -use_this(G, N, OpName) -> - FullOp = ic_util:to_colon([OpName|N]), - FullIntf = ic_util:to_colon(N), - case {ic_options:get_opt(G, {this, FullIntf}), - ic_options:get_opt(G, {this, FullOp}), - ic_options:get_opt(G, {this, true})} of - {_, force_false, _} -> - []; - {force_false, false, _} -> - []; - {false, false, false} -> - []; - _ -> - ["OE_This"] - end. - -use_from(G, N, OpName) -> - FullOp = ic_util:to_colon([OpName|N]), - FullIntf = ic_util:to_colon(N), - case {ic_options:get_opt(G, {from, FullIntf}), - ic_options:get_opt(G, {from, FullOp}), - ic_options:get_opt(G, {from, true})} of - {_, force_false, _} -> - []; - {force_false, false, _} -> - []; - {false, false, false} -> - []; - _ -> - ["OE_From"] - end. - - -emit_function_header(G, Fd, X, N, Name, {Extra, ExtraNo}, InP, Arity, OutP, - Reply, ReplyString, ?IC_FLAG_TEMPLATE_2) -> - emit(Fd, - "%%% ----------------------------------------------------------------------\n" - "%%% # ~p/~p\n" - "%%% Input : ~s\n", - [ic_util:to_atom(Name), (ExtraNo+Arity), Extra]), - ic_code:type_expand_all(G, N, X, Fd, ?TAB2, InP), - case Reply of - ["ok"] -> - emit(Fd, "%%% Output : ReturnValue = ~s\n", [ReplyString]); - _ -> - emit(Fd, "%%% Output : ReturnValue = ~s\n", [ReplyString]), - ic_code:type_expand_all(G, N, X, Fd, "% ", Reply) - end, - ic_code:type_expand_all(G, N, X, Fd, ?TAB2, OutP), - emit(Fd, - "%%% Exceptions : ~s\n" - "%%% Description: \n" - "%%% ----------------------------------------------------------------------\n", - [get_raises(X, ?IC_FLAG_TEMPLATE_2)]); -emit_function_header(G, Fd, X, N, Name, {Extra, ExtraNo}, InP, Arity, OutP, - Reply, ReplyString, Vers) -> - emit(Fd, - "%%----------------------------------------------------------------------\n" - "%% Function : ~p/~p\n" - "%% Arguments : ~s\n", - [ic_util:to_atom(Name), (ExtraNo+Arity), Extra]), - ic_code:type_expand_all(G, N, X, Fd, ?TAB, InP), - case Reply of - ["ok"] -> - emit(Fd, "%% Returns : ReturnValue = ~s\n", [ReplyString]); - _ -> - emit(Fd, "%% Returns : ReturnValue = ~s\n", [ReplyString]), - ic_code:type_expand_all(G, N, X, Fd, " ", Reply) - end, - ic_code:type_expand_all(G, N, X, Fd, ?TAB, OutP), - emit(Fd, - "%% Raises : ~s\n" - "%% Description: \n" - "%%----------------------------------------------------------------------\n", - [get_raises(X, Vers)]). - -get_raises(#op{raises = []}, _Vers) -> - ""; -get_raises(#op{raises = ExcList}, Vers) -> - get_raises2(ExcList, [], Vers); -get_raises(_X, _Vers) -> - []. - -get_raises2([H], Acc, _Vers) -> - lists:flatten(lists:reverse([ic_util:to_colon(H)|Acc])); -get_raises2([H|T], Acc, ?IC_FLAG_TEMPLATE_2) -> - get_raises2(T, ["\n%%% ", ic_util:to_colon(H) |Acc], - ?IC_FLAG_TEMPLATE_2); -get_raises2([H|T], Acc, _Vers) -> - get_raises2(T, ["\n%% ", ic_util:to_colon(H) |Acc], _Vers). - diff --git a/lib/ic/src/ic_erlbe.erl b/lib/ic/src/ic_erlbe.erl deleted file mode 100644 index d315a17e7c..0000000000 --- a/lib/ic/src/ic_erlbe.erl +++ /dev/null @@ -1,1142 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% --module(ic_erlbe). - - --export([do_gen/3]). -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --export([unfold/1, mk_attr_func_names/2]). - - --import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). --import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]). --import(ic_codegen, [emit/2, emit/3, nl/1]). --import(ic_options, [get_opt/2]). - --import(lists, [foreach/2, foldr/3, map/2]). - - --include("icforms.hrl"). --include("ic.hrl"). - --include_lib("stdlib/include/erl_compile.hrl"). - - -%%------------------------------------------------------------ -%% -%% Generate the client side Erlang stubs. -%% -%% Each module is generated to a separate file. -%% -%% Export declarations for all interface functions must be -%% generated. Each function then needs to generate a function head and -%% a body. IDL parameters must be converted into Erlang parameters -%% (variables, capitalised) and a type signature list must be -%% generated (for later encode/decode). -%% -%%------------------------------------------------------------ -do_gen(G, File, Form) -> - GT = get_opt(G, be), - G2 = ic_file:filename_push(G, [], mk_oe_name(G, - ic_file:remove_ext(to_list(File))), - erlang), - Light = ic_options:get_opt(G, light_ifr), - R = if - GT == erl_corba, Light == false -> - case ic_genobj:is_stubfile_open(G2) of - true -> - emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n", - [?ORBNAME, ?IFRTYPESHRL]); - false -> ok - end, - gen_head(G2, [], Form), - ic_codegen:export(ic_genobj:stubfiled(G2), - [{ictk:register_name(G2), 0}, - {ictk:unregister_name(G2), 0}, - {oe_get_module,5}, - {oe_dependency,0}]), - R0= gen(G2, [], Form), - ictk:reg_gen(G2, [], Form), - ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3 - genDependency(G2), % creates code for dependency list - R0; - GT == erl_corba, Light == true -> - case ic_genobj:is_stubfile_open(G2) of - true -> - emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n", - [?ORBNAME, ?IFRTYPESHRL]); - false -> ok - end, - gen_head(G2, [], Form), - ic_codegen:export(ic_genobj:stubfiled(G2), - [{ictk:register_name(G2), 0}, - {ictk:register_name(G2), 1}, - {ictk:unregister_name(G2), 0}, - {ictk:unregister_name(G2), 1}]), - R0= gen(G2, [], Form), - ictk:reg_gen(G2, [], Form), - ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3 - R0; - true -> - gen_head(G2, [], Form), - gen(G2, [], Form) - end, - ic_file:filename_pop(G2, erlang), - R. - - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = ic:handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, module) -> - CD = ic_code:codeDirective(G,X), - G2 = ic_file:filename_push(G, N, X, CD), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - G3 = ic_file:filename_pop(G2, CD), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, interface) -> - G2 = ic_file:filename_push(G, N, X, erlang), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, - X#interface.inherit_body), - gen_serv(G2, N, X), - G3 = ic_file:filename_pop(G2, erlang), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, const) -> -% N2 = [get_id2(X) | N], - emit_constant_func(G, X#const.id, X#const.val), - gen(G, N, Xs); %% N2 or N? - -gen(G, N, [X|Xs]) when is_record(X, op) -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs, - is_oneway(X), get_opt(G, be)), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_stub_func/9), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, erlang), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) -> - case may_contain_structs(X) of - true -> icstruct:struct_gen(G, N, X, erlang); - false -> ok - end, - gen(G, N, Xs); - -gen(_G, _N, []) -> ok. - - -may_contain_structs(X) when is_record(X, typedef) -> true; -may_contain_structs(X) when is_record(X, struct) -> true; -may_contain_structs(X) when is_record(X, union) -> true; -may_contain_structs(_X) -> false. - - - -%%-------------------------------------------------------------------- -%% -%% Generate the server side (handle_call and handle_cast) -%% - -gen_serv(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - GT = get_opt(G, be), - gen_oe_is_a(G, N, X, GT), - N2 = [get_id2(X) | N], - gen_oe_tc(G, N2, X, GT), - - emit_serv_std(GT, G, N, X), - - gen_calls(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> - gen_calls(G, N2, Body) end, - X#interface.inherit_body), - gen_end_of_call(GT, G), - - gen_casts(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> - gen_casts(G, N2, Body) end, - X#interface.inherit_body), - gen_end_of_cast(GT, G), - emit_skel_footer(GT, G, N, X); % Note N instead of N2 - false -> - ok - end. - -gen_oe_is_a(G, N, X, erl_corba) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:mcomment(Fd, ["Inherited Interfaces"]), - emit(Fd, "oe_is_a(~p) -> true;\n", [ictk:get_IR_ID(G, N, X)]), - lists:foreach(fun(ScopedName) -> - emit(Fd, "oe_is_a(~p) -> true;\n", - [ic_pragma:scope2id(G, ScopedName)]) - end, X#interface.inherit), - emit(Fd, "oe_is_a(_) -> false.\n"), - nl(Fd), - ok; -gen_oe_is_a(_G, _N, _X, _BE) -> ok. - - -%% Generates the oe_tc function -gen_oe_tc(G, N, X, erl_corba) -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:mcomment(Fd, ["Interface TypeCode"]), - LocalInterface = gen_oe_tc2(G, N, get_body(X), Fd, []), - CompleteInterface = - lists:foldl(fun({Name, Body}, FunAcc) -> - AName = ic_util:to_atom(ic_util:to_undersc(Name)), - gen_oe_tc3(G, AName, Body, Fd, FunAcc) - end, LocalInterface, X#interface.inherit_body), - emit(Fd, "oe_tc(_) -> undefined.\n"), - nl(Fd), - emit(Fd, "oe_get_interface() -> \n\t["), - emit_oe_get_interface(Fd, CompleteInterface), - nl(Fd), - ok; -gen_oe_tc(_, _, _, _) -> - ok. - -emit_oe_get_interface(Fd, []) -> - emit(Fd, "].\n"); -emit_oe_get_interface(Fd, [Item]) -> - emit(Fd, "~s].\n", [lists:flatten(Item)]); -emit_oe_get_interface(Fd, [H|T]) -> - emit(Fd, "~s,\n\t", [lists:flatten(H)]), - emit_oe_get_interface(Fd, T). - -gen_oe_tc2(_,_,[],_, Acc) -> - Acc; -gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, op) -> - R = ic_forms:get_tk(X), - IN = lists:map(fun(P) -> ic_forms:get_tk(P) end, - ic:filter_params([in, inout], X#op.params)), - OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end, - ic:filter_params([out, inout], X#op.params)), - Function = get_id2(X), - FunctionAtom = ic_util:to_atom(Function), - emit(Fd, "oe_tc(~p) -> \n\t~p;\n",[FunctionAtom, {R, IN, OUT}]), - GI = io_lib:format("{~p, oe_tc(~p)}",[Function, FunctionAtom]), - gen_oe_tc2(G, N, Rest, Fd, [GI|Acc]); - -gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) -> - {GetT, SetT} = mk_attr_func_types([], X), - NewAcc = - lists:foldl(fun(Id, FunAcc) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - GetAttrAtom = ic_util:to_atom(Get), - emit(Fd, "oe_tc(~p) -> \n\t~p;\n", - [GetAttrAtom, GetT]), - case X#attr.readonly of - {readonly, _} -> - GI = io_lib:format("{~p, oe_tc(~p)}", - [Get, GetAttrAtom]), - [GI|FunAcc]; - _ -> - SetAttrAtom = ic_util:to_atom(Set), - - emit(Fd, "oe_tc(~p) -> \n\t~p;\n", - [SetAttrAtom, SetT]), - GetGI = io_lib:format("{~p, oe_tc(~p)}", - [Get, GetAttrAtom]), - SetGI = io_lib:format("{~p, oe_tc(~p)}", - [Set, SetAttrAtom]), - [GetGI, SetGI|FunAcc] - end - end, Acc, ic_forms:get_idlist(X)), - gen_oe_tc2(G, N, Rest, Fd, NewAcc); - -gen_oe_tc2(G,N,[_X|Rest], Fd, Acc) -> - gen_oe_tc2(G,N,Rest, Fd, Acc). - - -gen_oe_tc3(_,_,[],_, Acc) -> - Acc; -gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, op) -> - Function = get_id2(X), - FunctionAtom = ic_util:to_atom(get_id2(X)), - GI = io_lib:format("{~p, ~p:oe_tc(~p)}",[Function, N, FunctionAtom]), - emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", - [FunctionAtom, N, FunctionAtom]), - gen_oe_tc3(G, N, Rest, Fd, [GI|Acc]); - -gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) -> - NewAcc = lists:foldl(fun(Id, FunAcc) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - GetAttrAtom = ic_util:to_atom(Get), - emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", - [GetAttrAtom, N, GetAttrAtom]), - case X#attr.readonly of - {readonly, _} -> - [io_lib:format("{~p, ~p:oe_tc(~p)}", - [Get, N, GetAttrAtom])|FunAcc]; - _ -> - SetAttrAtom = ic_util:to_atom(Set), - emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", - [SetAttrAtom, N, SetAttrAtom]), - [io_lib:format("{~p, ~p:oe_tc(~p)}", - [Get, N, GetAttrAtom]), - io_lib:format("{~p, ~p:oe_tc(~p)}", - [Set, N, SetAttrAtom])|FunAcc] - end - end, Acc, ic_forms:get_idlist(X)), - gen_oe_tc3(G, N, Rest, Fd, NewAcc); - -gen_oe_tc3(G,N,[_X|Rest], Fd, Acc) -> - gen_oe_tc3(G,N,Rest, Fd, Acc). - -gen_calls(G, N, [X|Xs]) when is_record(X, op) -> - case is_oneway(X) of - false -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, false, - get_opt(G, be)), - gen_calls(G, N, Xs); - true -> - gen_calls(G, N, Xs) - end; - -gen_calls(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_skel_func/9), - gen_calls(G, N, Xs); - -gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs); -gen_calls(_G, _N, []) -> ok. - -gen_casts(G, N, [X|Xs]) when is_record(X, op) -> - case is_oneway(X) of - true -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, true, - get_opt(G, be)), - gen_casts(G, N, Xs); - false -> - gen_casts(G, N, Xs) - end; - -gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs); -gen_casts(_G, _N, []) -> ok. - -emit_attr(G, N, X, F) -> - XX = #id_of{type=X}, - BE = get_opt(G, be), - {GetType, SetType} = mk_attr_func_types(N, X), - lists:foreach(fun(Id) -> - X2 = XX#id_of{id=Id}, - {Get, Set} = mk_attr_func_names(N, get_id(Id)), - F(G, N, X2, Get, [], GetType, [], - is_oneway(X2), BE), - case X#attr.readonly of - {readonly, _} -> ok; - _ -> - F(G, N, X2, Set, [mk_name(G, "Value")], - SetType, [], - is_oneway(X2), BE) - end end, ic_forms:get_idlist(X)). - - -extract_info(G, _N, X) when is_record(X, op) -> - Name = get_id2(X), - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - ArgNames = mk_erl_vars(G, InArgs), - TypeList = {ic_forms:get_tk(X), - map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), - map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) - }, - {Name, ArgNames, TypeList, OutArgs}. - - - -%% This function generates the standard functions of an object -%% gen_server -emit_serv_std(erl_corba, G, N, X) -> - Fd = ic_genobj:stubfiled(G), - Impl = ic_genobj:impl(G), - TypeID = ictk:get_IR_ID(G, N, X), - - nl(Fd), nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Object server implementation."]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), - nl(Fd), - emit(Fd, "typeID() ->\n"), - emit(Fd, " \"~s\".\n", [TypeID]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Object creation functions."]), - nl(Fd), - emit(Fd, "oe_create() ->\n"), - emit(Fd, " corba:create(?MODULE, \"~s\").\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create_link() ->\n"), - emit(Fd, " corba:create_link(?MODULE, \"~s\").\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create(Env) ->\n"), - emit(Fd, " corba:create(?MODULE, \"~s\", Env).\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create_link(Env) ->\n"), - emit(Fd, " corba:create_link(?MODULE, \"~s\", Env).\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create(Env, RegName) ->\n"), - emit(Fd, " corba:create(?MODULE, \"~s\", Env, RegName).\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create_link(Env, RegName) ->\n"), - emit(Fd, " corba:create_link(?MODULE, \"~s\", Env, RegName).\n", [TypeID]), - nl(Fd), - ic_codegen:mcomment(Fd, ["Init & terminate functions."]), - nl(Fd), - emit(Fd, "init(Env) ->\n"), - ic_codegen:comment(Fd, "Call to implementation init"), - emit(Fd, " corba:handle_init(~p, Env).\n", [to_atom(Impl)]), - nl(Fd), - emit(Fd, "terminate(Reason, State) ->\n"), - emit(Fd, " corba:handle_terminate(~p, Reason, State).\n", - [to_atom(Impl)]), - nl(Fd), nl(Fd), - Fd; -emit_serv_std(erl_genserv, G, N, X) -> - Fd = ic_genobj:stubfiled(G), - Impl = ic_genobj:impl(G), - TypeID = ictk:get_IR_ID(G, N, X), - - nl(Fd), nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Server implementation."]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), - nl(Fd), - emit(Fd, "typeID() ->\n"), - emit(Fd, " \"~s\".\n", [TypeID]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Server creation functions."]), - nl(Fd), - emit(Fd, "oe_create() ->\n"), - emit(Fd, " start([], []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link() ->\n"), - emit(Fd, " start_link([], []).\n", []), - nl(Fd), - emit(Fd, "oe_create(Env) ->\n"), - emit(Fd, " start(Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link(Env) ->\n"), - emit(Fd, " start_link(Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create(Env, RegName) ->\n"), - emit(Fd, " start(RegName, Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link(Env, RegName) ->\n"), - emit(Fd, " start_link(RegName, Env, []).\n", []), - nl(Fd), - ic_codegen:mcomment(Fd, ["Start functions."]), - nl(Fd), - emit(Fd, "start(Env, Opt) ->\n"), - emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start_link(Env, Opt) ->\n"), - emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start(RegName, Env, Opt) ->\n"), - emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start_link(RegName, Env, Opt) ->\n"), - emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"), - nl(Fd), - ic_codegen:comment(Fd, "Standard gen_server termination"), - emit(Fd, "stop(OE_THIS) ->\n"), - emit(Fd, " gen_server:cast(OE_THIS,stop).\n"), - nl(Fd), - ic_codegen:comment(Fd, "Call to implementation init"), - emit(Fd, "init(Env) ->\n"), - emit(Fd, " ~p:~p(Env).\n", [to_atom(Impl), init]), - nl(Fd), - emit(Fd, "terminate(Reason, State) ->\n"), - emit(Fd, " ~p:~p(Reason, State).\n", - [to_atom(Impl), terminate]), - nl(Fd), nl(Fd), - Fd. - -gen_end_of_call(erl_corba, G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), - emit(Fd, "handle_call(stop, _, State) ->\n"), - emit(Fd, " {stop, normal, ok, State}"), - case get_opt(G, serv_last_call) of - exception -> - emit(Fd, ";\n"), - nl(Fd), - emit(Fd, "handle_call(_, _, State) ->\n"), - emit(Fd, " {reply, catch corba:raise(#'BAD_OPERATION'{minor=1163001857, completion_status='COMPLETED_NO'}), State}.\n"); - exit -> - emit(Fd, ".\n"), - nl(Fd), - nl(Fd) - end, - ok; -gen_end_of_call(erl_genserv, G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), - emit(Fd, "handle_call(stop, _, State) ->\n"), - emit(Fd, " {stop, normal, ok, State}"), - emit(Fd, ".\n"), - nl(Fd), nl(Fd), - ok. - -gen_end_of_cast(erl_corba, G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), - emit(Fd, "handle_cast(stop, State) ->\n"), - emit(Fd, " {stop, normal, State}"), - case get_opt(G, serv_last_call) of - exception -> - emit(Fd, ";\n"), - nl(Fd), - emit(Fd, "handle_cast(_, State) ->\n"), - emit(Fd, " {noreply, State}.\n"); - exit -> - emit(Fd, ".\n"), - nl(Fd), nl(Fd) - end, - ok; -gen_end_of_cast(erl_genserv, G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), - emit(Fd, "handle_cast(stop, State) ->\n"), - emit(Fd, " {stop, normal, State}"), - emit(Fd, ".\n"), - nl(Fd), nl(Fd), - ok. - -emit_skel_footer(erl_corba, G, N, X) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), - case use_impl_handle_info(G, N, X) of - true -> - emit(Fd, "handle_info(Info, State) ->\n"), - emit(Fd, " corba:handle_info(~p, Info, State).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - false -> - emit(Fd, "handle_info(_, State) ->\n"), - emit(Fd, " {noreply, State}.\n\n") - end, - nl(Fd), - case get_opt(G, no_codechange) of - false -> - emit(Fd, "code_change(OldVsn, State, Extra) ->\n"), - emit(Fd, " corba:handle_code_change(~p, OldVsn, State, Extra).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - true -> - emit(Fd, "code_change(_, State, _) ->\n"), - emit(Fd, " {ok, State}.\n\n") - end, - ok; -emit_skel_footer(erl_genserv, G, N, X) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), - case use_impl_handle_info(G, N, X) of - true -> - emit(Fd, "handle_info(Info, State) ->\n"), - emit(Fd, " ~p:handle_info(Info, State).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - false -> - emit(Fd, "handle_info(_, State) ->\n"), - emit(Fd, " {noreply, State}.\n\n") - end, - nl(Fd), nl(Fd), - case get_opt(G, no_codechange) of - false -> - emit(Fd, "code_change(OldVsn, State, Extra) ->\n"), - emit(Fd, " ~p:code_change(OldVsn, State, Extra).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - true -> - emit(Fd, "code_change(_, State, _) ->\n"), - emit(Fd, " {ok, State}.\n\n") - end, - ok. - - -use_impl_handle_info(G, N, X) -> - FullName = ic_util:to_colon([get_id2(X) | N]), - case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of - {_, force_false} -> false; - {false, false} -> false; - _ -> true - end. - -use_timeout(G, N, _X) -> - FullName = ic_util:to_colon(N), - case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of - {_, force_false} -> false; - {false, false} -> false; - _ -> true - end. - -use_precond(G, N, X) -> - FullName = ic_util:to_colon([get_id2(X) | N]), - case get_opt(G, {precond, FullName}) of - false -> - InterfaceName = ic_util:to_colon(N), - case get_opt(G, {precond, InterfaceName}) of - false -> - case get_opt(G, precond) of - false -> false; - V2 -> V2 - end; - V2 -> V2 - end; - V1 -> V1 - end. - -use_postcond(G, N, X) -> - FullName = ic_util:to_colon([get_id2(X) | N]), - case get_opt(G, {postcond, FullName}) of - false -> - InterfaceName = ic_util:to_colon(N), - case get_opt(G, {postcond, InterfaceName}) of - false -> - case get_opt(G, postcond) of - false -> false; - V3 -> V3 - end; - V2 -> V2 - end; - V1 -> V1 - end. - - -%%------------------------------------------------------------ -%% -%% Export stuff -%% -%% Gathering of all names that should be exported from a stub -%% file. -%% - - -gen_head_special(G, N, X) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - - foreach(fun({Name, Body}) -> - ic_codegen:comment(Fd, "Exports from ~p", - [ic_util:to_colon(Name)]), - ic_codegen:export(Fd, exp_top(G, N, Body, [], get_opt(G, be))), - nl(Fd) - end, X#interface.inherit_body), - - ic_codegen:comment(Fd, "Type identification function"), - ic_codegen:export(Fd, [{typeID, 0}]), - nl(Fd), - ic_codegen:comment(Fd, "Used to start server"), - ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1}, {oe_create_link, 1}, - {oe_create, 2}, {oe_create_link, 2}]), - nl(Fd), - case get_opt(G, be) of - erl_corba -> - ic_codegen:comment(Fd, "TypeCode Functions and inheritance"), - ic_codegen:export(Fd, [{oe_tc, 1}, {oe_is_a, 1}, {oe_get_interface, 0}]); - _ -> - ic_codegen:export(Fd, [{start, 2}, {start_link, 3}]) - end, - nl(Fd), - ic_codegen:comment(Fd, "gen server export stuff"), - emit(Fd, "-behaviour(gen_server).\n"), - - case get_opt(G, be) of - erl_genserv -> %% stop/1 is only for erl_genserv backend - ic_codegen:export(Fd, [{stop, 1}, {init, 1}, {terminate, 2}, {handle_call, 3}, - {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]); - _ -> - ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {handle_call, 3}, - {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]) - end, - - case get_opt(G, be) of - erl_corba -> - nl(Fd), - emit(Fd, "-include_lib(\"~s/include/~s\").\n", [?ORBNAME, ?CORBAHRL]); - _ -> - ok - end, - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Object interface functions."]), - nl(Fd), nl(Fd), nl(Fd), - Fd; -gen_head_special(_G, _N, _X) -> ok. - - - -%% Shall generate all export declarations -gen_head(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - F = ic_genobj:stubfiled(G), - ic_codegen:comment(F, "Interface functions"), - ic_codegen:export(F, exp_top(G, N, X, [], get_opt(G, be))), - nl(F), - gen_head_special(G, N, X); - false -> ok - end. - -exp_top(_G, _N, X, Acc, _) when element(1, X) == preproc -> - Acc; -exp_top(G, N, L, Acc, BE) when is_list(L) -> - exp_list(G, N, L, Acc, BE); -exp_top(G, N, M, Acc, BE) when is_record(M, module) -> - exp_list(G, N, get_body(M), Acc, BE); -exp_top(G, N, I, Acc, BE) when is_record(I, interface) -> - exp_list(G, N, get_body(I), Acc, BE); -exp_top(G, N, X, Acc, BE) -> - exp3(G, N, X, Acc, BE). - -exp3(_G, _N, C, Acc, _BE) when is_record(C, const) -> - [{get_id(C#const.id), 0} | Acc]; -exp3(_G, _N, Op, Acc, erl_corba) when is_record(Op, op) -> - FuncName = get_id(Op#op.id), - Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1, - [{FuncName, Arity}, {FuncName, Arity+1} | Acc]; -exp3(G, N, Op, Acc, _BE) when is_record(Op, op) -> - FuncName = get_id(Op#op.id), - Arity = - case use_timeout(G,N,Op) of - true -> - %% NO TimeOut on ONEWAYS here !!!! - case is_oneway(Op) of - true -> - length(ic:filter_params([in, inout], Op#op.params)) + 1; - false -> - length(ic:filter_params([in, inout], Op#op.params)) + 2 - end; - false -> - length(ic:filter_params([in, inout], Op#op.params)) + 1 - end, - [{FuncName, Arity} | Acc]; - -exp3(_G, _N, A, Acc, erl_corba) when is_record(A, attr) -> - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case A#attr.readonly of - {readonly, _} -> [{Get, 1}, {Get, 2} | Acc2]; - _ -> [{Get, 1}, {Get, 2}, - {Set, 2}, {Set, 3} | Acc2] - end end, Acc, ic_forms:get_idlist(A)); -exp3(_G, _N, A, Acc, _BE) when is_record(A, attr) -> - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case A#attr.readonly of - {readonly, _} -> [{Get, 1} | Acc2]; - _ -> [{Get, 1}, {Set, 2} | Acc2] - end end, Acc, ic_forms:get_idlist(A)); - -exp3(_G, _N, _X, Acc, _BE) -> Acc. - -exp_list(G, N, L, OrigAcc, BE) -> - lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc, BE) end, OrigAcc, L). - - - - -%%------------------------------------------------------------ -%% -%% Emit stuff -%% -%% Low level generation primitives -%% - -emit_stub_func(G, N, X, Name, ArgNames, _TypeList, OutArgs, Oneway, Backend) -> - case ic_genobj:is_stubfile_open(G) of - false -> - ok; - true -> - Fd = ic_genobj:stubfiled(G), - StubName = list_to_atom(Name), - UsingTimeout = use_timeout(G, N, X), - Timeout = case UsingTimeout of - true -> - mk_name(G, "Timeout"); - false -> - "infinity" - end, - Options = mk_name(G, "Options"), - This = mk_name(G, "THIS"), - CallOrCast = - case is_oneway(X) of - true -> ?CAST; - _ -> ?CALL - end, - emit_op_comment(G, Fd, X, StubName, ArgNames, OutArgs), - case Backend of - erl_corba -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This | ArgNames])]), - emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE).\n\n", - [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames)]), - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This, Options| ArgNames])]), - emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE, ~s).\n\n", - [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames), - Options]); - _ -> - FunName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - list_to_atom(ic_util:to_undersc([Name | N])); - false -> - StubName - end, - %% NO TimeOut on ONEWAYS here !!!! - case Oneway of - true -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This | ArgNames])]); - false -> - case UsingTimeout of - true -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This, Timeout| ArgNames])]); - false -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This | ArgNames])]) - end - end, - - %% NO TimeOut on ONEWAYS here !!!! - if - length(ArgNames) == 0 -> - case is_oneway(X) of - true -> - emit(Fd, " ~s:~s(~s, ~p).\n\n", - [?GENSERVMOD, CallOrCast, This, FunName]); - false -> - emit(Fd, " ~s:~s(~s, ~p, ~s).\n\n", - [?GENSERVMOD, CallOrCast, This, FunName, Timeout]) - end; - true -> - case is_oneway(X) of - true -> - emit(Fd, " ~s:~s(~s, {~p, ~s}).\n\n", - [?GENSERVMOD, CallOrCast, This, FunName, - mk_list(ArgNames)]); - false -> - emit(Fd, " ~s:~s(~s, {~p, ~s}, ~s).\n\n", - [?GENSERVMOD, CallOrCast, This, FunName, - mk_list(ArgNames), Timeout]) - end - end - end - end. - -emit_skel_func(G, N, X, OpName, ArgNames, TypeList, OutArgs, Oneway, Backend) -> - case ic_genobj:is_stubfile_open(G) of - false -> - ok; - true -> - emit_skel_func_helper(G, N, X, OpName, ArgNames, TypeList, OutArgs, - Oneway, Backend) - end. - -emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway, - erl_corba) -> - Fd = ic_genobj:stubfiled(G), - Name = list_to_atom(OpName), - ImplF = Name, - ImplM = list_to_atom(ic_genobj:impl(G)), - ThisStr = mk_name(G, "THIS"), - FromStr = mk_name(G, "From"), - State = mk_name(G, "State"), - Context = mk_name(G, "Context"), - - {UseFrom, From} = - case Oneway of - false -> - case use_from(G, N, OpName) of - true -> - {FromStr, FromStr}; - false -> - {"false", "_"} - end; - true -> - {"false", "_"} - end, - {UseThis, This} = - case use_this(G, N, OpName) of - true -> - {ThisStr, ThisStr}; - false -> - {"false", "_"} - end, - %% Create argument list string - CallArgs = mk_list(ArgNames), - emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs), - - %% Check if pre and post conditions are specified for this operation - Precond = use_precond(G, N, X), - Postcond = use_postcond(G, N, X), - - case Oneway of - true -> - emit(Fd, "handle_cast({~s, ~s, ~p, [~s]}, ~s) ->\n", - [This, Context, Name, CallArgs, State]), - case {Precond, Postcond} of - {false, false} -> - emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s);\n\n", - [ImplM, ImplF, CallArgs, State, Context, UseThis]); - _ -> - emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n", - [ImplM, ImplF, CallArgs, State, Context, UseThis, - Precond, Precond]) - end; - false -> - emit(Fd, "handle_call({~s, ~s, ~p, [~s]}, ~s, ~s) ->\n", - [This, Context, Name, CallArgs, From, State]), - case {Precond, Postcond} of - {false, false} -> - emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s);\n\n", - [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom]); - _-> - emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n", - [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom, - Precond, Postcond]) - end - end; -emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway, - _Backend) -> - Fd = ic_genobj:stubfiled(G), - Name = list_to_atom(OpName), - ImplF = Name, - ImplM = list_to_atom(ic_genobj:impl(G)), - FromStr = mk_name(G, "From"), - State = mk_name(G, "State"), - - %% Create argument list - CallArgs1 = [State | ArgNames], - {CallArgs2, From} = - case is_oneway(X) of - false -> - case use_from(G, N, OpName) of - true -> - {[FromStr | CallArgs1], FromStr}; - false -> - {CallArgs1, "_"} - end; - true -> - {CallArgs1, "_"} - end, - %% Create argument list string - CallArgs = mk_list(CallArgs2), - emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs), - FunName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - list_to_atom(ic_util:to_undersc([OpName | N])); - false -> - list_to_atom(OpName) - end, - case Oneway of - true -> - if - length(ArgNames) == 0 -> - emit(Fd, "handle_cast(~p, ~s) ->\n", [FunName, State]); - true -> - emit(Fd, "handle_cast({~p, ~s}, ~s) ->\n", - [FunName, mk_list(ArgNames), State]) - end, - emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]); - false -> - if - length(ArgNames) == 0 -> - emit(Fd, "handle_call(~p, ~s, ~s) ->\n", - [FunName, From, State]); - true -> - emit(Fd, "handle_call({~p, ~s}, ~s, ~s) ->\n", - [FunName, mk_list(ArgNames), From, State]) - end, - emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]) - end. - -use_this(G, N, OpName) -> - FullOp = ic_util:to_colon([OpName|N]), - FullIntf = ic_util:to_colon(N), - case {get_opt(G, {this, FullIntf}), get_opt(G, {this, FullOp}), - get_opt(G, {this, true})} of - {_, force_false, _} -> false; - {force_false, false, _} -> false; - {false, false, false} -> false; - _ -> true - end. - -use_from(G, N, OpName) -> - FullOp = ic_util:to_colon([OpName|N]), - FullIntf = ic_util:to_colon(N), - case {get_opt(G, {from, FullIntf}), get_opt(G, {from, FullOp}), - get_opt(G, {from, true})} of - {_, force_false, _} -> false; - {force_false, false, _} -> false; - {false, false, false} -> false; - _ -> true - end. - - -emit_constant_func(G, Id, Val) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - N = list_to_atom(get_id(Id)), - emit_const_comment(G, Fd, Id, N), - emit(Fd, "~p() -> ~p.\n\n", [N, Val]) - end. - - - -emit_const_comment(_G, F, _X, Name) -> - ic_codegen:mcomment_light(F, - [io_lib:format("Constant: ~p", [Name])]). - - -emit_op_comment(G, F, X, Name, InP, OutP) -> - ic_codegen:mcomment_light(F, - [io_lib:format("~s: ~p", [get_title(X), Name]), - "", - get_returns(G, X, InP, OutP) | - get_raises(X)]). - -get_title(X) when is_record(X, attr) -> "Attribute Operation"; -get_title(_X) -> "Operation". - -get_raises(X) when is_record(X, op) -> - if X#op.raises == [] -> []; - true -> - [" Raises: " ++ - mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, - X#op.raises))] - end; -get_raises(_X) -> []. - -get_returns(_G, _X, _InP, []) -> - " Returns: RetVal"; -get_returns(G, _X, _InP, OutP) -> - " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]). - - - - -%%------------------------------------------------------------ -%% -%% Utilities -%% -%% Convenient little go-get functions -%% -%%------------------------------------------------------------ - -%% The automaticly generated get and set operation names for an -%% attribute. -mk_attr_func_names(_Scope, Name) -> - {"_get_" ++ Name, "_set_" ++ Name}. -%% {scoped_name(Scope, "_get_"++Name), scoped_name(Scope, "_set_"++Name)}. - -%% Returns TK of the Get and Set attribute functions. -mk_attr_func_types(_N, X) -> - TK = ic_forms:get_tk(X), - {{TK, [], []}, {tk_void, [TK], []}}. - - - -%%------------------------------------------------------------ -%% -%% Generation utilities and common stuff -%% -%% Convenient stuff for generation -%% -%%------------------------------------------------------------ - - -%% Input is a list of parameters (in parse form) and output is a list -%% of capitalised variable names. mk_var is in icgen -mk_erl_vars(_G, Params) -> - map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). - - -%% mk_list produces a nice comma separated string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - - -%%------------------------------------------------------------ -%% -%% Parser utilities -%% -%% Called from the yecc parser. Expands the identifier list of an -%% attribute so that the attribute generator never has to handle -%% lists. -%% -%%------------------------------------------------------------ - - -%% Unfold identifier lists or nested lists. Note that many records -%% contain an entry named id that is a list before unfold and a single -%% id afterwards. -unfold(L) when is_list(L) -> - lists:flatten(map(fun(X) -> unfold2(X) end, L)); -unfold(X) -> unfold2(X). - -unfold2(A) when is_record(A, attr) -> - map(fun(Id) -> A#attr{id=Id} end, A#attr.id); -unfold2(M) when is_record(M, member) -> - map(fun(Id) -> M#member{id=Id} end, M#member.id); -unfold2(M) when is_record(M, case_dcl) -> - map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label); -unfold2(T) when is_record(T, typedef) -> - map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id). - - - - -%% Code produce for dependency function -genDependency(G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd),nl(Fd), - ic_codegen:comment(Fd, "Idl file dependency list function"), - emit(Fd, "oe_dependency() ->\n\n", []), - emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). diff --git a/lib/ic/src/ic_error.erl b/lib/ic/src/ic_error.erl deleted file mode 100644 index 790e1f0539..0000000000 --- a/lib/ic/src/ic_error.erl +++ /dev/null @@ -1,376 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_error). - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/ic_debug.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([error/2, - fatal_error/2, - init_errors/1, - return/1, - warn/2, - get_error_count/1]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% Error and warning utilities. -%% -%% Note that errors are somewhat brutal and that warnings are kept in -%% a list for the user to extract at a later stage. The handling of -%% warnings is entirely up to the user while handling of errors is -%% never left to the user. -%% -%%-------------------------------------------------------------------- - -return(G) -> - case ic_options:get_opt(G, silent2) of - true -> - case get_error_count(G) of - 0 -> {ok, get_list(G, warn_list)}; - _X -> {error, get_list(G, warn_list), get_list(G, error_list)} - end; - false -> - case get_error_count(G) of - 0 -> ok; - X -> print_error(G, {error, g, ic_genobj:idlfile(G), {error_count, X}}), - error - end - end. - - -get_list(G, ListName) -> - ?lookup(G#genobj.options, ListName). - - -%% Public function for reporting an error -error(G, Err) -> - Error = {error, g, ic_genobj:idlfile(G), Err}, - case insert_in_list(G, Error, error_list) of - new -> - print_error(G, Error), - MaxErrs = ic_options:get_opt(G, maxerrs), - case incr_counter(G, error_count) of - X when X >= MaxErrs -> - fatal_error(G, {error_count_exceeded, X}); - _ -> Error - end; - old -> - Error - end. - -%% Public function for reporting an error. NOTE: also stops execution -fatal_error(G, Err) -> - Error = {error, g, ic_genobj:idlfile(G), Err}, - insert_in_list(G, Error, error_list), - incr_counter(G, error_count), - print_error(G, Error), - throw(Error). - - -%% Public function for reporting a warning -warn(G, Warn) -> - Warning = {warn, g, ic_genobj:idlfile(G), Warn}, - case insert_in_list(G, Warning, warn_list) of - new -> - print_warn(G, Warning), - MaxErrs = ic_options:get_opt(G, maxwarns), - case incr_counter(G, warn_count) of - X when X >= MaxErrs -> - fatal_error(G, {warn_count_exceeded, X}); - _ -> ok - end; - old -> ok -end. - - -%% Initialisation of all counters and lists associated with errors and -%% warnings. -init_errors(G) -> - reset_counter(G, error_count), - reset_counter(G, warn_count), - reset_list(G, error_list), - reset_list(G, warn_list), - ok. - - - -%%-------------------------------------------------------------------- -%% Counter and list (warn and error) handling -%% - -incr_counter(G, Counter) -> - Num = ?lookup(G#genobj.options, Counter) + 1, - ?insert(G#genobj.options, Counter, Num), - Num. - -reset_counter(G, Counter) -> - ?insert(G#genobj.options, Counter, 0). - -get_error_count(G) -> - ?lookup(G#genobj.options, error_count). - -reset_list(G, ListName) -> - ?insert(G#genobj.options, ListName, []). - -insert_in_list(G, Item, ListName) -> - List = ?lookup(G#genobj.options, ListName), - case lists:member(Item, List) of - true -> old; - false -> - ?insert(G#genobj.options, ListName, [Item| List]), - new - end. - - -%%-------------------------------------------------------------------- -%% -%% Nice printouts of errors and warnings -%% - - -%% Errors - -print_error(G, Error) -> - case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of - {true, _} -> ok; - {_, true} -> ok; - _ -> format_error(Error) - end, - error. - -format_error({error, _, File, {parse_error, Line, Args}}) -> - Fmt = lists:foldl(fun(_, Acc) -> [$~, $s | Acc] end, [], Args), - display(File, Line, Fmt, Args); -format_error({error, _, File, {error_count, X}}) -> - display(File, "~p errors found", [X]); -format_error({error, _, File, {error_count_exceeded, X}}) -> - display(File, "too many errors found (~p)", [X]); -format_error({error, _, File, {warn_count_exceeded, X}}) -> - display(File, "too many warnings found (~p)", [X]); -format_error({error, _, File, {inherit_name_collision, - {Orig, Item}, {Base, NewItem}}}) -> - display(File, ic_forms:get_line(Item), "~s collides with ~s", - [pp([ic_forms:get_id2(Item) | Orig]), pp([ic_forms:get_id2(NewItem) | Base])]); -format_error({error, _, File, {unsupported_op, {'~', Line}}}) -> - display(File, Line, "unsupported unary operation ~~", []); -format_error({error, _, File, {multiply_defined, X}}) -> - display(File, ic_forms:get_line(X), "multiple defined identifier ~p", [ic_forms:get_id2(X)]); -format_error({error, _, File, {illegal_spelling, X}}) -> - display(File, ic_forms:get_line(X), -% "illegal spelling of identifier ~s (capitalisation?)", - "identifier ~p multiply declared - differs in case only", - [ic_forms:get_id2(X)]); -format_error({error, _, File, {illegal_enumerant_value, X}}) -> - display(File, ic_forms:get_line(X), - "Enumerant ~s's value collide by name with other type", - [ic_forms:get_id2(X)]); -format_error({error, _, File, {illegal_forward, X}}) -> - display(File, ic_forms:get_line(X), - "cannot inherit from forwarded interface ~s", [ic_forms:get_id2(X)]); -format_error({error, _, File, {illegal_const_t, X, Type}}) -> - display(File, ic_forms:get_line(X), - "Illegal constant type ~s of ~s", [pp(Type), ic_forms:get_id2(X)]); -format_error({error, _, File, {multiple_cases, X}}) -> - display(File, ic_forms:get_line(X), "multiple case values ~s", [pp(X)]); -format_error({error, _, File, {symtab_not_found, X}}) -> - display(File, ic_forms:get_line(X), "undeclared identifier ~s", [ic_forms:get_id2(X)]); -format_error({error, _, File, {preproc, Lines}}) -> - display(File, "preprocessor error: ~s", [hd(Lines)]); -format_error({error, _, File, {ic_pp_error, Lines}}) -> - display(File, "preprocessor error: ~s", [Lines]); -format_error({error, _, File, {illegal_float, Line}}) -> - display(File, Line, "illegal floating point number", []); -format_error({error, _, File, {bad_type_combination, E, V1, V2}}) -> - display(File, ic_forms:get_line(E), "incompatible types, ~p and ~p", [V1, V2]); -format_error({error, _, File, {bad_oneway_type, X, _TK}}) -> - display(File, ic_forms:get_line(X), "oneway operations must be declared void", []); -format_error({error, _, File, {inout_spec_for_c, X, Arg}}) -> - display(File, ic_forms:get_line(X), "inout parameter ~s specified in native c mode", - [Arg]); -format_error({error, _, File, {sequence_not_defined, X, Arg}}) -> - display(File, ic_forms:get_line(X), "sequence ~s not defined", [Arg]); -format_error({error, _, File, {illegal_typecode_for_c, Arg}}) -> - display(File, not_specified, "illegal typecode ~s used in native c mode", - [Arg]); -format_error({error, _, File, {name_not_found, N}}) -> - display(File, not_specified, "name ~s not found", [N]); -format_error({error, _, File, {illegal_typecode_for_c, Arg, N}}) -> - display(File, not_specified, "illegal typecode ~p used for ~p in native c mode", [Arg, N]); -format_error({error, _, File, {oneway_outparams, X}}) -> - display(File, ic_forms:get_line(X), - "oneway operations may not have out or inout parameters", []); -format_error({error, _, File, {oneway_raises, X}}) -> - display(File, ic_forms:get_line(X), "oneway operations may not raise exceptions", - []); -format_error({error, _, File, {bad_tk_match, T, TK, V}}) -> - display(File, ic_forms:get_line(T), - "value ~p does not match declared type ~s", [V, pp(TK)]); -format_error({error, _, File, {bad_scope_enum_case, ScopedId}}) -> - display(File, ic_forms:get_line(ScopedId), - "scoped enum identifiers not allowed as case (~s)", - [pp(ScopedId)]); -format_error({error, _, File, {bad_type, Expr, Op, _TypeList, V}}) -> - display(File, ic_forms:get_line(Expr), - "parameter value ~p to ~s is of illegal type", [V, pp(Op)]); -format_error({error, _, File, {bad_case_type, TK, X, Val}}) -> - display(File, ic_forms:get_line(X), - "case value ~s does not match discriminator type ~s", - [case_pp(X, Val), pp(TK)]); -format_error({error, _, File, {tk_not_found, X}}) -> - display(File, ic_forms:get_line(X), "undeclared identifier ~s", [pp(X)]); -%%% New format_errors -format_error({error, _, File, {bad_fixed, Format, Args, Line}}) -> - display(File, Line, Format, Args); -format_error({error, _, File, {illegal_switch_t, Arg, _N}}) -> - display(File, ic_forms:get_line(Arg), "illegal switch", []); -format_error({error, _, File, {inherit_resolve, Arg, N}}) -> - display(File, ic_forms:get_line(Arg), "cannot resolve ~s", [N]); -format_error({error, _, File, {bad_escape_character, Line, Char}}) -> - display(File, Line, "bad escape character \"~c\"", [Char]); -format_error({error, _, File, {pragma_code_opt_bad_option_list, Line}}) -> - display(File, Line, "bad option list on pragma \"CODEOPT\"", []); -format_error({error, _, File, {bad_string, Line}}) -> - display(File, Line, "bad string", []); -format_error({error, _, File, {create_dir, Path, Reason}}) -> - display(File, not_specified, "couldn't create directory ~p due to ~p", [Path, Reason]); -format_error({error, _, File, {open_file, Path, Reason}}) -> - display(File, not_specified, "couldn't open ~p due to ~p", [Path, Reason]); -format_error({error, _, File, {plain_error_string, ErrString}}) -> - display(File, not_specified, "~s", [ErrString]); -format_error({error, _, File, {plain_error_string, T, ErrString}}) -> - display(File, ic_forms:get_line(T), "~s", [ErrString]); -format_error({error, _, File, {ErrString, Line}}) -> - display(File, Line, ErrString, []). - - -%% Warnings -print_warn(G, Warn) -> - case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of - {true, _} -> ok; - {_, true} -> ok; - _ -> format_warn(Warn) - end. - -format_warn({warn, _, File, {ic_pp_warning, Lines}}) -> - display(File, "preprocessor warning: ~s", [Lines]); -format_warn({warn, _, _File, {cfg_open, _Reason, File}}) -> - display(File, "warning: could not open file: ~p", [File]); -format_warn({warn, _, _File, {cfg_read, File}}) -> - display(File, "warning: syntax error in configuration file", []); -format_warn({warn, _, File, {multi_modules, Id}}) -> - display(File, ic_forms:get_line(Id), "warning: multiple modules in file", []); -format_warn({warn, _, File, {illegal_opt, Opt}}) -> - display(File, "warning: unrecognised option: ~p", [Opt]); -format_warn({warn, _, File, {nested_mod, Id}}) -> - display(File, ic_forms:get_line(Id), "warning: nested module: ~s", [ic_forms:get_id(Id)]); -format_warn({warn, _, File, {inherit_name_shadow, {Orig, Item}, - {Base, NewItem}}}) -> - display(File, ic_forms:get_line(Item), - "warning: ~s shadows ~s", [pp([ic_forms:get_id2(Item) | Orig]), - pp([ic_forms:get_id2(NewItem) | Base])]); -format_warn({warn, _, File, {internal_307, X, Y}}) -> - %% If global Scope variable is not [] at top level constant - display(File, ic_forms:get_line(X), "warning: internal 307: ~p ~p", [X, Y]); -format_warn({warn, _, File, {WarnString, Line}}) -> - display(File, Line, WarnString, []). - -%% Display an error or warning -display(File, not_specified, F, A) -> - io:format("~p : ~s~n", [File, io_lib:format(F, A)]); -display(File, Line, F, A) -> - io:format("~p on line ~p: ~s~n", [File, Line, io_lib:format(F, A)]). -display(File, F, A) -> - io:format("~p: ~s~n", [File, io_lib:format(F, A)]). - - - -%%format_warn2(G, WarnStr) -> -%% case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2), -%% ic_options:get_opt(G, nowarn)} of -%% {false, false, false} -> -%% io:format("~p: warning: ~s~n", [ic_genobj:idlfile(G), WarnStr]); -%% _ -> ok -%% end. - -%%format_warn2(G, Line, WarnStr) -> -%% case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2), -%% ic_options:get_opt(G, nowarn)} of -%% {false, false, false} -> -%% io:format("~p on line ~p: warning: ~s~n", -%% [ic_genobj:idlfile(G), Line, WarnStr]); -%% _ -> ok -%% end. - - - - -%% pretty print various stuff - -pp({tk_string, _}) -> "string"; -pp({tk_wstring, _}) -> "wstring"; -pp(tk_long) -> "long"; -pp(tk_short) -> "short"; -pp(tk_ushort) -> "unsigned short"; -pp(tk_ulong) -> "unsigned long"; -pp(tk_float) -> "float"; -pp(tk_double) -> "double"; -pp(tk_boolean) -> "boolean"; -pp(tk_char) -> "char"; -pp(tk_wchar) -> "wchar"; -pp(tk_octet) -> "octet"; -pp(tk_null) -> "null"; -pp(tk_void) -> "void"; -pp(tk_any) -> "any"; -pp({tk_fixed, _, _}) -> "fixed"; -pp({tk_objref, _, _}) -> "object reference"; -pp(rshift) -> ">>"; -pp(lshift) -> "<<"; -pp(X) when element(1, X) == tk_enum -> "enum"; -pp(X) when is_record(X, scoped_id) -> ic_util:to_colon(X); -pp(X) when element(1, X) == '<identifier>' -> ic_forms:get_id(X); -pp(X) when is_list(X) andalso is_list(hd(X)) -> ic_util:to_colon(X); -pp({_, Num, Beef}) when is_integer(Num) -> Beef; -pp({Beef, Num}) when is_integer(Num) -> ic_util:to_list(Beef); -pp(X) -> ic_util:to_list(X). - -%% special treatment of case label names -case_pp(X, _Val) when is_record(X, scoped_id) -> pp(X); -case_pp(_X, Val) -> pp(Val). - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_fetch.erl b/lib/ic/src/ic_fetch.erl deleted file mode 100644 index 59f21711ec..0000000000 --- a/lib/ic/src/ic_fetch.erl +++ /dev/null @@ -1,389 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_fetch). - --include("icforms.hrl"). - --export([member2type/3]). - --export([fetchTk/3, isArray/3, isBasicType/1, isBasicType/2, - isBasicType/3, isBasicTypeOrEterm/3, isEterm/3, isString/3, - isStruct/3, isUnion/3, name2type/2, searchIncludedTk/2, - searchInsideTks/2, searchTk/2, searchTk/3]). - -name2type(G, Name) -> - S = ic_genobj:tktab(G), - ScopedName = lists:reverse(string:tokens(Name,"_")), - InfoList = ets:lookup( S, ScopedName ), - filter( InfoList ). - - - -%% This is en overloaded function, -%% differs in input on unions -member2type(_G, X, I) when is_record(X, union)-> - Name = ic_forms:get_id2(I), - case lists:keysearch(Name,2,element(6,X#union.tk)) of - false -> - error; - {value,Rec} -> - fetchType(element(3,Rec)) - end; -member2type( G, SName, MName ) -> - - S = ic_genobj:tktab( G ), - SNList = lists:reverse(string:tokens(SName,"_")), - ScopedName = [MName | SNList], - InfoList = ets:lookup( S, ScopedName ), - - case filter( InfoList ) of - error -> - %% Try a little harder, seeking inside tktab - case lookup_member_type_in_tktab(S, ScopedName, MName) of - error -> - %% Check if this is the "return to return1" case - case MName of - "return1" -> - %% Do it all over again ! - ScopedName2 = ["return" | SNList], - InfoList2 = ets:lookup( S, ScopedName2 ), - case filter( InfoList2 ) of - error -> - %% Last resort: seek in pragma table - lookup_type_in_pragmatab(G, SName); - - Other -> - Other - end; - _ -> - %% Last resort: seek in pragma table - lookup_type_in_pragmatab(G, SName) - end; - Other -> - Other - end; - Other -> - Other - end. - - -lookup_member_type_in_tktab(S, ScopedName, MName) -> - case ets:match_object(S, {'_',member,{MName,'_'},nil}) of - [] -> - error; - [{_FullScopedName,member,{MName,TKInfo},nil}]-> - fetchType( TKInfo ); - List -> - lookup_member_type_in_tktab(List,ScopedName) - end. - -lookup_member_type_in_tktab([],_ScopedName) -> - error; -lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) -> - case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of - ScopedName -> - fetchType(TKInfo); - _ -> - lookup_member_type_in_tktab(Rest,ScopedName) - end. - - -lookup_type_in_pragmatab(G, SName) -> - S = ic_genobj:pragmatab(G), - - %% Look locally first - case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of - [] -> - %% No match, seek included - case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of - - [] -> - error; - [[Type]] -> - io:format("1 Found(~p) : ~p~n",[SName,Type]), - Type - end; - - [[Type]] -> - io:format("2 Found(~p) : ~p~n",[SName,Type]), - Type - end. - - - - -filter( [] ) -> - error; -filter( [I | Is ] ) -> - case I of - { _, member, { _, TKINFO }, _ } -> - fetchType( TKINFO ); - - { _, struct, _, _ } -> - struct; - - { _, typedef, TKINFO, _ } -> - fetchType( TKINFO ); - - { _, module, _, _ } -> - module; - - { _, interface, _, _ } -> - interface; - - { _, op, _, _ } -> - op; - - { _,enum, _, _ } -> - enum; - - { _, spellcheck } -> - filter( Is ); - - _ -> - error - end. - - -fetchType( { tk_sequence, _, _ } ) -> - sequence; -fetchType( { tk_array, _, _ } ) -> - array; -fetchType( { tk_struct, _, _, _} ) -> - struct; -fetchType( { tk_string, _} ) -> - string; -fetchType( tk_short ) -> - short; -fetchType( tk_long ) -> - long; -fetchType( tk_ushort ) -> - ushort; -fetchType( tk_ulong ) -> - ulong; -fetchType( tk_float ) -> - float; -fetchType( tk_double ) -> - double; -fetchType( tk_boolean ) -> - boolean; -fetchType( tk_char ) -> - char; -fetchType( tk_octet ) -> - octet; -fetchType( { tk_enum, _, _, _ } ) -> - enum; -fetchType( { tk_union, _, _, _, _, _ } ) -> - union; -fetchType( tk_any ) -> - any; -fetchType( _ ) -> - error. - -isBasicTypeOrEterm(G, N, S) -> - case isBasicType(G, N, S) of - true -> - true; - false -> - isEterm(G, N, S) - end. - - -isEterm(G, N, S) when element(1, S) == scoped_id -> - {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of - "erlang_term" -> - true; - "ETERM*" -> - true; - _X -> - false - end; -isEterm(_G, _Ni, _X) -> - false. - -isBasicType(G, N, S) when element(1, S) == scoped_id -> - {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - isBasicType(fetchType(TK)); -isBasicType(_G, _N, {string, _} ) -> - false; -isBasicType(_G, _N, {Type, _} ) -> - isBasicType(Type). - - -isBasicType(G, Name) -> - isBasicType(name2type(G, Name )). - - -isBasicType(Type) -> - lists:member(Type, - [tk_short,short, - tk_long,long, - tk_ushort,ushort, - tk_ulong,ulong, - tk_float,float, - tk_double,double, - tk_boolean,boolean, - tk_char,char, - tk_octet,octet]). - - - -isString(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_string',_}, _} -> - true; - _ -> - false - end; -isString(_G, _N, T) when is_record(T, string) -> - true; -isString(_G, _N, _Other) -> - false. - - -isArray(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_array', _, _}, _} -> - true; - _ -> - false - end; -isArray(_G, _N, T) when is_record(T, array) -> - true; -isArray(_G, _N, _Other) -> - false. - - - -isStruct(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_struct', _, _, _}, _} -> - true; - _ -> - false - end; -isStruct(_G, _N, T) when is_record(T, struct) -> - true; -isStruct(_G, _N, _Other) -> - false. - - - -isUnion(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} -> - true; - _Other -> - false - end; -isUnion(_G, _N, T) when is_record(T, union) -> - true; -isUnion(_G, _N, _Other) -> - false. - - - -%%------------------------------------------------------------ -%% -%% Always fetchs TK of a record. -%% -%%------------------------------------------------------------ -fetchTk(G,N,X) -> - case ic_forms:get_tk(X) of - undefined -> - searchTk(G,ictk:get_IR_ID(G, N, X)); - TK -> - TK - end. - - -%%------------------------------------------------------------ -%% -%% seek type code when not accessible by get_tk/1 -%% -%%------------------------------------------------------------ -searchTk(G,IR_ID) -> - S = ic_genobj:tktab(G), - case catch searchTk(S,IR_ID,typedef) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch searchTk(S,IR_ID,struct) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch searchTk(S,IR_ID,union) of - {value,TK} -> - TK; - _ -> - undefined - end - end - end. - - -searchTk(S,IR_ID,Type) -> - L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), - case lists:keysearch(IR_ID,2,L) of - {value,TK} -> - {value,TK}; - false -> - searchInsideTks(L,IR_ID) - end. - - -searchInsideTks([],_IR_ID) -> - false; -searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) -> - case searchIncludedTk(TK,IR_ID) of - {value,TK} -> - {value,TK}; - false -> - searchInsideTks(Xs,IR_ID) - end. - - -searchIncludedTk({tk_array,TK,_},IR_ID) -> - searchIncludedTk(TK,IR_ID); -searchIncludedTk({tk_sequence,TK,_},IR_ID) -> - searchIncludedTk(TK,IR_ID); -searchIncludedTk(TK,_IR_ID) when is_atom(TK) -> - false; -searchIncludedTk(TK,IR_ID) -> - case element(2,TK) == IR_ID of - true -> - {value,TK}; - false -> - false - end. - - - - - - - - - - - diff --git a/lib/ic/src/ic_file.erl b/lib/ic/src/ic_file.erl deleted file mode 100644 index 688a777400..0000000000 --- a/lib/ic/src/ic_file.erl +++ /dev/null @@ -1,448 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - --module(ic_file). - --include_lib("ic/src/ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([filename_push/4, filename_pop/2, open/2, close/1, remove_ext/1, join/2, - add_dot_erl/1, add_dot_hrl/1, add_dot_c/1, add_dot_h/1, add_dot_java/1, - add_dot_idl/1, javaInterfaceFilePush/3, javaInterfaceFilePop/1, - createDirectory/2, createJavaDirectory/2, open_java_file/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: filename_push -%% -%% Pushes a file name, can also push ignore in which case means that -%% no files should ever be opened at this scope. Note that empty in -%% the file descriptor entries means that the file just isn't open -%% yet. -%%----------------------------------------------------------------- -filename_push(G, _N, ignore, _) -> - G#genobj{stubfile=[ignore | G#genobj.stubfile], - stubfiled=[ignore | G#genobj.stubfiled], - skelfile=[ignore | G#genobj.skelfile], - skelfiled=[ignore | G#genobj.skelfiled], - includefile=[ignore | G#genobj.includefile], - includefiled=[ignore | G#genobj.includefiled]}; - -filename_push(G, N, X, Lang) -> - Fullname = [ic_forms:get_id2(X) | N], - EName0 = ic_util:to_undersc(Fullname), - - DoGen = ic_genobj:do_gen(G), - - ImplName = find_impl_name(G, Fullname), - - {StubName, EName} = - case Lang of - erlang -> - {join(ic_options:get_opt(G, stubdir), add_dot_erl(EName0)), - EName0}; - erlang_template -> - {join(ic_options:get_opt(G, stubdir), add_dot_erl(ImplName)), - ImplName}; - c -> - {join(ic_options:get_opt(G, stubdir), add_dot_c(EName0)), - EName0}; - c_server -> - {join(ic_options:get_opt(G, stubdir), add_dot_c(EName0++"__s")), - EName0}; - erlang_template_no_gen -> - {undefined, EName0}; - erlang_no_stub -> - {undefined, EName0}; - c_no_stub -> - {undefined, EName0}; - c_server_no_stub -> - {undefined, EName0} - end, - Stub = if DoGen==true -> - case StubName of - undefined -> - ignore; - _ -> - ic_codegen:emit_stub_head(G, open(empty, StubName), EName, Lang) - end; - true -> ignore end, - - HrlName = case Lang of - erlang_template -> - ignore; - erlang_template_no_gen -> - ignore; - erlang -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), add_dot_hrl(EName)), - ignore); - c -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), add_dot_h(EName)), - ignore); - c_server -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), - add_dot_h(EName++"__s")), - ignore); - erlang_no_stub -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), add_dot_hrl(EName)), - ignore); - c_no_stub -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), add_dot_h(EName)), - ignore); - c_server_no_stub -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), - add_dot_h(EName++"__s")), - ignore) - end, - Hrl = if DoGen==true -> - case Lang of - erlang_template -> - ignore; - erlang_template_no_gen -> - ignore; - erlang_no_stub -> - ic_codegen:emit_hrl_head(G, open(empty, HrlName), - EName, erlang); - c_no_stub -> - ic_codegen:emit_hrl_head(G, open(empty, HrlName), - EName, c); - c_server_no_stub -> - ic_codegen:emit_hrl_head(G, open(empty, HrlName), - EName, c_server); - _ -> - ic_codegen:emit_hrl_head(G, open(empty, HrlName), - EName, Lang) - end; - true -> ignore end, - - G#genobj{impl=ImplName, - stubfile=[StubName | G#genobj.stubfile], - stubfiled=[Stub | G#genobj.stubfiled], - includefile=[HrlName | G#genobj.includefile], - includefiled=[Hrl | G#genobj.includefiled]}. - -%%----------------------------------------------------------------- -%% Func: join/2 -%% -%% Special version of filename join. -%%----------------------------------------------------------------- -join([], File) -> - File; -join(Path, File) -> - filename:join(Path, File). - - -%%----------------------------------------------------------------- -%% Func: filename_pop/2 -%%----------------------------------------------------------------- -filename_pop(G, Lang) -> -%% io:format("Popped file names: ~p~n", [hd(G#genobj.stubfile)]), -%% case is_skelfile_open(G) of -%% true -> emit_skel_footer(G); -%% false -> ok end, -%% close(hd(G#genobj.skelfiled)), - close(hd(G#genobj.stubfiled)), - ic_codegen:emit_hrl_foot(G, Lang), - close(hd(G#genobj.includefiled)), - G#genobj{stubfile=tl(G#genobj.stubfile), - stubfiled=tl(G#genobj.stubfiled), -%% skelfile=tl(G#genobj.skelfile), -%% skelfiled=tl(G#genobj.skelfiled), - includefile=tl(G#genobj.includefile), - includefiled=tl(G#genobj.includefiled)}. - - - -%%----------------------------------------------------------------- -%% Func: javaInterfaceFilePush/3 -%%----------------------------------------------------------------- -javaInterfaceFilePush(G, N, X) -> - Name = ic_forms:get_java_id(X), - {InterfaceFd, InterfaceFileName} = open_java_file(G, N, Name), - - StubClassName = "_" ++ Name ++ "Stub", - {StubFd, StubFileName} = open_java_file(G, N, StubClassName), - - SkelClassName = "_" ++ Name ++ "ImplBase", - {SkelFd, SkelFileName} = open_java_file(G, N, SkelClassName), - - HelperClassName = Name ++ "Helper", - {HelperFd, HelperFileName} = open_java_file(G, N, HelperClassName), - - HolderClassName = Name ++ "Holder", - {HolderFd, HolderFileName} = open_java_file(G, N, HolderClassName), - - G#genobj{ - interfacefile=[InterfaceFileName | G#genobj.interfacefile], - interfacefiled=[InterfaceFd | G#genobj.interfacefiled], - stubfile=[StubFileName | G#genobj.stubfile], - stubfiled=[StubFd | G#genobj.stubfiled], - skelfile=[SkelFileName | G#genobj.skelfile], - skelfiled=[SkelFd | G#genobj.skelfiled], - helperfile=[HelperFileName | G#genobj.helperfile], - helperfiled=[HelperFd | G#genobj.helperfiled], - holderfile=[HolderFileName | G#genobj.holderfile], - holderfiled=[HolderFd | G#genobj.holderfiled]}. - - - - - -%%----------------------------------------------------------------- -%% Func: javaInterfaceFilePop/1 -%%----------------------------------------------------------------- -javaInterfaceFilePop(G) -> - close(hd(G#genobj.interfacefiled)), - close(hd(G#genobj.stubfiled)), - close(hd(G#genobj.skelfiled)), - close(hd(G#genobj.helperfiled)), - close(hd(G#genobj.holderfiled)), - G#genobj{ - interfacefile=tl(G#genobj.interfacefile), - interfacefiled=tl(G#genobj.interfacefiled), - stubfile=tl(G#genobj.stubfile), - stubfiled=tl(G#genobj.stubfiled), - skelfile=tl(G#genobj.skelfile), - skelfiled=tl(G#genobj.skelfiled), - helperfile=tl(G#genobj.helperfile), - helperfiled=tl(G#genobj.helperfiled), - holderfile=tl(G#genobj.holderfile), - holderfiled=tl(G#genobj.holderfiled)}. - -%%----------------------------------------------------------------- -%% Func: createDirectory/2 -%%----------------------------------------------------------------- -createDirectory(_G, []) -> - ok; -createDirectory(G, Scope) -> - Path = ic_file:join(ic_options:get_opt(G, stubdir), ic_pragma:slashify(Scope)), - case file:make_dir(Path) of - ok -> - ok; - {error, eexist} -> - ok; - {error, Reason} -> - ic_error:fatal_error(G, {create_dir, Path, Reason}) - end. - - -%%----------------------------------------------------------------- -%% Func: createJavaDirectory/2 -%%----------------------------------------------------------------- -createJavaDirectory(_G, []) -> - ok; -createJavaDirectory(G, Scope) -> - JavaScope = ic_util:adjustScopeToJava(G,Scope), - Path = ic_file:join(ic_options:get_opt(G, stubdir), ic_pragma:slashify(JavaScope)), - case file:make_dir(Path) of - ok -> - ok; - {error, eexist} -> - ok; - {error, Reason} -> - ic_error:fatal_error(G, {create_dir, Path, Reason}) - end. - - - - -%%----------------------------------------------------------------- -%% Func: createJavaFileName/3 -%%----------------------------------------------------------------- -createJavaFileName(G, Scope, FName) -> - JavaScope = ic_util:adjustScopeToJava(G,Scope), - join(ic_options:get_opt(G, stubdir), - ic_pragma:slashify([FName++".java"|JavaScope])). - -%%----------------------------------------------------------------- -%% Func: close/2 (used to be file_close) -%%----------------------------------------------------------------- -close(empty) -> ok; -close(ignore) -> ok; -close(Fd) -> - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: remove_ext/1 -%%----------------------------------------------------------------- -remove_ext(File) -> - filename:rootname(filename:basename(File)). - -%%----------------------------------------------------------------- -%% Func: open/2 (used to be file_open) -%%----------------------------------------------------------------- -open(_, ignore) -> ignore; -open(empty, Name) -> - case file:open(Name, [raw, binary, write]) of - {ok, Fd} -> - Fd; - {error, Reason} -> - exit({error, Reason}) -%% ic_error:fatal_error(G, {open_file, Name, Reason}) - end. - -%%----------------------------------------------------------------- -%% Func: open_java_file/3 -%%----------------------------------------------------------------- -open_java_file(G, N, Name) -> - createJavaDirectory(G, N), - FName = createJavaFileName(G, N, Name), - case file:open(FName, [raw, binary, write]) of - {ok, Fd} -> - ic_codegen:emit_stub_head(G, Fd, Name, java), - emit_package(G, N, Fd), - {Fd, FName}; - {error, Reason} -> - ic_error:fatal_error(G, {open_file, FName, Reason}) - end. - -%%----------------------------------------------------------------- -%% Func: emit_package/3 -%%----------------------------------------------------------------- -emit_package(_G, [], _Fd) -> - ok; -emit_package(G, N, Fd) -> - ic_codegen:emit(Fd, "package ~s;\n", [ic_util:to_dot(G,N)]), - ic_codegen:nl(Fd). - -%%----------------------------------------------------------------- -%% Func: add_dot_erl/1 -%%----------------------------------------------------------------- -add_dot_erl(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$l, $r, $e, $. | _Rest] -> - File; - _ -> - File ++ ".erl" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_hrl/1 -%%----------------------------------------------------------------- -add_dot_hrl(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$l, $r, $h, $. | _Rest] -> - File; - _ -> - File ++ ".hrl" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_c/1 -%%----------------------------------------------------------------- -add_dot_c(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$c, $. | _Rest] -> - File; - _ -> - File ++ ".c" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_h/1 -%%----------------------------------------------------------------- -add_dot_h(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$h, $. | _Rest] -> - File; - _ -> - File ++ ".h" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_java/1 -%%----------------------------------------------------------------- -add_dot_java(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$a, $v, $a, $j, $. | _Rest] -> - File; - _ -> - File ++ ".java" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_idl/1 -%%----------------------------------------------------------------- -add_dot_idl(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$l, $d, $i, $. | _Rest] -> - File; - _ -> - File ++ ".idl" - end. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% File handling stuff -%% -%% -%% Shall open a file for writing. Also sets up the generator with -%% usefull bits of information -%% -%%-------------------------------------------------------------------- -find_impl_name(G, Name) -> - N1 = ic_util:to_colon(Name), - N2 = ic_util:to_undersc(Name), - case {ic_options:get_opt(G, {impl, N1}), - ic_options:get_opt(G, {impl, N2})} of - {false, false} -> - case {ic_options:get_opt(G, {impl, "::"++N1}), - ic_options:get_opt(G, {impl, N2})} of - {false, false} -> N2 ++ "_impl"; - {X, _Y} when X /= false -> ic_util:to_list(X); - {_X, Y} when Y /= false -> ic_util:to_list(Y) - end; - {X, _Y} when X /= false -> ic_util:to_list(X); - {_X, Y} when Y /= false -> ic_util:to_list(Y) - end. diff --git a/lib/ic/src/ic_forms.erl b/lib/ic/src/ic_forms.erl deleted file mode 100644 index ed4b3e9a22..0000000000 --- a/lib/ic/src/ic_forms.erl +++ /dev/null @@ -1,442 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_forms). - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([get_id/1, get_id2/1, get_java_id/1, get_line/1]). --export([get_type_code/3, search_tk/2, clean_up_scope/1]). --export([get_body/1, get_dimension/1, get_idlist/1, get_type/1, get_tk/1, is_oneway/1]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% Generation go-get utilities -%% -%% Feeble attempt at virtual funtions. -%% -%%-------------------------------------------------------------------- - -get_dimension(X) when is_record(X, array) -> - [element(3, L) || L <- X#array.size]. - -%% Should find the name hidden in constructs -get_id( [{'<identifier>', _LineNo, Id}] ) -> Id; -get_id( {'<identifier>', _LineNo, Id} ) -> Id; -get_id(Id) when is_list(Id) andalso is_integer(hd(Id)) -> Id; -get_id(X) when is_record(X, scoped_id) -> X#scoped_id.id; -get_id(X) when is_record(X, array) -> get_id(X#array.id); -get_id( {'<string_literal>', _LineNo, Id} ) -> Id; -get_id( {'<wstring_literal>', _LineNo, Id} ) -> Id. - -get_line([{'<identifier>', LineNo, _Id}]) -> LineNo; -get_line({'<identifier>', LineNo, _Id}) -> LineNo; -get_line(X) when is_record(X, scoped_id) -> X#scoped_id.line; -get_line(X) when is_record(X, module) -> get_line(X#module.id); -get_line(X) when is_record(X, interface) -> get_line(X#interface.id); -get_line(X) when is_record(X, forward) -> get_line(X#forward.id); -get_line(X) when is_record(X, constr_forward) -> get_line(X#constr_forward.id); -get_line(X) when is_record(X, const) -> get_line(X#const.id); -get_line(X) when is_record(X, typedef) -> get_line(X#typedef.id); -get_line(X) when is_record(X, struct) -> get_line(X#struct.id); -get_line(X) when is_record(X, member) -> get_line(X#member.id); -get_line(X) when is_record(X, union) -> get_line(X#union.id); -get_line(X) when is_record(X, case_dcl) -> get_line(X#case_dcl.id); -get_line(X) when is_record(X, enum) -> get_line(X#enum.id); -get_line(X) when is_record(X, enumerator) -> get_line(X#enumerator.id); -get_line(X) when is_record(X, array) -> get_line(X#array.id); -get_line(X) when is_record(X, attr) -> get_line(X#attr.id); -get_line(X) when is_record(X, except) -> get_line(X#except.id); -get_line(X) when is_record(X, op) -> get_line(X#op.id); -get_line(X) when is_record(X, param) -> get_line(X#param.id); -get_line(X) when is_record(X, id_of) -> get_line(X#id_of.id); - -get_line({'or', T1, _T2}) -> get_line(T1); -get_line({'xor', T1, _T2}) -> get_line(T1); -get_line({'and', T1, _T2}) -> get_line(T1); -get_line({'rshift', T1, _T2}) ->get_line(T1); -get_line({'lshift', T1, _T2}) ->get_line(T1); -get_line({'+', T1, _T2}) -> get_line(T1); -get_line({'-', T1, _T2}) -> get_line(T1); -get_line({'*', T1, _T2}) -> get_line(T1); -get_line({'/', T1, _T2}) -> get_line(T1); -get_line({'%', T1, _T2}) -> get_line(T1); -get_line({{'-', _Line}, T}) -> get_line(T); -get_line({{'+', _Line}, T}) -> get_line(T); -get_line({{'~', _Line}, T}) -> get_line(T); -get_line({_, X, _}) when is_integer(X) -> X; -get_line({_A, N}) when is_integer(N) -> N; -get_line(_) -> -1. - - -%%-------------------------------------------------------------------- -%% -%% High level get functions. -%% -%% These are highly polymorphic functions that will get the id, -%% body and type of a record (those records output from the -%% parser). -%% -%% NOTE: The typedef node (the alias) is special, because the type -%% field is a type definition and therefore considered a body, -%% and the type of a typedef is its name. -%% - -get_id2(X) when is_record(X, module) -> get_id(X#module.id); -get_id2(X) when is_record(X, interface) -> get_id(X#interface.id); -get_id2(X) when is_record(X, forward) -> get_id(X#forward.id); -get_id2(X) when is_record(X, constr_forward) -> get_id(X#constr_forward.id); -get_id2(X) when is_record(X, const) -> get_id(X#const.id); -get_id2(X) when is_record(X, typedef) -> get_id(hd(X#typedef.id)); -get_id2(X) when is_record(X, struct) -> get_id(X#struct.id); -get_id2(X) when is_record(X, member) -> get_id(hd(X#member.id)); -get_id2(X) when is_record(X, union) -> get_id(X#union.id); -get_id2(X) when is_record(X, case_dcl) -> get_id(X#case_dcl.id); -get_id2(X) when is_record(X, enum) -> get_id(X#enum.id); -get_id2(X) when is_record(X, enumerator) -> get_id(X#enumerator.id); -get_id2(X) when is_record(X, array) -> get_id(X#array.id); -get_id2(X) when is_record(X, attr) -> get_id(X#attr.id); -get_id2(X) when is_record(X, except) -> get_id(X#except.id); -get_id2(X) when is_record(X, op) -> get_id(X#op.id); -get_id2(X) when is_record(X, param) -> get_id(X#param.id); -get_id2(X) when is_record(X, type_dcl) -> get_id2(X#type_dcl.type); -get_id2(X) when is_record(X, scoped_id) -> ic_symtab:scoped_id_strip(X); -get_id2(X) when is_record(X, preproc) -> get_id(X#preproc.id); -get_id2(X) when is_record(X, id_of) -> get_id2(X#id_of.id); -get_id2(X) -> get_id(X). - -get_body(X) when is_record(X, module) -> X#module.body; -get_body(X) when is_record(X, interface) -> X#interface.body; -get_body(X) when is_record(X, struct) -> X#struct.body; -get_body(X) when is_record(X, union) -> X#union.body; -get_body(X) when is_record(X, enum) -> X#enum.body; -get_body(X) when is_record(X, typedef) -> X#typedef.type; % See Note -get_body(X) when is_record(X, except) -> X#except.body. - -get_type(X) when is_record(X, const) -> X#const.type; -get_type(X) when is_record(X, type_dcl) -> X#type_dcl.type; -get_type(X) when is_record(X, typedef) -> X#typedef.id; % See Note -get_type(X) when is_record(X, member) -> X#member.type; -get_type(X) when is_record(X, union) -> X#union.type; -get_type(X) when is_record(X, case_dcl) -> X#case_dcl.type; -get_type(X) when is_record(X, sequence) -> X#sequence.type; -get_type(X) when is_record(X, attr) -> X#attr.type; -get_type(X) when is_record(X, op) -> X#op.type; -get_type(X) when is_record(X, param) -> X#param.type. -%%get_type(X) when record(X, id_of) -> get_type(X#id_of.type). - -%% Temporary place -get_tk(X) when is_record(X, interface) -> X#interface.tk; -get_tk(X) when is_record(X, forward) -> X#forward.tk; -get_tk(X) when is_record(X, constr_forward) -> X#constr_forward.tk; -get_tk(X) when is_record(X, const) -> X#const.tk; -get_tk(X) when is_record(X, type_dcl) -> X#type_dcl.tk; -get_tk(X) when is_record(X, typedef) -> X#typedef.tk; -get_tk(X) when is_record(X, struct) -> X#struct.tk; -get_tk(X) when is_record(X, union) -> X#union.tk; -get_tk(X) when is_record(X, enum) -> X#enum.tk; -get_tk(X) when is_record(X, attr) -> X#attr.tk; -get_tk(X) when is_record(X, except) -> X#except.tk; -get_tk(X) when is_record(X, op) -> X#op.tk; -get_tk(X) when is_record(X, id_of) -> X#id_of.tk; -get_tk(X) when is_record(X, param) -> X#param.tk. - - -%% Get idlist returns the list of identifiers found in typedefs, case -%% dcls etc. -get_idlist(X) when is_record(X, typedef) -> X#typedef.id; -get_idlist(X) when is_record(X, member) -> X#member.id; -get_idlist(X) when is_record(X, case_dcl) -> X#case_dcl.label; -get_idlist(X) when is_record(X, attr) -> X#attr.id. - - -is_oneway(X) when is_record(X, op) -> - case X#op.oneway of - {oneway, _} -> true; - _ -> false - end; -is_oneway(_X) -> false. - - - - - -%%------------------------------------------------------------ -%% -%% Analyze the record and seek the correct type code. -%% -%% NOT equal to get_tk, this will always succed ! -%% -%%------------------------------------------------------------ -get_type_code(G, N, X) -> - case get_type_code2(G, N, X) of - undefined -> - %% Remove "Package" suffix from scope - N2 = clean_up_scope(N), - search_tk(G,ictk:get_IR_ID(G, N2, X)); - TC -> - TC - end. - -clean_up_scope(N) -> - clean_up_scope(N,[]). - -clean_up_scope([],N) -> - lists:reverse(N); -clean_up_scope([N|Ns],Found) -> - case lists:suffix("Package",N) of - true -> - Len = length(N), - case Len > 7 of - true -> - N2 = string:substr(N,1,Len-7), - clean_up_scope(Ns,[N2|Found]); - false -> - clean_up_scope(Ns,[N|Found]) - end; - false -> - clean_up_scope(Ns,[N|Found]) - end. - - -get_type_code2(_, _, X) when is_record(X, interface) -> X#interface.tk; -get_type_code2(_, _, X) when is_record(X, forward) -> X#forward.tk; -get_type_code2(_, _, X) when is_record(X, constr_forward) -> X#constr_forward.tk; -get_type_code2(_, _, X) when is_record(X, const) -> X#const.tk; -get_type_code2(_, _, X) when is_record(X, type_dcl) -> X#type_dcl.tk; -get_type_code2(_, _, X) when is_record(X, typedef) -> - Id = X#typedef.id, - ET = X#typedef.tk, - if is_list(Id) -> - Head = hd(Id), - if is_tuple(Head) -> - case element(1,Head) of - array -> - get_array_tc(ET, element(3,Head)); - _ -> - ET - end; - true -> - ET - end; - true -> - ET - end; - -get_type_code2(_, _, X) when is_record(X, struct) -> X#struct.tk; -get_type_code2(_, _, X) when is_record(X, union) -> X#union.tk; -get_type_code2(_, _, X) when is_record(X, enum) -> X#enum.tk; -get_type_code2(_, _, X) when is_record(X, attr) -> X#attr.tk; -get_type_code2(_, _, X) when is_record(X, except) -> X#except.tk; -get_type_code2(_, _, X) when is_record(X, op) -> X#op.tk; -get_type_code2(_, _, X) when is_record(X, id_of) -> X#id_of.tk; -get_type_code2(_, _, X) when is_record(X, param) -> X#param.tk; - -get_type_code2(G, N, X) when is_record(X, member) -> - ET = get_type_code(G, N, element(2,X)), - Id = element(3,X), - - if is_list(Id) -> - Head = hd(Id), - if is_tuple(Head) -> - case element(1,Head) of - array -> - get_array_tc(ET, element(3,Head)); - _ -> - ET - end; - true -> - ET - end; - true -> - ET - end; - -get_type_code2(G, N, X) when is_record(X, scoped_id) -> - element(3,ic_symtab:get_full_scoped_name(G, N, X)); - -get_type_code2(G, N, X) when is_record(X, sequence) -> - if is_tuple(X#sequence.length) -> - {tk_sequence, - get_type_code(G, N, X#sequence.type), - list_to_integer(element(3,X#sequence.length))}; - true -> - {tk_sequence, - get_type_code(G, N, X#sequence.type), - X#sequence.length} - end; - -get_type_code2(_G, _N, {unsigned,{short,_}}) -> tk_ushort; - -get_type_code2(_G, _N, {unsigned,{long,_}}) -> tk_ulong; - -get_type_code2(_G, _N, {unsigned,{'long long',_}}) -> tk_ulonglong; - -get_type_code2(_G, _N, X) when is_record(X, fixed) -> - {tk_fixed, X#fixed.digits, X#fixed.scale}; - -get_type_code2(G, N, {X,_}) -> - get_type_code2(G, N, X); - -get_type_code2(_, _, short) -> tk_short; -get_type_code2(_, _, long) -> tk_long; -get_type_code2(_, _, 'long long') -> tk_longlong; -get_type_code2(_, _, float) -> tk_float; -get_type_code2(_, _, double) -> tk_double; -get_type_code2(_, _, boolean) -> tk_boolean; -get_type_code2(_, _, char) -> tk_char; -get_type_code2(_, _, wchar) -> tk_wchar; -get_type_code2(_, _, octet) -> tk_octet; -get_type_code2(_, _, string) -> tk_string; -get_type_code2(_, _, wstring) -> tk_wstring; -get_type_code2(_, _, any) -> tk_any. - - -get_array_tc(ET, []) -> - ET; -get_array_tc(ET, [L|Ls]) -> - {tk_array, - get_array_tc(ET,Ls), - list_to_integer(element(3,L))}. - - - - -%%------------------------------------------------------------ -%% -%% seek type code when not accessible by ic_forms:get_tk/1 ( should be -%% a part of "do_gen" related functions later ) -%% -%%------------------------------------------------------------ -search_tk(G, IR_ID) -> - S = ic_genobj:tktab(G), - case catch search_tk(S,IR_ID,typedef) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch search_tk(S,IR_ID,struct) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch search_tk(S,IR_ID,union) of - {value,TK} -> - TK; - _ -> - undefined - end - end - end. - - -search_tk(S, IR_ID, Type) -> - L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), - case lists:keysearch(IR_ID,2,L) of - {value,TK} -> - {value,TK}; - false -> - search_inside_tks(L,IR_ID) - end. - - -search_inside_tks([],_IR_ID) -> - false; -search_inside_tks([{tk_array,TK,_}|Xs],IR_ID) -> - case search_included_tk(TK,IR_ID) of - {value,TK} -> - {value,TK}; - false -> - search_inside_tks(Xs,IR_ID) - end. - - -search_included_tk({tk_array,TK,_}, IR_ID) -> - search_included_tk(TK,IR_ID); -search_included_tk({tk_sequence,TK,_}, IR_ID) -> - search_included_tk(TK,IR_ID); -search_included_tk(TK, _IR_ID) when is_atom(TK) -> - false; -search_included_tk(TK, IR_ID) -> - case element(2,TK) == IR_ID of - true -> - {value,TK}; - false -> - false - end. - - - - -%% This is similar to get_id2 but in everything else -%% than a module it will generate an id prefixed -get_java_id(Id) when is_list(Id) -> - case java_keyword_coalition(Id) of - true -> - "_" ++ Id; - false -> - Id - end; -get_java_id(Id_atom) when is_atom(Id_atom) -> - Id = atom_to_list(Id_atom), - case java_keyword_coalition(Id) of - true -> - "_" ++ Id; - false -> - Id - end; -get_java_id(X) -> - Id = get_id2(X), - case java_keyword_coalition(Id) of - true -> - "_" ++ Id; - false -> - Id - end. - -java_keyword_coalition(Id) -> - lists:member(list_to_atom(Id), - [abstract, default, 'if', private, throw, boolean, - do, implements, protected, throws, break, - double, import, public, transient, byte, - else, instanceof, return, 'try', 'case', extends, - int, short, void, 'catch', final, interface, static, - volatile, char, finally, long, super, while, class, - float, native, switch, const, for, new, synchronized, - continue, goto, package, this, true, false]). - - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_genobj.erl b/lib/ic/src/ic_genobj.erl deleted file mode 100644 index eb2c24c000..0000000000 --- a/lib/ic/src/ic_genobj.erl +++ /dev/null @@ -1,245 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_genobj). - - --include_lib("ic/src/ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([new/1, free_table_space/1, process_space/0]). --export([skelfiled/1, stubfiled/1, hrlfiled/1, includefiled/1]). --export([interfacefiled/1, helperfiled/1, holderfiled/1]). --export([is_skelfile_open/1, is_stubfile_open/1, is_hrlfile_open/1]). --export([include_file/1, include_file_stack/1]). --export([push_file/2, pop_file/2, sys_file/2]). - --export([skelscope/1, stubscope/1, impl/1, do_gen/1]). --export([symtab/1, auxtab/1, tktab/1, pragmatab/1, optiontab/1, typedeftab/1]). --export([idlfile/1, module/1, set_idlfile/2, set_module/2]). - - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% Initialisation stuff -%% -%% -%% -%%-------------------------------------------------------------------- - - -new(Opts) -> - OptDB = ets:new(options, [set, public]), - Warns = ets:new(warnings, [set, public]), - Aux = ets:new(aux, [set, public]), - Tk = ets:new(tktab, [set, public]), - PragmaTab = ets:new(pragmatab, [bag, public]), - TypeDefTab = ets:new(c_typedeftab, [set, public]), - G = #genobj{options=OptDB, - warnings=Warns, - symtab=ic_symtab:new(), - auxtab=Aux, - tktab=Tk, - pragmatab=PragmaTab, - c_typedeftab=TypeDefTab}, - ic_error:init_errors(G), - ic_options:add_opt(G, default_opts, true), - ic_options:read_cfg(G, Opts), % Read any config files - ic_options:add_opt(G, Opts, true), - ic_symtab:symtab_add_faked_included_types(G), % Add CORBA::<Types> that as if they - % were defined in an included file - case ic_options:get_opt(G, be) of - false -> - DefBE = ic_options:defaultBe(), - case ic_options:get_opt(G, multiple_be) of - false -> - ic_options:add_opt(G, be, DefBE), - G; - List -> - case lists:member(DefBE, List) of - true -> - %% Delete the default be from the list to avoid - %% generating it twice. - NewList = lists:delete(DefBE, List), - ic_options:add_opt(G, multiple_be, NewList), - ic_options:add_opt(G, be, DefBE), - G; - false -> - G - end - end; - _ -> - G - end. - - -%%-------------------------------------------------------------------- -%% -%% Table removal -%% -%% -%% -%%-------------------------------------------------------------------- - - -free_table_space(G) -> - %% Free ets tables - ets:delete(G#genobj.options), - ets:delete(G#genobj.symtab), - ets:delete(G#genobj.warnings), - ets:delete(G#genobj.auxtab), - ets:delete(G#genobj.tktab), - ets:delete(G#genobj.pragmatab), - ets:delete(G#genobj.c_typedeftab), - %% Close file descriptors - close_fd(G#genobj.skelfiled), - close_fd(G#genobj.stubfiled), - close_fd(G#genobj.interfacefiled), - close_fd(G#genobj.helperfiled), - close_fd(G#genobj.holderfiled), - close_fd(G#genobj.includefiled). - -close_fd([]) -> - ok; -close_fd([Fd|Fds]) -> - file_close(Fd), - close_fd(Fds). - -file_close(empty) -> ok; -file_close(ignore) -> ok; -file_close(Fd) -> - file:close(Fd). - - -%%-------------------------------------------------------------------- -%% -%% Process memory usage -%% -%% -%% -%%-------------------------------------------------------------------- - -process_space() -> - Pheap=4*element(2,element(2,lists:keysearch(heap_size,1,process_info(self())))), - Pstack=4*element(2,element(2,lists:keysearch(stack_size,1,process_info(self())))), - io:format("Process current heap = ~p bytes\n",[Pheap]), - io:format("Symbol current stack = ~p bytes\n",[Pstack]), - io:format("-----------------------------------------------\n"), - io:format("Totally used ~p bytes\n\n",[Pheap+Pstack]). - - - - - - -skelfiled(G) -> hd(G#genobj.skelfiled). -stubfiled(G) -> hd(G#genobj.stubfiled). -includefiled(G) -> hd(G#genobj.includefiled). -hrlfiled(G) -> hd(G#genobj.includefiled). -interfacefiled(G) -> hd(G#genobj.interfacefiled). -helperfiled(G) -> hd(G#genobj.helperfiled). -holderfiled(G) -> hd(G#genobj.holderfiled). - -include_file(G) -> hd(G#genobj.includefile). -include_file_stack(G) -> G#genobj.includefile. - -is_skelfile_open(G) -> - if hd(G#genobj.skelfiled) /= empty, hd(G#genobj.skelfiled) /= ignore - -> true; - true -> false - end. -is_stubfile_open(G) -> - if hd(G#genobj.stubfiled) /= empty, hd(G#genobj.stubfiled) /= ignore - -> true; - true -> false - end. - -is_hrlfile_open(G) -> - if hd(G#genobj.includefiled) /= empty, hd(G#genobj.includefiled) /= ignore - -> true; - true -> false - end. - -%%-------------------------------------------------------------------- -%% -%% Handling of pre processor file commands -%% -%%-------------------------------------------------------------------- - -push_file(G, Id) -> - New = G#genobj.filestack+1, - set_idlfile(G, Id), - G#genobj{filestack=New, do_gen=true_or_not(New)}. -pop_file(G, Id) -> - New = G#genobj.filestack-1, - set_idlfile(G, Id), - G#genobj{filestack=New, do_gen=true_or_not(New)}. -sys_file(G, _Id) -> G#genobj{sysfile=true}. - - -do_gen(G) -> G#genobj.do_gen. - -%%-------------------------------------------------------------------- -%% -%% Storage routines -%%i -%% The generator object G is used to store many usefull bits of -%% information so that the information doesn't need to get passed -%% around everywhere. -%% -%%-------------------------------------------------------------------- - - -skelscope(G) -> G#genobj.skelscope. -stubscope(G) -> G#genobj.stubscope. -symtab(G) -> G#genobj.symtab. -auxtab(G) -> G#genobj.auxtab. -tktab(G) -> G#genobj.tktab. -impl(G) -> G#genobj.impl. -pragmatab(G) -> G#genobj.pragmatab. -optiontab(G) -> G#genobj.options. -typedeftab(G) -> G#genobj.c_typedeftab. - -idlfile(G) -> ?lookup(G#genobj.options, idlfile). -module(G) -> ?lookup(G#genobj.options, module). - -set_idlfile(G, X) -> ?insert(G#genobj.options, idlfile, X). -set_module(G, X) -> ?insert(G#genobj.options, module, ic_forms:get_id(X)). - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- -true_or_not(X) when X < 2 -> - true; -true_or_not(_) -> - false. diff --git a/lib/ic/src/ic_java_type.erl b/lib/ic/src/ic_java_type.erl deleted file mode 100644 index 931aa92a8e..0000000000 --- a/lib/ic/src/ic_java_type.erl +++ /dev/null @@ -1,1214 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - --module(ic_java_type). - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([getType/3, getHolderType/3, - getParamType/4, inlinedTypes/2, - marshalFun/4, unMarshalFun/4, getFullType/4, - getFullType/3, getMarshalType/4, getUnmarshalType/4, - getdim/1]). --export([isBasicType/3, isBasicType/1]). --export([isIntegerType/3, isIntegerType/1]). --export([isTermType/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- -%%----------------------------------------------------------------- -%% Func: getType/3 -%%----------------------------------------------------------------- -getType(G, N, T) when is_record(T, scoped_id) -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ?ICPACKAGE ++ "Pid"; - "erlang.port" -> - ?ICPACKAGE ++ "Port"; - "erlang.ref" -> - ?ICPACKAGE ++ "Ref"; - "erlang.term" -> - ?ICPACKAGE ++ "Term"; - {enum, Type} -> - getType(G, N, Type); - Type -> - case TK of - {tk_array,_,_} -> - tk2type(G,N,T,TK); - {tk_sequence,_,_} -> - tk2type(G,N,T,TK); - tk_any -> - ?ICPACKAGE ++ "Any"; - _ -> - case isBasicType(G,N,TK) of - true -> - tk2type(G,N,T,TK); - false -> - Type %% Other types - end - end - end; - -getType(_G, _N, S) when is_list(S) -> - S; - -getType(_G, _N, T) when is_record(T, string) -> - "java.lang.String"; - -getType(_G, _N, T) when is_record(T, wstring) -> %% WSTRING - "java.lang.String"; - -getType(G, N, T) when is_record(T, struct) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); - -getType(G, N, T) when is_record(T, union) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); - -getType(G, N, T) when is_record(T, sequence) -> - getType(G, N, ic_forms:get_type(T)) ++ "[]"; - -getType(G, N, T) when is_record(T, enum) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); - -%% NOTE i am using the new isJavaElementaryType -%% to avoid members declared as keywords (except -%% all java elementary types) to be used as a -%% class -getType(G, N, T) when is_record(T, member) -> - Type = tk2type(G,N,T,ic_forms:get_type_code(G, N, T)), - case isJavaElementaryType(list_to_atom(Type)) of - true -> - Type; - false -> - Prefix = list_to_atom(lists:flatten(string:tokens(Type,"[]"))), - case isJavaElementaryType(Prefix) of %% Checks if Type is an array - %% of elementary java types - true -> - Type; - false -> - ic_forms:get_java_id(getType(G,N,ic_forms:get_type(T))) ++ - if is_record(hd(T#member.id),array) -> - arrayEmptyDim(hd(T#member.id)); - true -> - "" - end - end - end; - -getType(_G, _N, {boolean, _}) -> - "boolean"; - -getType(_G, _N, {octet, _}) -> - "byte"; - -getType(_G, _N, {void, _}) -> - "void"; - -getType(_G, _N, {unsigned, U}) -> - case U of - {short,_} -> - "short"; - {long,_} -> - "int"; - {'long long',_} -> - "long" - end; - -getType(_G, _N, {char, _}) -> - "char"; - -getType(_G, _N, {wchar, _}) -> %% WCHAR - "char"; - -getType(_G, _N, {short, _}) -> - "short"; - -getType(_G, _N, {long, _}) -> - "int"; - -getType(_G, _N, {'long long', _}) -> - "long"; - -getType(_G, _N, {float, _}) -> - "float"; - -getType(_G, _N, {double, _}) -> - "double"; - -getType(_G, _N, {any, _}) -> - ?ICPACKAGE ++ "Any". - - - - - - -%%----------------------------------------------------------------- -%% Func: getHolderType/3 -%%----------------------------------------------------------------- -getHolderType(G, N, T) when element(1, T) == scoped_id -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ?ICPACKAGE ++ "PidHolder"; - "erlang.port" -> - ?ICPACKAGE ++ "PortHolder"; - "erlang.ref" -> - ?ICPACKAGE ++ "RefHolder"; - "erlang.term" -> - ?ICPACKAGE ++ "TermHolder"; - {enum, Type} -> - getHolderType(G, N, Type); - - Type -> - case TK of - {'tk_struct', _, _, _} -> - Type ++ "Holder"; - - {'tk_union', _, _, _, _, _} -> - Type ++ "Holder"; - - {'tk_array', _ , _} -> - Type ++ "Holder"; - - {'tk_sequence', _ , _} -> - Type ++ "Holder"; - - {'tk_string', _} -> - ?ICPACKAGE ++ "StringHolder"; - - {'tk_wstring', _} -> %% WSTRING - ?ICPACKAGE ++ "StringHolder"; - - {'tk_enum', _, _, _} -> - Type ++ "Holder"; - - 'tk_boolean' -> - ?ICPACKAGE ++ "BooleanHolder"; - - 'tk_octet' -> - ?ICPACKAGE ++ "ByteHolder"; - - 'tk_ushort' -> - ?ICPACKAGE ++ "ShortHolder"; - - 'tk_ulong' -> - ?ICPACKAGE ++ "IntHolder"; - - 'tk_ulonglong' -> %% ULLONG - ?ICPACKAGE ++ "LongHolder"; - - 'tk_short' -> - ?ICPACKAGE ++ "ShortHolder"; - - 'tk_long' -> - ?ICPACKAGE ++ "IntHolder"; - - 'tk_longlong' -> - ?ICPACKAGE ++ "LongHolder"; %% LLONG - - 'tk_float' -> - ?ICPACKAGE ++ "FloatHolder"; - - 'tk_double' -> - ?ICPACKAGE ++ "DoubleHolder"; - - 'tk_char' -> - ?ICPACKAGE ++ "CharHolder"; - - 'tk_wchar' -> %% WCHAR - ?ICPACKAGE ++ "CharHolder"; - - 'tk_any' -> - ?ICPACKAGE ++ "AnyHolder"; - - _ -> - case isBasicType(G,N,TK) of - true -> - %% Faked the type ! - getHolderType(G, N, {list_to_atom(tk2type(G,N,T,TK)), -1}); - false -> - %%io:format("TK = ~p, Type = ~p\n",[TK,Type]), - ic_util:to_dot(G,FullScopedName) ++ "Holder" - end - end - end; - -getHolderType(G, N, S) when is_list(S) -> - ic_util:to_dot(G,[S|N]) ++ "Holder"; - -getHolderType(_G, _N, T) when is_record(T, string) -> - ?ICPACKAGE ++"StringHolder"; - -getHolderType(_G, _N, T) when is_record(T, wstring) -> %% WSTRING - ?ICPACKAGE ++"StringHolder"; - -getHolderType(G, N, T) when is_record(T, struct) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; - -getHolderType(G, N, T) when is_record(T, union) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; - -getHolderType(G, N, T) when is_record(T, array) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; - -getHolderType(G, N, T) when is_record(T, sequence) -> - getType(G, N, ic_forms:get_type(T)) ++ "Holder[]"; - -getHolderType(G, N, T) when is_record(T, enum) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; - -getHolderType(_G, _N, {boolean, _}) -> - ?ICPACKAGE ++"BooleanHolder"; - -getHolderType(_G, _N, {octet, _}) -> - ?ICPACKAGE ++"ByteHolder"; - -getHolderType(_G, _N, {void, _}) -> - "void"; - -getHolderType(_G, _N, {unsigned, U}) -> - case U of - {short,_} -> - ?ICPACKAGE ++"ShortHolder"; - {long,_} -> - ?ICPACKAGE ++"IntHolder"; - {'long long',_} -> - ?ICPACKAGE ++"LongHolder" - end; - -getHolderType(_G, _N, {char, _}) -> - ?ICPACKAGE ++"CharHolder"; - -getHolderType(_G, _N, {wchar, _}) -> %% WCHAR - ?ICPACKAGE ++"CharHolder"; - -getHolderType(_G, _N, {short, _}) -> - ?ICPACKAGE ++"ShortHolder"; - -getHolderType(_G, _N, {long, _}) -> - ?ICPACKAGE ++"IntHolder"; - -getHolderType(_G, _N, {'long long', _}) -> - ?ICPACKAGE ++"LongHolder"; - -getHolderType(_G, _N, {float, _}) -> - ?ICPACKAGE ++"FloatHolder"; - -getHolderType(_G, _N, {double, _}) -> - ?ICPACKAGE ++"DoubleHolder"; - -getHolderType(_G, _N, {any,_}) -> - ?ICPACKAGE ++ "AnyHolder". - - -%%----------------------------------------------------------------- -%% Func: getParamType/4 -%%----------------------------------------------------------------- -getParamType(G, N, S, in) -> - getType(G, N, S); -getParamType(G, N, S, ret) -> - getType(G, N, S); -getParamType(G, N, S, out) -> - getHolderType(G, N, S); -getParamType(G, N, S, inout) -> - getHolderType(G, N, S). - - -%%----------------------------------------------------------------- -%% Func: getUnmarshalType/4 -%%----------------------------------------------------------------- -getUnmarshalType(G, N, X, T) when element(1, T) == scoped_id -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ?ICPACKAGE ++ "PidHelper"; - "erlang.port" -> - ?ICPACKAGE ++ "PortHelper"; - "erlang.ref" -> - ?ICPACKAGE ++ "RefHelper"; - "erlang.term" -> - ?ICPACKAGE ++ "TermHelper"; - {enum, Type} -> - getUnmarshalType(G, N, X, Type); - Type -> - case TK of - {'tk_struct', _, _, _} -> - Type ++ "Helper"; - - {'tk_union', _, _, _, _, _} -> - Type ++ "Helper"; - - {'tk_sequence', _ , _} -> - Type ++ "Helper"; - - {'tk_array', _ , _} -> - Type ++ "Helper"; - - {'tk_enum', _, _, _} -> - Type ++ "Helper"; - - {'tk_string',_} -> - ?ERLANGPACKAGE ++ "OtpErlangString"; - - {'tk_wstring',_} -> %% WSTRING - ?ERLANGPACKAGE ++ "OtpErlangString"; - - 'tk_char' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_wchar' -> %% WCHAR - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_octet' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_ushort' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_ulong' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_ulonglong' -> %% ULLONG - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_short' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_long' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_longlong' -> %% LLONG - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_float' -> - ?ERLANGPACKAGE ++ "OtpErlangDouble"; - - 'tk_double' -> - ?ERLANGPACKAGE ++ "OtpErlangDouble"; - - 'tk_boolean' -> - ?ERLANGPACKAGE ++ "OtpErlangAtom"; - - 'tk_void' -> - ?ERLANGPACKAGE ++ "OtpErlangAtom"; - - 'tk_any' -> - ?ICPACKAGE ++ "AnyHelper"; - - _ -> - case isBasicType(G,N,TK) of - true -> - %% Faked the type ! - getUnmarshalType(G, N, X, {list_to_atom(tk2type(G,N,T,TK)), -1}); - false -> - ic_util:to_dot(G,FullScopedName) ++ "Helper" - end - end - end; - -getUnmarshalType(_G, _N, _X, S) when is_list(S) -> - S ++ "Helper"; - -getUnmarshalType(_G, _N, _X, T) when is_record(T, string) -> - ?ERLANGPACKAGE ++ "OtpErlangString"; - -getUnmarshalType(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING - ?ERLANGPACKAGE ++ "OtpErlangString"; - -getUnmarshalType(G, N, _X, T) when is_record(T, struct) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; - -getUnmarshalType(G, N, _X, T) when is_record(T, union) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; - -getUnmarshalType(G, N, X, T) when is_record(T, sequence) andalso - is_record(X, member) -> - ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ "Helper"; - -getUnmarshalType(G, N, X, T) when is_record(T, sequence) andalso - is_record(X, case_dcl) -> - ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ "Helper"; - -getUnmarshalType(G, N, X, T) when is_record(T, sequence) -> - getUnmarshalType(G, N, X, ic_forms:get_type(T)) ++ "Helper"; - -getUnmarshalType(G, N, X, T) when is_record(T, array) andalso - is_record(X, case_dcl) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; - -getUnmarshalType(G, N, _X, T) when is_record(T, enum) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getUnmarshalType(_G, _N, _X, {boolean, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangAtom"; - -getUnmarshalType(_G, _N, _X, {octet, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {void, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangAtom"; - -getUnmarshalType(_G, _N, _X, {unsigned, U}) -> - case U of - {short,_} -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - {long,_} -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - {'long long',_} -> - ?ERLANGPACKAGE ++ "OtpErlangLong" - end; - -getUnmarshalType(_G, _N, _X, {char, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {wchar, _}) -> %% WCHAR - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {short, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {long, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {'long long', _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {float, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangDouble"; - -getUnmarshalType(_G, _N, _X, {double, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangDouble"; - -getUnmarshalType(_G, _N, _X, {any, _}) -> - ?ICPACKAGE ++ "AnyHelper". - -%%----------------------------------------------------------------- -%% Func: getMarshalType/4 -%%----------------------------------------------------------------- -getMarshalType(G, N, X, T) when element(1, T) == scoped_id -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ?ICPACKAGE ++ "PidHelper"; - "erlang.port" -> - ?ICPACKAGE ++ "PortHelper"; - "erlang.ref" -> - ?ICPACKAGE ++ "RefHelper"; - "erlang.term" -> - ?ICPACKAGE ++ "TermHelper"; - {enum, Type} -> - getMarshalType(G, N, X, Type); - Type -> - case TK of - {'tk_struct', _, _, _} -> - Type ++ "Helper"; - - {'tk_union', _, _, _, _, _} -> - Type ++ "Helper"; - - {'tk_array', _ , _} -> - Type ++ "Helper"; - - {'tk_sequence', _ , _} -> - Type ++ "Helper"; - - {'tk_enum', _, _, _} -> - Type ++ "Helper"; - - {'tk_string',_} -> - "string"; - - {'tk_wstring',_} -> %% WSTRING - "string"; - - 'tk_char' -> - "char"; - - 'tk_wchar' -> %% WCHAR - "char"; - - 'tk_octet' -> - "byte"; - - 'tk_ushort' -> - "ushort"; - - 'tk_ulong' -> - "uint"; - - 'tk_ulonglong' -> %% ULLONG - "ulong"; - - 'tk_short' -> - "short"; - - 'tk_long' -> - "int"; - - 'tk_longlong' -> %% LLONG - "long"; - - 'tk_float' -> - "float"; - - 'tk_double' -> - "double"; - - 'tk_boolean' -> - "boolean"; - - 'tk_void' -> - "atom"; - - 'tk_any' -> - ?ICPACKAGE ++ "AnyHelper"; - - _ -> - case isBasicType(G,N,TK) of - true -> - %% Faked the type ! - getMarshalType(G, N, X, {list_to_atom(tk2type(G,N,T,TK)), -1}); - false -> - ic_util:to_dot(G,FullScopedName) ++ "Helper" - end - end - end; - -getMarshalType(_G, _N, _X, S) when is_list(S) -> - S ++ "Helper"; - -getMarshalType(_G, _N, _X, T) when is_record(T, string) -> - "string"; - -getMarshalType(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING - "string"; - -getMarshalType(G, N, _X, T) when is_record(T, struct) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getMarshalType(G, N, _X, T) when is_record(T, union) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getMarshalType(G, N, X, T) when is_record(T, array) andalso - is_record(X, case_dcl) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getMarshalType(G, N, X, T) when is_record(T, sequence) andalso - is_record(X, member) -> - ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ - "Helper"; - -getMarshalType(G, N, _X, T) when is_record(T, sequence) -> - getType(G, N, ic_forms:get_type(T)) ++ - "Helper"; - -getMarshalType(G, N, _X, T) when is_record(T, enum) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getMarshalType(_G, _N, _X, {boolean, _}) -> - "boolean"; - -getMarshalType(_G, _N, _X, {octet, _}) -> - "byte"; - -getMarshalType(_G, _N, _X, {void, _}) -> - ""; % <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - -getMarshalType(_G, _N, _X, {unsigned, U}) -> - case U of - {short,_} -> - "ushort"; - {long,_} -> - "uint"; - {'long long',_} -> - "ulong" - end; - -getMarshalType(_G, _N, _X, {short, _}) -> - "short"; -getMarshalType(_G, _N, _X, {long, _}) -> - "int"; -getMarshalType(_G, _N, _X, {'long long', _}) -> - "long"; -getMarshalType(_G, _N, _X, {float, _}) -> - "float"; -getMarshalType(_G, _N, _X, {double, _}) -> - "double"; -getMarshalType(_G, _N, _X, {char, _}) -> - "char"; -getMarshalType(_G, _N, _X, {wchar, _}) -> %% WCHAR - "char"; -getMarshalType(_G, _N, _X, {any, _}) -> - ?ICPACKAGE ++ "AnyHelper". - - - - -%%----------------------------------------------------------------- -%% Func: unMarshalFun/4 -%%----------------------------------------------------------------- -unMarshalFun(G, N, X, T) when element(1, T) == scoped_id -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ".read_pid()"; - "erlang.port" -> - ".read_port()"; - "erlang.ref" -> - ".read_ref()"; - "erlang.term" -> - ".read_term()"; - {enum, Type} -> - unMarshalFun(G, N, X, Type); - _Type -> - case isBasicType(G,N,TK) of - true -> - case TK of - {'tk_string',_} -> - ".read_string()"; - - {'tk_wstring',_} -> %% WSTRING - ".read_string()"; - - 'tk_boolean' -> - ".read_boolean()"; - - 'tk_octet' -> - ".read_byte()"; - - 'tk_ushort' -> - ".read_ushort()"; - - 'tk_ulong' -> - ".read_uint()"; - - 'tk_ulonglong' -> %% ULLONG - ".read_ulong()"; - - 'tk_short' -> - ".read_short()"; - - 'tk_long' -> - ".read_int()"; - - 'tk_longlong' -> %% LLONG - ".read_long()"; - - 'tk_float' -> - ".read_float()"; - - 'tk_double' -> - ".read_double()"; - - 'tk_char' -> - ".read_char()"; - - 'tk_wchar' -> %% WCHAR - ".read_char()"; - - _ -> - %% Faked the type ! - unMarshalFun(G, N, X, {list_to_atom(tk2type(G,N,X,TK)), -1}) - end; - false -> - ".unmarshal()" - end - end; - -unMarshalFun(_G, _N, _X, S) when is_list(S) -> - ".unmarshal()"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, string) -> - ".read_string()"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING - ".read_string()"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, struct) -> - ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangTuple)"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, union) -> - ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangTuple)"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, sequence) -> - ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlanglist)"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, enum) -> - ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangAtom)"; - -unMarshalFun(_G, _N, _X, {boolean, _}) -> - ".read_boolean()"; - -unMarshalFun(_G, _N, _X, {octet, _}) -> - ".read_byte()"; - -unMarshalFun(_G, _N, _X, {void, _}) -> - ""; - -unMarshalFun(_G, _N, _X, {unsigned, U}) -> - case U of - {short,_} -> - ".read_ushort()"; - {long,_} -> - ".read_uint()"; - {'long long',_} -> - ".read_ulong()" - end; - -unMarshalFun(_G, _N, _X, {short, _}) -> - ".read_short()"; -unMarshalFun(_G, _N, _X, {long, _}) -> - ".read_int()"; -unMarshalFun(_G, _N, _X, {'long long', _}) -> - ".read_long()"; -unMarshalFun(_G, _N, _X, {float, _}) -> - ".read_float()"; -unMarshalFun(_G, _N, _X, {double, _}) -> - ".read_double()"; -unMarshalFun(_G, _N, _X, {char, _}) -> - ".read_char()"; -unMarshalFun(_G, _N, _X, {wchar, _}) -> %% WCHAR - ".read_char()". - - - - - -%%----------------------------------------------------------------- -%% Func: getFullType/4 - /3 -%% -%% Note : Similar to the getType/3 with the major difference -%% thet on arrays and sequences it will also declare -%% their sizes. Used for "new" declarations -%% -%%----------------------------------------------------------------- - - -getFullType(G, N, X, T) when is_record(X, typedef) andalso is_record(T, array) -> - FullDim = - tk2FullType(G,N,X,ic_forms:get_tk(X)) ++ - getFullDim(G,N,T#array.size), - fixArrayDims(FullDim); - -getFullType(G, N, X, T) when is_record(X, member) andalso is_record(T, array) -> - FullDim = - getFullType(G, N, ic_forms:get_type(X)) ++ - getFullDim(G,N,T#array.size), - fixArrayDims(FullDim); - -getFullType(G, N, X, T) when is_record(X, case_dcl) andalso is_record(T, array) -> - FullDim = - getFullType(G, N, ic_forms:get_type(X)) ++ - getFullDim(G,N,T#array.size), - fixArrayDims(FullDim); - -getFullType(G, N, _X, T) -> - getFullType(G, N, T). - - - -getFullType(G, N, T) when is_record(T, scoped_id) -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - case TK of - {tk_array,_,_} -> - tk2FullType(G,N,T,TK); - {tk_sequence,_,_} -> - tk2FullType(G,N,T,TK); - _ -> - case isBasicType(G,N,TK) of - true -> - tk2FullType(G,N,T,TK); - false -> - %% Other types - ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)) - end - end; - -getFullType(G, N, T) when is_record(T, sequence) -> - fixSeqDims(getType(G,N,T),"_length"); - -getFullType(G, N, T) -> - getType(G, N, T). - - - -%% In order to make a legal declaration -%% of an assignable array, the dimensions -%% of empty array sequences are swifted to -%% the end of the type -fixArrayDims(Cs) -> - fixArrayDims(Cs,[],[]). - -fixArrayDims([],Fulls,Emptys) -> - lists:reverse(Fulls) ++ Emptys; -fixArrayDims([91,93|Rest],Fulls,Emptys) -> - fixArrayDims(Rest,Fulls,[91,93|Emptys]); -fixArrayDims([C|Rest],Fulls,Emptys) -> - fixArrayDims(Rest,[C|Fulls],Emptys). - - -%% In order to make a legal declaration -%% of an assignable array, the dimensions -%% of empty array of sequences are swifted -%% to the end of the type -fixSeqDims(Cs,Length) -> - fixSeqDims(Cs,Length,[]). - -fixSeqDims([],_Length,Found) -> - lists:reverse(Found); -fixSeqDims([91,93|Rest],Length,Found) when is_list(Length) -> - lists:reverse([93|lists:reverse(Length)] ++ - [91|Found]) ++ Rest; -fixSeqDims([C|Rest],Length,Found) -> - fixSeqDims(Rest,Length,[C|Found]). - - - -%%----------------------------------------------------------------- -%% Func: inlinedTypes/2 -%%----------------------------------------------------------------- -inlinedTypes(PkgName, Type) when is_record(Type, struct) -> - "_" ++ PkgName ++ "."; -inlinedTypes(PkgName, Type) when is_record(Type, union) -> - "_" ++ PkgName ++ "."; -inlinedTypes(PkgName, Type) when is_record(Type, enum) -> - "_" ++ PkgName ++ "."; -inlinedTypes(_, _) -> - "". - -%%----------------------------------------------------------------- -%% Func: marshalFun/4 -%%----------------------------------------------------------------- -marshalFun(G, N, X, Type) -> - case isBasicType(G, N, Type) of - true -> - ".write_" ++ getMarshalType(G, N, X, Type); - _ -> - getMarshalType(G, N, X, Type) ++ ".marshal" - end. - - -%%----------------------------------------------------------------- -%% Func: isBasicType/3 -%%----------------------------------------------------------------- -isBasicType(G, N, S) when element(1, S) == scoped_id -> - {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - isBasicType(ictype:fetchType(TK)); - -isBasicType(G, N, X) when is_record(X, member) -> - if is_record(hd(element(3,X)), array) -> - false; - true -> - isBasicType(G, N, element(2,X)) - end; - -isBasicType(_G, _N, {unsigned, {long, _}} ) -> - true; - -isBasicType(_G, _N, {unsigned, {short, _}} ) -> - true; - -isBasicType(_G, _N, {unsigned, {'long long', _}} ) -> - true; - -isBasicType(_G, _N, {'long long', _} ) -> - true; - -isBasicType(_G, _N, {Type, _} ) -> - isBasicType(Type); - -isBasicType(_G, _N, Type) -> - isBasicType(Type). - - -%%----------------------------------------------------------------- -%% Func: isBasicType/1 -%%----------------------------------------------------------------- - -isBasicType( Type ) -> - lists:member(Type, - [tk_short,short, - tk_long,long, - tk_longlong,longlong, %% LLONG - tk_ushort,ushort, - tk_ulong,ulong, - tk_ulonglong,ulonglong, %% ULLONG - tk_float,float, - tk_double,double, - tk_boolean,boolean, - tk_char,char, - tk_wchar,wchar, %% WCHAR - tk_octet,octet, - tk_wstring,wstring, %% WSTRING - tk_string,string]). - -%% returns true if the Type is a java elementary type -isJavaElementaryType( Type ) -> - lists:member(Type, - [byte, char, wchar, boolean, - int, short, long, 'long long', float, double]). - -%%----------------------------------------------------------------- -%% Func: isIntegerType/3 -%%----------------------------------------------------------------- -isIntegerType(G, N, S) when element(1, S) == scoped_id -> - {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - isIntegerType(ictype:fetchType(TK)); -isIntegerType(_G, _N, {unsigned, {long, _}} ) -> - true; -isIntegerType(_G, _N, {unsigned, {short, _}} ) -> - true; -isIntegerType(_G, _N, {unsigned, {'long long', _}} ) -> - true; -isIntegerType(_G, _N, {'long long', _} ) -> - true; -isIntegerType(_G, _N, {Type, _} ) -> - isIntegerType(Type); -isIntegerType(_G, _N, Type) -> - isIntegerType(Type). - -%%----------------------------------------------------------------- -%% Func: isIntegerType/1 -%%----------------------------------------------------------------- - -isIntegerType( Type ) -> - lists:member(Type, - [tk_short,short, - tk_long,long, - tk_longlong,longlong, %% LLONG - tk_ushort,ushort, - tk_ulong,ulong, - tk_ulonglong,ulonglong, %% ULLONG - tk_char,char, - tk_wchar,wchar, %% WCHAR - tk_octet,octet]). - - - -%%----------------------------------------------------------------- -%% Func: isTerm/3 -%%----------------------------------------------------------------- -isTermType(G, N, T) -> - case getType(G,N,T) of - "com.ericsson.otp.ic.Term" -> - true; - _ -> - false - end. - - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - - -%% Changes the typecode to the -%% corresponding "basic" type -tk2type(_G,_N,_X,{'tk_struct', _IFRId, "port", _ElementList}) -> - ?ICPACKAGE ++ "Port"; -tk2type(_G,_N,_X,{'tk_struct', _IFRId, "pid", _ElementList}) -> - ?ICPACKAGE ++ "Pid"; -tk2type(_G,_N,_X,{'tk_struct', _IFRId, "ref", _ElementList}) -> - ?ICPACKAGE ++ "Ref"; -tk2type(_G,_N,_X,{'tk_struct', _IFRId, "term", _ElementList}) -> - ?ICPACKAGE ++ "Term"; -tk2type(_G,_N,_X,{'tk_string', _}) -> - "java.lang.String"; -tk2type(_G,_N,_X,{'tk_wstring', _}) -> %% WSTRING - "java.lang.String"; -tk2type(G,N,X,{'tk_array', ElemTC, Dim}) -> - tkarr2decl(G,N,X,{'tk_array', ElemTC, Dim}); -tk2type(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}) -> - tkseq2decl(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}); -tk2type(G,N,_X,{'tk_struct', IFRId, Name, _ElementList}) -> - ScopedId= - lists:reverse(string:tokens(lists:nth(2,string:tokens(IFRId,":")),"/")), - - case ic_forms:clean_up_scope([Name|N]) of - ScopedId -> - %% Right path, use N instead - ic_util:to_dot(G,[Name|N]); - _ -> - %% Ugly work arround - ic_util:to_dot(G,ScopedId) - end; -tk2type(G,N,_X,{'tk_union', IFRId, Name, _, _, _ElementList}) -> - ScopedId= - lists:reverse(string:tokens(lists:nth(2,string:tokens(IFRId,":")),"/")), - - case ic_forms:clean_up_scope([Name|N]) of - ScopedId -> - %% Right path, use N instead - ic_util:to_dot(G,[Name|N]); - _ -> - %% Ugly work arround - ic_util:to_dot(G,ScopedId) - end; -tk2type(_G,_N,_X,{'tk_enum', _Id, Name, _ElementList}) -> - Name; -tk2type(_G,_N,_X,tk_void) -> - "void"; -tk2type(_G,_N,_X,tk_long) -> - "int"; -tk2type(_G,_N,_X,tk_longlong) -> %% LLONG - "long"; -tk2type(_G,_N,_X,tk_short) -> - "short"; -tk2type(_G,_N,_X,tk_ulong) -> - "int"; -tk2type(_G,_N,_X,tk_ulonglong) -> %% ULLONG - "long"; -tk2type(_G,_N,_X,tk_ushort) -> - "short"; -tk2type(_G,_N,_X,tk_float) -> - "float"; -tk2type(_G,_N,_X,tk_double) -> - "double"; -tk2type(_G,_N,_X,tk_boolean) -> - "boolean"; -tk2type(_G,_N,_X,tk_char) -> - "char"; -tk2type(_G,_N,_X,tk_wchar) -> %% WCHAR - "char"; -tk2type(_G,_N,_X,tk_octet) -> - "byte"; -tk2type(_G,_N,_X,tk_string) -> - "java.lang.String"; -tk2type(_G,_N,_X,tk_wstring) -> %% WSTRING - "java.lang.String"; -tk2type(_G,_N,_X,tk_any) -> - ?ICPACKAGE ++ "Any"; -tk2type(_G,_N,_X,tk_term) -> %% Term - ?ICPACKAGE ++ "Term". - -%% Changes the sequence typecode to the -%% corresponding "basic" structure -tkseq2decl(G,N,X,TKSeq) -> - tkseq2decl2(G,N,X,TKSeq,[],[]). - -tkseq2decl2(G,N,X,{tk_sequence,E,D},[],Ds) -> - tkseq2decl2(G,N,X,E,[],[D|Ds]); -tkseq2decl2(G,N,X,TkEl,[],Ds) -> - ElName = tk2type(G,N,X,TkEl), - ElName ++ getdim(Ds). - -%% Changes the array typecode to the -%% corresponding "basic" structure -tkarr2decl(G,N,X,TKArr) -> - tkarr2decl2(G,N,X,TKArr,[],[]). - -tkarr2decl2(G,N,X,{tk_array,E,D},[],Ds) -> - tkarr2decl2(G,N,X,E,[],[D|Ds]); -tkarr2decl2(G,N,X,TkEl,[],Ds) -> - ElName = tk2type(G,N,X,TkEl), - ElName ++ getdim(Ds). - -getdim([]) -> - ""; -getdim([_D|Ds]) -> - getdim(Ds) ++ "[]". - - - -%% Changes the typecode to the corresponding "basic" type -%% used for variable declarations where arrays and sequences -%% are declared with there full dimensions -tk2FullType(G,N,X,{'tk_array', ElemTC, Dim}) -> - tkarr2FullDecl(G,N,X,{'tk_array', ElemTC, Dim}); -tk2FullType(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}) -> - tkseq2FullDecl(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}); -tk2FullType(G,N,X,TK) -> - tk2type(G,N,X,TK). - - -%% Changes the sequence typecode to the -%% corresponding "basic" structure here -%% arrays and sequences are declared with -%% their full dimensions -tkseq2FullDecl(G,N,X,TKSeq) -> - tkseq2FullDecl2(G,N,X,TKSeq,[],[]). - -tkseq2FullDecl2(G,N,X,{tk_sequence,E,D},[],Ds) -> - tkseq2FullDecl2(G,N,X,E,[],[D|Ds]); -tkseq2FullDecl2(G,N,X,TkEl,[],Ds) -> - ElName = tk2FullType(G,N,X,TkEl), - ElName ++ getdim(Ds). - -%% Changes the array typecode to the -%% corresponding "basic" structure -tkarr2FullDecl(G,N,X,TKArr) -> - tkarr2FullDecl2(G,N,X,TKArr,[],[]). - -tkarr2FullDecl2(G,N,X,{tk_array,E,D},[],Ds) -> - tkarr2FullDecl2(G,N,X,E,[],[D|Ds]); -tkarr2FullDecl2(G,N,X,TkEl,[],Ds) -> - ElName = tk2FullType(G,N,X,TkEl), - ElName ++ getFullDim(G,N,Ds). - -getFullDim(_G,_N,[]) -> - ""; -getFullDim(G,N,[D|Ds]) when is_record(D,scoped_id) -> - {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), - "[" ++ ic_util:to_dot(G,FSN) ++ "]" ++ getFullDim(G,N,Ds); -getFullDim(G,N,[D|Ds]) when is_integer(D) -> - "[" ++ integer_to_list(D) ++ "]" ++ getFullDim(G,N,Ds); -getFullDim(G,N,[D|Ds]) when is_tuple(D) -> - "[" ++ ic_util:eval_java(G,N,D) ++ "]" ++ getFullDim(G,N,Ds). - - - -%% Constructs an array empty dimension string -%% used for array variable declaration -arrayEmptyDim(X) -> - arrayEmptyDim2(X#array.size). - -arrayEmptyDim2([_D]) -> - "[]"; -arrayEmptyDim2([_D |Ds]) -> - "[]" ++ arrayEmptyDim2(Ds). - - - diff --git a/lib/ic/src/ic_jbe.erl b/lib/ic/src/ic_jbe.erl deleted file mode 100644 index 56518a681b..0000000000 --- a/lib/ic/src/ic_jbe.erl +++ /dev/null @@ -1,1488 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - - --module(ic_jbe). - - --export([do_gen/3, gen/3, emit_type_function/4]). - - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). --include_lib("stdlib/include/erl_compile.hrl"). - - - -%%------------------------------------------------------------ -%% -%% Entry point -%% -%%------------------------------------------------------------ - -do_gen(G, _File, Form) -> - gen(G, [], Form). - - -%%------------------------------------------------------------ -%% -%% Generate the client side C stubs. -%% -%% Each module is generated to a separate file. -%% -%% Each function needs to generate a function head and -%% a body. IDL parameters must be converted into C parameters. -%% -%%------------------------------------------------------------ - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, module) -> - gen_module(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, interface) -> - gen_interface(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, const) -> - ic_constant_java:gen(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, op) -> - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, attr) -> - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, except) -> - gen_exception(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, enum) -> - ic_enum_java:gen(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, struct) -> - ic_struct_java:gen(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, union) -> - ic_union_java:gen(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, typedef) -> - gen_typedef(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, member) -> - %%?PRINTDEBUG2("gen member: ~p\n",[ic_forms:get_type(X)]), - gen_member(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, case_dcl) -> - %%?PRINTDEBUG2("gen case decl: ~p\n",[ic_forms:get_type(X)]), - gen(G, N, [ic_forms:get_type(X)]), - gen(G, N, Xs); - -gen(G, N, [_|Xs]) -> - gen(G, N, Xs); - -gen(_G, _N, []) -> - ok. - - -%%%-------------------------------------------- -%%% -%%% Just generates the directory to host -%%% the module files -%%% -%%%-------------------------------------------- - -gen_module(G, N, X) -> - case ic_genobj:do_gen(G) of - - true -> %% Generate & register - N1 = [ic_forms:get_id2(X) | N], - %% Create directory - ic_file:createJavaDirectory(G, N1), - gen(G, N1, ic_forms:get_body(X)); - - false -> %% Register only - N1 = [ic_forms:get_id2(X) | N], - reg(G, N1, ic_forms:get_body(X)) - end. - -reg(G, N, [X|_Xs]) when is_record(X, module) -> - reg(G, [ic_forms:get_id2(X) | N], ic_forms:get_body(X)); - -reg(G, N, [X|_Xs]) when is_record(X, interface) -> - reg(G, [ic_forms:get_id2(X) | N], ic_forms:get_body(X)); - -reg(G, N, [X|Xs]) when is_record(X, typedef) -> - Name = ic_util:to_dot(G,[ic_forms:get_java_id(X) | N]), - case X#typedef.type of - {scoped_id,_,_,_} -> - {FullScopedName, _, _, _} = - ic_symtab:get_full_scoped_name(G, N, X#typedef.type), - Type = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - ic_code:insert_typedef(G, Name, Type); - _ -> - ok - end, - reg(G, N, Xs); - -reg(G, N, [_|Xs]) -> - reg(G, N, Xs); - -reg(_G, _N, []) -> - ok. - - - - -%%%---------------------------------------------- -%%% -%%% Generates the interface code -%%% -%%%---------------------------------------------- - -gen_interface(G, N, X) -> - case ic_genobj:do_gen(G) of - true -> - G1 = ic_file:javaInterfaceFilePush(G, N, X), - - %% Generate Interface file - InterfaceFd = ic_genobj:interfacefiled(G1), - emit_interface(G1, N, X, InterfaceFd), - - %% Generate Helper file - HelperFd = ic_genobj:helperfiled(G1), - emit_helper(G1, N, X, HelperFd), - - %% Generate Holder file - HolderFd = ic_genobj:holderfiled(G1), - emit_holder(G1, N, X, HolderFd), - - %% Generate Stub file - StubFd = ic_genobj:stubfiled(G1), - emit_stub(G1,N,X,StubFd), %<--------------------------------------------------- 1 - - %% Generate Skeleton file - SkelFd = ic_genobj:skelfiled(G1), - emit_skel(G1, N, X, SkelFd), - - ic_file:javaInterfaceFilePop(G1); - false -> - ok - end. - - - - -%%%-------------------------------------------- -%%% -%%% Typedef redirection -%%% -%%%-------------------------------------------- - -gen_typedef(G, N, X) -> - Name = ic_util:to_dot(G,[ic_forms:get_java_id(X) | N]), - case X#typedef.type of - {scoped_id,_,_,_} -> - {FullScopedName, _, _, _} = - ic_symtab:get_full_scoped_name(G, N, X#typedef.type), - Type = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - ic_code:insert_typedef(G, Name, Type); - _ -> - ok - end, - gen_typedef_1(G, N, X, ic_forms:get_body(X)). - -gen_typedef_1(G, N, X, Type) when is_record(Type, sequence) -> - ic_sequence_java:gen(G, N, Type, ic_forms:get_java_id(X)); -gen_typedef_1(G, N, X, Type) when is_record(Type, array) -> - ic_array_java:gen(G, N, X, Type); -gen_typedef_1(G, N, X, _Type) -> - gen_typedef_2(G, N, X, X#typedef.id), - ok. - -gen_typedef_2(G, N, X, Type) when is_record(Type, array) -> - gen_typedef_1(G, N, X, Type); -gen_typedef_2(G, N, X, Type) when is_list(Type) -> - case Type of - [] -> - ok; - _ -> - gen_typedef_2(G, N, X, hd(Type)), - gen_typedef_2(G, N, X, tl(Type)) - end; -%gen_typedef_2(G, N, X, Type) -> %% Generating Helpers for typedef -% %% Stoped due to compatibility problems -% %% with erl_genserv backend -% case ic_java_type:isBasicType(G,N,X#typedef.type) of -% true -> -% ok; -% false -> -% case ic_forms:get_type_code(G,N,X#typedef.type) of -% {'tk_struct', _, _, _} -> -% ic_struct_java:gen(G, N, X); -% {'tk_sequence',_,_} -> -% ic_sequence_java:gen(G, N, X, ic_forms:get_java_id(X)), -% ok; -% _ -> -% ok -% end -% end; -gen_typedef_2(_G, _N, _X, _Type) -> - ok. - - - -%%%-------------------------------------------- -%%% -%%% Member redirection -%%% -%%%-------------------------------------------- - -gen_member(G, N, X) -> - gen_member_1(G, N, X, [X#member.type]), - gen_member_2(G, N, X, X#member.id). - - -gen_member_1(_G, _N, _X, []) -> - ok; - -gen_member_1(G, N, X, [T|Ts]) when is_record(T, sequence) -> - ic_sequence_java:gen(G, N, T, ic_forms:get_java_id(X)), - gen_member_1(G, N, X, Ts); - -gen_member_1(G, N, X, [T|Ts]) -> - gen(G,N,[T]), - gen_member_1(G,N,X,Ts). - - -gen_member_2(_G, _N, _X, []) -> - ok; - -gen_member_2(G, N, X, [T|Ts]) when is_record(T, array) -> %% BUG ! - ic_array_java:gen(G, N, X, T), - gen_member_2(G, N, X, Ts); - -gen_member_2(G, N, X, [_T|Ts]) -> - gen_member_2(G, N, X, Ts). - - - -gen_exception(_G, N, X) -> - io:format("Warning : Exceptions not supported for java mapping, ~p ignored\n", - [ic_util:to_colon([ic_forms:get_java_id(X)|N])]), - ok. - - - -%%%----------------------------------------------------- -%%% -%%% Interface file generation -%%% -%%%----------------------------------------------------- - -emit_interface(G, N, X, Fd) -> - Interface = ic_forms:get_java_id(X), %% Java Interface Name - IFCName = ic_forms:get_id2(X), %% Internal Interface Name - - ic_codegen:emit(Fd, "public interface ~s {\n\n",[Interface]), - Body = ic_forms:get_body(X), - - %% Generate type declarations inside interface - gen(G, [IFCName |N], Body), - - lists:foreach(fun({_Name, Body1}) -> - emit_interface_prototypes(G, [IFCName|N], Body1, Fd) end, - [{x, Body} | X#interface.inherit_body]), - - ic_codegen:emit(Fd, "}\n\n"). - - -emit_interface_prototypes(G, N, [X |Xs], Fd) when is_record(X, op) -> - - {_, ArgNames, TypeList} = extract_info(G, N, X), - {R, ParameterTypes, _} = TypeList, - - OpName = ic_forms:get_java_id(X), - RT = ic_java_type:getParamType(G,N,R,ret), - PL = ic_util:mk_list(gen_par_list(G, N, X, ParameterTypes,ArgNames)), - - ic_codegen:emit(Fd, "/*\n"), - ic_codegen:emit(Fd, " * Operation ~p interface functions \n", [ic_util:to_colon([OpName|N])]), - ic_codegen:emit(Fd, " */\n\n"), - - ic_codegen:emit(Fd, "~s ~s(~s)\n",[RT, OpName, PL]), - ic_codegen:emit(Fd, " throws java.lang.Exception;\n\n\n"), - - emit_interface_prototypes(G, N, Xs, Fd); -emit_interface_prototypes(G, N, [X |Xs], Fd) when is_record(X, attr) -> - ic_attribute_java:emit_attribute_prototype(G, N, X, Fd), - emit_interface_prototypes(G, N, Xs, Fd); -emit_interface_prototypes(G, N, [_X|Xs], Fd) -> - emit_interface_prototypes(G, N, Xs, Fd); -emit_interface_prototypes(_G, _N, [], _Fd) -> ok. - - - - -%%%----------------------------------------------------- -%%% -%%% Holder file generation -%%% -%%%----------------------------------------------------- - -emit_holder(_G, N, X, Fd) -> - InterfaceName = ic_forms:get_java_id(X), - FullInterfaceName = ic_util:to_dot([InterfaceName|N]), - - ic_codegen:emit(Fd, "public final class ~sHolder {\n\n",[InterfaceName]), - - ic_codegen:emit(Fd, " // Instance variable\n"), - ic_codegen:emit(Fd, " public ~s value;\n\n",[FullInterfaceName]), - - ic_codegen:emit(Fd, " // Constructors\n"), - ic_codegen:emit(Fd, " public ~sHolder() {\n",[InterfaceName]), - ic_codegen:emit(Fd, " this(null);\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public ~sHolder(~s _arg) {\n",[InterfaceName, FullInterfaceName]), - ic_codegen:emit(Fd, " value = _arg;\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public void _marshal() {\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public void _unmarshal() {\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n\n"). - - - - -%%%----------------------------------------------------- -%%% -%%% Helper file generation -%%% -%%%----------------------------------------------------- -emit_helper(G, N, X, Fd) -> - InterfaceName = ic_forms:get_java_id(X), - FullInterfaceName = ic_util:to_dot([InterfaceName|N]), - - ic_codegen:emit(Fd, "public final class ~sHelper {\n\n",[InterfaceName]), - - ic_codegen:emit(Fd, " // Constructor\n"), - ic_codegen:emit(Fd, " public ~sHelper() {\n",[InterfaceName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static void _marshal() {\n"), - ic_codegen:emit(Fd, " // Writing the object to the message\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static ~s _unmarshal() {\n",[FullInterfaceName]), - ic_codegen:emit(Fd, " // Reading the object from the message\n"), - ic_codegen:emit(Fd, " return null;\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static java.lang.String id() {\n"), - ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, X)]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n\n"). - - - - -%%%----------------------------------------------------- -%%% -%%% Stub file generation -%%% -%%%----------------------------------------------------- - -emit_stub(G, N, X, Fd) -> - InterfaceName = ic_forms:get_java_id(X), %% Java Interface Name - IFCName = ic_forms:get_id2(X), %% Internal Interface Name - - FullInterfaceName = ic_util:to_dot([InterfaceName|N]), - Body = ic_forms:get_body(X), - - ic_codegen:emit(Fd, "public class _~sStub implements ~s {\n\n", - [InterfaceName,FullInterfaceName]), - - ic_codegen:emit(Fd, " // Client data\n"), - ic_codegen:emit(Fd, " public ~sEnvironment _env;\n\n",[?ICPACKAGE]), - - ic_codegen:emit(Fd, " // Constructors\n"), - ic_codegen:emit(Fd, " public _~sStub(~sOtpSelf _self,\n",[InterfaceName,?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " ~sOtpPeer _peer,\n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " _env =\n"), - ic_codegen:emit(Fd, " new ~sEnvironment(_self, _peer, _server);\n",[?ICPACKAGE]), - ic_codegen:emit(Fd, " _env.connect();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public _~sStub(java.lang.String _selfN,\n",[InterfaceName]), - ic_codegen:emit(Fd, " java.lang.String _peerN,\n"), - ic_codegen:emit(Fd, " java.lang.String _cookie,\n"), - ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), - ic_codegen:emit(Fd, " _env =\n"), - ic_codegen:emit(Fd, " new ~sEnvironment(_selfN, _peerN, _cookie, _server);\n",[?ICPACKAGE]), - ic_codegen:emit(Fd, " _env.connect();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public _~sStub(~sOtpConnection _connection,\n",[InterfaceName, ?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), - ic_codegen:emit(Fd, " _env =\n"), - ic_codegen:emit(Fd, " new ~sEnvironment(_connection, _server);\n",[?ICPACKAGE]), - ic_codegen:emit(Fd, " _env.connect();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - emit_message_reference_extraction(Fd), - - emit_servers_object_access(Fd), - - emit_client_connection_close(Fd), - - emit_client_connection_reconnect(Fd), - - emit_client_destroy(Fd), - - lists:foreach(fun({_Name, Body1}) -> - emit_op_implementation(G, [IFCName|N], Body1, Fd) end, - [{x, Body} | X#interface.inherit_body]), - - ic_codegen:emit(Fd, "}\n\n"). - - -emit_op_implementation(G, N, [X |Xs], Fd) when is_record(X, op) -> - - WireOpName = ic_forms:get_id2(X), - OpName = ic_forms:get_java_id(WireOpName), - {_, ArgNames, TypeList} = extract_info(G, N, X), - {R, ParamTypes, _} = TypeList, - - RT = ic_java_type:getParamType(G,N,R,ret), - PL = ic_util:mk_list(gen_par_list(G, N, X, ParamTypes, ArgNames)), - CMCPL = ic_util:mk_list(gen_client_marshal_call_par_list(ArgNames)), - - ic_codegen:emit(Fd, " // Operation ~p implementation\n", [ic_util:to_colon([WireOpName|N])]), - ic_codegen:emit(Fd, " public ~s ~s(~s)\n", [RT, OpName, PL]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - %% Function marshal call - ic_codegen:emit(Fd, " // Calling the marshal function\n"), - - case CMCPL of - "" -> - ic_codegen:emit(Fd, " _~s_marshal(_env);\n\n",[OpName]); - _ -> - ic_codegen:emit(Fd, " _~s_marshal(_env, ~s);\n\n",[OpName, CMCPL]) - end, - - %% Sending call - ic_codegen:emit(Fd, " // Message send\n"), - ic_codegen:emit(Fd, " _env.send();\n\n"), - - case ic_forms:is_oneway(X) of - true -> - ok; - false -> - %% Receiving return values - ic_codegen:emit(Fd, " // Message receive\n"), - ic_codegen:emit(Fd, " _env.receive();\n\n"), - - %% Function unmarshal call - case RT of - "void" -> - case ic_util:mk_list(gen_client_unmarshal_call_par_list(ArgNames)) of - "" -> - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - ic_codegen:emit(Fd, " _~s_unmarshal(_env);\n", - [OpName]); - UMCPL -> - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - ic_codegen:emit(Fd, " _~s_unmarshal(_env, ~s);\n", - [OpName,UMCPL]) - end; - _ -> - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - case ic_util:mk_list(gen_client_unmarshal_call_par_list(ArgNames)) of - "" -> - ic_codegen:emit(Fd, " return _~s_unmarshal(_env);\n", - [OpName]); - UMCPL -> - ic_codegen:emit(Fd, " return _~s_unmarshal(_env, ~s);\n", - [OpName,UMCPL]) - end - end - end, - ic_codegen:emit(Fd, " }\n\n"), - - %% Marshalling - emit_op_marshal(G, N, X, Fd), - - %% UnMarshalling - emit_op_unmarshal(G, N, X, Fd), - ic_codegen:emit(Fd, "\n"), - - emit_op_implementation(G, N, Xs, Fd); -emit_op_implementation(G, N, [X |Xs], Fd) when is_record(X, attr) -> - ic_attribute_java:emit_attribute_stub_code(G, N, X, Fd), - emit_op_implementation(G, N, Xs, Fd); -emit_op_implementation(G, N, [_X|Xs], Fd) -> - emit_op_implementation(G, N, Xs, Fd); -emit_op_implementation(_G, _N, [], _Fd) -> ok. - - - - - -%%--------------------------------------- -%% -%% Marshal operation generation -%% -%%--------------------------------------- - -emit_op_marshal(G, N, X, Fd) -> - WireOpName = ic_forms:get_id2(X), - OpName = ic_forms:get_java_id(WireOpName), - {_, ArgNames, TypeList} = extract_info(G, N, X), - {_R, ParamTypes, _} = TypeList, - - PL = ic_util:mk_list(gen_marshal_par_list(G, N, X, ParamTypes, ArgNames)), - - ic_codegen:emit(Fd, " // Marshal operation for ~p\n", [OpName]), - case PL of - "" -> - ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env)\n", - [OpName, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"); - _ -> - ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env, ~s)\n", - [OpName, ?ICPACKAGE, PL]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n") - end, - %% Message encoding - emit_op_encode(G, N, X, OpName, WireOpName, ParamTypes, ArgNames, Fd), - - ic_codegen:emit(Fd, " }\n\n"). - - -emit_op_encode(G, N, X, _OpN, WOpN, ParamTypes, ArgNames, Fd) -> - - OpCallName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ic_util:to_undersc([WOpN|N]); - false -> - WOpN - end, - - SendParamNr = count_client_send(ArgNames), - - ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n", - [?ERLANGPACKAGE]), - - case ic_forms:is_oneway(X) of - true -> - %% Initiating call tuple - ic_codegen:emit(Fd, " // Message header assembly\n"), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"$gen_cast\");\n\n"); - false -> - %% Initiating call tuple - ic_codegen:emit(Fd, " // Message header assembly\n"), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), - - %% Initiating call identity tuple - ic_codegen:emit(Fd, " // Message identity part creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __env.write_client_pid();\n"), - ic_codegen:emit(Fd, " __env.write_client_ref();\n\n") - end, - - %% Operation part initializations - case SendParamNr > 0 of - true -> - ic_codegen:emit(Fd, " // Operation attribute creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n", [SendParamNr+1]), - ic_codegen:emit(Fd, " __os.write_atom(~p);\n", [OpCallName]), - emit_op_encode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd); - false -> %% No in/inout paramaters - ic_codegen:emit(Fd, " __os.write_atom(~p);\n", [OpCallName]) - end. - - - -emit_op_encode_loop(_,_,_,_,[],_,_Fd) -> - ok; -emit_op_encode_loop(G, N, X, [_Type|Types],[{out, _Arg}|Args], Counter, Fd) -> - emit_op_encode_loop(G, N, X, Types, Args, Counter, Fd); -emit_op_encode_loop(G, N, X, [Type|Types], [{inout, Arg}|Args], Counter, Fd) -> - case ic_java_type:isBasicType(G, N, Type) of - true -> - ic_codegen:emit(Fd, " __os~s(~s.value);\n", - [ic_java_type:marshalFun(G, N, X, Type),Arg]); - false -> - ic_codegen:emit(Fd, " ~s(__os, ~s.value);\n", - [ic_java_type:marshalFun(G, N, X, Type),Arg]) - end, - emit_op_encode_loop(G, N, X, Types, Args, Counter+1, Fd); -emit_op_encode_loop(G, N, X, [Type|Types], [{in, Arg}|Args], Counter, Fd) -> - case ic_java_type:isBasicType(G, N, Type) of - true -> - ic_codegen:emit(Fd, " __os~s(~s);\n", - [ic_java_type:marshalFun(G, N, X, Type),Arg]); - false -> - ic_codegen:emit(Fd, " ~s(__os, ~s);\n", - [ic_java_type:marshalFun(G, N, X, Type),Arg]) - end, - emit_op_encode_loop(G, N, X, Types, Args, Counter+1, Fd). - - - - - - -%%------------------------------------- -%% -%% UnMarshal operation generation -%% -%%------------------------------------- - -emit_op_unmarshal(G, N, X, Fd) -> - case ic_forms:is_oneway(X) of - true -> - ok; - false -> - OpName = ic_forms:get_java_id(X), - {_, ArgNames, TypeList} = extract_info(G, N, X), - {R, ParamTypes, _} = TypeList, - - RT = ic_java_type:getParamType(G,N,R,ret), - PL = ic_util:mk_list(gen_unmarshal_par_list(G, N, X, ParamTypes, ArgNames)), - - case PL of - "" -> - case RT of - "void" -> - ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), - ic_codegen:emit(Fd, " public static void _~s_unmarshal(~sEnvironment __env)\n", - [OpName, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - ic_codegen:emit(Fd, " __env.getIs().read_atom();\n"), - ic_codegen:emit(Fd, " }\n\n"); - _ -> - ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), - ic_codegen:emit(Fd, " public static ~s _~s_unmarshal(~sEnvironment __env)\n", - [RT, OpName, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get input stream\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n", - [?ERLANGPACKAGE]), - - emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd), - ic_codegen:emit(Fd, " }\n\n") - end; - _ -> - ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), - ic_codegen:emit(Fd, " public static ~s _~s_unmarshal(~sEnvironment __env, ~s)\n", - [RT, OpName, ?ICPACKAGE, PL]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get input stream\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n", - [?ERLANGPACKAGE]), - - emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd), - ic_codegen:emit(Fd, " }\n\n") - end - end. - - -emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd) -> - ReceiveNr = count_client_receive(ArgNames), - - case RT of - "void" -> - case ReceiveNr > 0 of - true -> - ic_codegen:emit(Fd, " // Extracting output values\n"), - ic_codegen:emit(Fd, " __is.read_tuple_head();\n"), - ic_codegen:emit(Fd, " __is.read_atom();\n"), - emit_op_decode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd); - false -> - ic_codegen:emit(Fd, " __is.read_atom();\n") - end; - _ -> - case ReceiveNr > 0 of - true -> - ic_codegen:emit(Fd, " // Extracting return/output values\n"), - ic_codegen:emit(Fd, " __is.read_tuple_head();\n"), - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " ~s _result = __is~s;\n", - [RT,ic_java_type:unMarshalFun(G, N, X, R)]); - false -> - ic_codegen:emit(Fd, " ~s _result = ~s.unmarshal(__is);\n", - [RT, ic_java_type:getUnmarshalType(G,N,X,R)]) - end, - emit_op_decode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd), - - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, " return _result;\n"); - false -> - ic_codegen:emit(Fd, " // Extracting return value\n"), - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " return __is~s;\n", - [ic_java_type:unMarshalFun(G, N, X, R)]); - false -> - ic_codegen:emit(Fd, " return ~s.unmarshal(__is);\n", - [ic_java_type:getUnmarshalType(G,N,X,R)]) - end - end - end. - -emit_op_decode_loop(_,_,_,_,[],_,_Fd) -> - ok; -emit_op_decode_loop(G, N, X, [_Type|Types], [{in, _Arg}|Args], Counter, Fd) -> - emit_op_decode_loop(G, N, X, Types, Args, Counter, Fd); -emit_op_decode_loop(G, N, X, [Type|Types], [{_, Arg}|Args], Counter, Fd) -> - case ic_java_type:isBasicType(G,N,Type) of - true -> - ic_codegen:emit(Fd, " ~s.value = __is~s;\n", - [Arg, - ic_java_type:unMarshalFun(G, N, X, Type)]); - false -> - ic_codegen:emit(Fd, " ~s.value = ~s.unmarshal(__is);\n", - [Arg, - ic_java_type:getUnmarshalType(G, N, X, Type)]) - end, - emit_op_decode_loop(G, N, X, Types, Args, Counter+1, Fd). - - - -emit_message_reference_extraction(Fd) -> - ic_codegen:emit(Fd, " // Returns call reference\n"), - ic_codegen:emit(Fd, " public ~sOtpErlangRef __getRef()\n", - [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " return _env.received_ref();\n"), - ic_codegen:emit(Fd, " }\n\n"). - -emit_servers_object_access(Fd) -> - ic_codegen:emit(Fd, " // Returns the server\n"), - ic_codegen:emit(Fd, " public java.lang.Object __server() {\n"), - ic_codegen:emit(Fd, " return _env.server();\n"), - ic_codegen:emit(Fd, " }\n\n"). - -emit_client_connection_close(Fd) -> - ic_codegen:emit(Fd, " // Closes connection\n"), - ic_codegen:emit(Fd, " public void __disconnect() {\n"), - ic_codegen:emit(Fd, " _env.disconnect();\n"), - ic_codegen:emit(Fd, " }\n\n"). - -emit_client_connection_reconnect(Fd) -> - ic_codegen:emit(Fd, " // Reconnects client\n"), - ic_codegen:emit(Fd, " public void __reconnect()\n"), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " _env.reconnect();\n"), - ic_codegen:emit(Fd, " }\n\n"). - -emit_client_destroy(Fd) -> - ic_codegen:emit(Fd, " // Destroy server\n"), - ic_codegen:emit(Fd, " public void __stop()\n"), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " _env.client_stop_server();\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - -%%%---------------------------------------------------- -%%% -%%% Generates the server code -%%% -%%%---------------------------------------------------- - -emit_skel(G, N, X, Fd) -> - InterfaceName = ic_forms:get_java_id(X), - FullInterfaceName = ic_util:to_dot([InterfaceName|N]), - - ic_codegen:emit(Fd, "public abstract class _~sImplBase implements ~s {\n\n", - [InterfaceName,FullInterfaceName]), - - ic_codegen:emit(Fd, " // Server data\n"), - ic_codegen:emit(Fd, " protected ~sEnvironment _env = null;\n\n",[?ICPACKAGE]), - - ic_codegen:emit(Fd, " // Constructors\n"), - ic_codegen:emit(Fd, " public _~sImplBase() {\n",[InterfaceName]), - ic_codegen:emit(Fd, " }\n\n"), - - emit_caller_pid(G, N, X, Fd), - - %% Emit operation dictionary - emit_dictionary(G, N, X, Fd), - - %% Emit server switch - emit_server_switch(G, N, X, Fd), - - ic_codegen:emit(Fd, "}\n"). - - -emit_server_switch(G, N, X, Fd) -> - - IFCName = ic_forms:get_id2(X), %% Internal Interface Name - Body = ic_forms:get_body(X), - Counter = 0, - - ic_codegen:emit(Fd, " // Operation invokation\n"), - ic_codegen:emit(Fd, " public ~sOtpOutputStream invoke(~sOtpInputStream _in)\n", - [?ERLANGPACKAGE,?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Create a new environment if needed\n"), - ic_codegen:emit(Fd, " if (_env == null)\n"), - ic_codegen:emit(Fd, " _env = new com.ericsson.otp.ic.Environment();\n\n"), - - ic_codegen:emit(Fd, " // Unmarshal head\n"), - ic_codegen:emit(Fd, " _env.uHead(_in);\n\n"), - - ic_codegen:emit(Fd, " // Switch over operation\n"), - ic_codegen:emit(Fd, " return __switch(_env);\n"), - - ic_codegen:emit(Fd, " }\n\n"), - - - ic_codegen:emit(Fd, " // Operation switch\n"), - ic_codegen:emit(Fd, " public ~sOtpOutputStream __switch(~sEnvironment __env)\n", [?ERLANGPACKAGE,?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Setup streams and operation label\n"), - ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " int __label = __env.uLabel(__operations);\n\n"), - - ic_codegen:emit(Fd, " // Switch over operation\n"), - ic_codegen:emit(Fd, " switch(__label) {\n\n"), - - OpNr = emit_server_op_switch_loop(G, - [IFCName|N], - [{x, Body} | X#interface.inherit_body], - Counter, - Fd), - - ic_codegen:emit(Fd, " case ~p: { // Standard stop operation\n\n",[OpNr]), - ic_codegen:emit(Fd, " __env.server_stop_server();\n\n"), - ic_codegen:emit(Fd, " } break;\n\n"), - - ic_codegen:emit(Fd, " default: // It will never come down here \n"), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"BAD OPERATION\");\n\n", []), - - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " if(__os.count() > 0)\n"), - ic_codegen:emit(Fd, " return __os;\n\n"), - - ic_codegen:emit(Fd, " return null;\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - -emit_server_op_switch_loop(_G, _N, [], C, _Fd) -> - C; -emit_server_op_switch_loop(G, N, [{_,X}|Xs], C, Fd) -> - C1 = emit_server_op_switch(G, N, X, C, Fd), - emit_server_op_switch_loop(G, N, Xs, C1, Fd). - - -emit_server_op_switch(G, N, [X|Xs], C, Fd) when is_record(X, op) -> - - OpName = ic_forms:get_java_id(X), - - ic_codegen:emit(Fd, " case ~p: { // Operation ~s\n\n",[C,ic_util:to_dot([OpName|N])]), - - emit_invoke(G, N, X, Fd), - - ic_codegen:emit(Fd, " } break;\n\n"), - - emit_server_op_switch(G, N, Xs, C+1, Fd); -emit_server_op_switch(G, N, [X |Xs], C, Fd) when is_record(X, attr) -> - C1 = ic_attribute_java:emit_attribute_switch_case(G,N,X,Fd,C), - emit_server_op_switch(G, N, Xs, C1, Fd); -emit_server_op_switch(G, N, [_X|Xs], C, Fd) -> - emit_server_op_switch(G, N, Xs, C, Fd); -emit_server_op_switch(_G, _N, [], C, _Fd) -> - C. - - -emit_caller_pid(_G, _N, _X, Fd) -> - ic_codegen:emit(Fd, " // Extracts caller identity\n"), - ic_codegen:emit(Fd, " public ~sOtpErlangPid __getCallerPid() {\n", [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " return _env.getScaller();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public ~sOtpErlangPid __getCallerPid(~sEnvironment __env) {\n", - [?ERLANGPACKAGE, ?ICPACKAGE]), - ic_codegen:emit(Fd, " return __env.getScaller();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public boolean __isStopped() {\n"), - ic_codegen:emit(Fd, " return _env.isStopped();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public boolean __isStopped(~sEnvironment __env) {\n", - [?ICPACKAGE]), - ic_codegen:emit(Fd, " return __env.isStopped();\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - -%% Creates an operation dictionary -emit_dictionary(G, N, X, Fd) -> - - Counter = 0, - Body = ic_forms:get_body(X), - - ic_codegen:emit(Fd, " // Operation dictionary\n"), - ic_codegen:emit(Fd, " private static java.util.Dictionary __operations = new java.util.Hashtable();\n"), - ic_codegen:emit(Fd, " static {\n"), - - emit_dictionary_loop(G, - [ic_forms:get_id2(X)|N], - [{x, Body} | X#interface.inherit_body], - Counter, - Fd), - - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " // Operation dictionary access\n"), - ic_codegen:emit(Fd, " public static java.util.Dictionary __operations() {\n"), - ic_codegen:emit(Fd, " return __operations;\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - - -emit_dictionary_loop(_G, _N, [], C, Fd) -> - ic_codegen:emit(Fd, " __operations.put(~p, new java.lang.Integer(~p));\n", - ["stop",C]); -emit_dictionary_loop(G, N, [{_,X}|Xs], C, Fd) -> - C1 = emit_dictionary(G, N, X, C, Fd), - emit_dictionary_loop(G, N, Xs, C1, Fd). - - -emit_dictionary(G, N, [X|Xs], C, Fd) when is_record(X, op) -> - - OpName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ic_util:to_undersc([ic_forms:get_id2(X)|N]); - false -> - ic_forms:get_id2(X) - end, - - ic_codegen:emit(Fd, " __operations.put(~p, new java.lang.Integer(~p));\n", - [OpName,C]), - emit_dictionary(G, N, Xs, C+1, Fd); - -emit_dictionary(G, N, [X |Xs], C, Fd) when is_record(X, attr) -> - C1 = ic_attribute_java:emit_atrribute_on_dictionary(G, N, X, Fd, C), - emit_dictionary(G, N, Xs, C1, Fd); - -emit_dictionary(G, N, [_X|Xs], C, Fd) -> - emit_dictionary(G, N, Xs, C, Fd); - -emit_dictionary(_G, _N, [], C, _Fd) -> - C. - - - -emit_invoke(G, N, X, Fd) -> - - {_, ArgNames, TypeList} = extract_info(G, N, X), - {R, ParamTypes, _} = TypeList, - OpName = ic_forms:get_java_id(X), - RT = ic_java_type:getParamType(G,N,R,ret), - PL = ic_util:mk_list(gen_cb_arg_list(ArgNames)), - OutParamNr = count_server_send(ArgNames), - - case count_server_receive(ArgNames) of - 0 -> - ok; - _C -> - ic_codegen:emit(Fd, " // Preparing input\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n", - [?ERLANGPACKAGE]), - emit_server_unmarshal_loop(G, N, X, ParamTypes, ArgNames, 1, Fd) - end, - - ic_codegen:emit(Fd, " // Calling implementation function\n"), - case RT of - "void" -> - ic_codegen:emit(Fd, " this.~s(~s);\n\n", - [OpName,PL]); - _ -> - ic_codegen:emit(Fd, " ~s _result = this.~s(~s);\n\n", - [RT, OpName, PL]) - end, - - case ic_forms:is_oneway(X) of - true -> - ok; - false -> - ic_codegen:emit(Fd, " // Marshaling output\n"), - ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), - - case RT of - "void" -> - case OutParamNr > 0 of - true -> - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n",[OutParamNr+1]), - ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n"), - emit_server_marshal_loop(G, N, X, ParamTypes,ArgNames,1,Fd); - false -> - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n\n") - end; - _ -> - case OutParamNr > 0 of - true -> - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n",[OutParamNr+1]), - - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " __os~s(_result); // Return value\n", - [ic_java_type:marshalFun(G,N,X,R)]); - false -> - ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n", - [ic_java_type:marshalFun(G,N,X,R)]) - end, - emit_server_marshal_loop(G, N, X, ParamTypes,ArgNames,1,Fd); - false -> - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), - - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " __os~s(_result); // Return value\n\n", - [ic_java_type:marshalFun(G,N,X,R)]); - false -> - ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n\n", - [ic_java_type:marshalFun(G,N,X,R)]) - end - end - end, - ic_codegen:nl(Fd) - end. - - -emit_server_unmarshal_loop(_,_,_,_,[],_,Fd) -> - ic_codegen:nl(Fd); -emit_server_unmarshal_loop(G, N, X, [Type|Types], [{in, Arg}|Args], Counter, Fd) -> - case ic_java_type:isBasicType(G,N,Type) of - true -> - ic_codegen:emit(Fd, " ~s ~s = __is~s; // In value\n", - [ic_java_type:getType(G,N,Type), - Arg, - ic_java_type:unMarshalFun(G,N,X,Type)]); - false -> - ic_codegen:emit(Fd, " ~s ~s = ~s.unmarshal(__is); // In value\n", - [ic_java_type:getType(G,N,Type), - Arg, - ic_java_type:getUnmarshalType(G,N,X,Type)]) - end, - emit_server_unmarshal_loop(G, N, X, Types, Args, Counter+1, Fd); -emit_server_unmarshal_loop(G, N, X, [Type|Types],[{inout, Arg}|Args], Counter, Fd) -> - Holder = ic_java_type:getHolderType(G,N,Type), - case ic_java_type:isBasicType(G,N,Type) of - true -> -% OtpEncVar = ic_java_type:getUnmarshalType(G,N,X,Type), - ic_codegen:emit(Fd, " ~s _~s = __is~s;\n", - [ic_java_type:getType(G,N,Type), - Arg, - ic_java_type:unMarshalFun(G,N,X,Type)]), - ic_codegen:emit(Fd, " ~s ~s = new ~s(_~s); // InOut value\n", - [Holder, - Arg, - Holder, - Arg]); - false -> - ic_codegen:emit(Fd, " ~s ~s = new ~s(); // InOut value\n", - [Holder, - Arg, - Holder]), - ic_codegen:emit(Fd, " ~s._unmarshal(__is);\n", - [Arg]) - end, - emit_server_unmarshal_loop(G, N, X, Types, Args, Counter+1, Fd); -emit_server_unmarshal_loop(G, N, X, [Type|Types],[{out, Arg}|Args], Counter, Fd) -> - Holder = ic_java_type:getHolderType(G,N,Type), - ic_codegen:emit(Fd, " ~s ~s = new ~s(); // Out value\n", [Holder, Arg, Holder]), - emit_server_unmarshal_loop(G, N, X, Types, Args, Counter, Fd). - - -emit_server_marshal_loop(_,_,_,_,[],_,_Fd) -> - ok; -emit_server_marshal_loop(G, N, X, [_Type|Types],[{in, _Arg}|Args], Counter, Fd) -> - emit_server_marshal_loop(G, N, X, Types, Args, Counter, Fd); -emit_server_marshal_loop(G, N, X, [Type|Types],[{_, Arg}|Args], Counter, Fd) -> -% Holder = ic_java_type:getHolderType(G,N,Type), - case ic_java_type:isBasicType(G,N,Type) of - true -> - ic_codegen:emit(Fd, " __os~s(~s.value); // Out/InOut value\n", - [ic_java_type:marshalFun(G,N,X,Type),Arg]); - false -> - ic_codegen:emit(Fd, " ~s._marshal(__os); // Out/InOut value\n", - [Arg]) - end, - emit_server_marshal_loop(G, N, X, Types, Args, Counter+1, Fd). - - - - - -%%%---------------------------------------------------- -%%% -%%% Utilities -%%% -%%%---------------------------------------------------- - -extract_info(_G, N, X) when is_record(X, op) -> - Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - Args = X#op.params, - ArgNames = mk_c_vars(Args), - TypeList = {ic_forms:get_type(X), - lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args), - [] - }, - {Name, ArgNames, TypeList}; -extract_info(_G, N, X) -> - Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - {Name, [], []}. - -%% Input is a list of parameters (in parse form) and output is a list -%% of parameter attribute and variable names. -mk_c_vars(Params) -> - lists:map(fun(P) -> {A, _} = P#param.inout, - {A, ic_forms:get_id(P#param.id)} - end, - Params). - -%% -handle_preproc(G, _N, line_nr, X) -> - Id = ic_forms:get_java_id(X), - Flags = X#preproc.aux, - case Flags of - [] -> ic_genobj:push_file(G, Id); - _ -> - lists:foldr(fun({_, _, "1"}, Gprim) -> ic_genobj:push_file(Gprim, Id); - ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id); - ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end, - G, Flags) - end; -handle_preproc(G, _N, _Other, _X) -> - G. - - -%% -gen_par_list(_, _, _, [], []) -> - []; -gen_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> - JType = ic_java_type:getParamType(G, N, Type, Attr), - [JType ++ " " ++ Arg | - gen_par_list(G, N, X, Types, Args)]. - - -gen_marshal_par_list(_, _, _, [], []) -> - []; -gen_marshal_par_list(G, N, X, [_Type |Types], [{out, _Arg}|Args]) -> - gen_marshal_par_list(G, N, X, Types, Args); -gen_marshal_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> - JType = ic_java_type:getParamType(G, N, Type, Attr), - [JType ++ " " ++ Arg | - gen_marshal_par_list(G, N, X, Types, Args)]. - - -gen_unmarshal_par_list(_, _, _, [], []) -> - []; -gen_unmarshal_par_list(G, N, X, [_Type |Types], [{in, _Arg}|Args]) -> - gen_unmarshal_par_list(G, N, X, Types, Args); -gen_unmarshal_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> - JType = ic_java_type:getParamType(G, N, Type, Attr), - [JType ++ " " ++ Arg | - gen_unmarshal_par_list(G, N, X, Types, Args)]. - - -%% -gen_client_marshal_call_par_list([]) -> - []; -gen_client_marshal_call_par_list([{out, _Arg}|Args]) -> - gen_client_marshal_call_par_list(Args); -gen_client_marshal_call_par_list([{_Attr, Arg}|Args]) -> - [Arg | gen_client_marshal_call_par_list(Args)]. - - -gen_client_unmarshal_call_par_list([]) -> - []; -gen_client_unmarshal_call_par_list([{in, _Arg}|Args]) -> - gen_client_unmarshal_call_par_list(Args); -gen_client_unmarshal_call_par_list([{_Attr, Arg}|Args]) -> - [Arg | gen_client_unmarshal_call_par_list(Args)]. - - - -count_client_receive(ArgNames) -> - count_client_receive(ArgNames,0). - -count_client_receive([],C) -> - C; -count_client_receive([{in, _Arg}|Args],C) -> - count_client_receive(Args,C); -count_client_receive([_|Args],C) -> - count_client_receive(Args,C+1). - - - -count_client_send(ArgNames) -> - count_client_send(ArgNames,0). - -count_client_send([],C) -> - C; -count_client_send([{out, _Arg}|Args],C) -> - count_client_send(Args,C); -count_client_send([_|Args],C) -> - count_client_send(Args,C+1). - - -gen_cb_arg_list([]) -> - []; -gen_cb_arg_list([{_Attr, Arg}|Args]) -> - [Arg | gen_cb_arg_list(Args)]. - - -count_server_receive(ArgNames) -> - count_server_receive(ArgNames,0). - -count_server_receive([],C) -> - C; -count_server_receive([_|Args],C) -> - count_server_receive(Args,C+1). - - -count_server_send(ArgNames) -> - count_server_send(ArgNames,0). - -count_server_send([],C) -> - C; -count_server_send([{in, _Arg}|Args],C) -> - count_server_send(Args,C); -count_server_send([_|Args],C) -> - count_server_send(Args,C+1). - - - - - -%%%------------------------------------------------------- - - -emit_type_function(G, N, X, Fd) -> - - TC = ic_forms:get_type_code(G, N, X), - - %%io:format("X = ~p\nTC = ~p\n",[X,TC]), - - ic_codegen:emit(Fd, " private static ~sTypeCode _tc;\n",[?ICPACKAGE]), - ic_codegen:emit(Fd, " synchronized public static ~sTypeCode type() {\n\n",[?ICPACKAGE]), - - ic_codegen:emit(Fd, " if (_tc != null)\n"), - ic_codegen:emit(Fd, " return _tc;\n\n"), - - emit_type_function(TC, 0, Fd), - - ic_codegen:emit(Fd, "\n _tc = _tc0;\n"), - - ic_codegen:emit(Fd, "\n return _tc0;\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - -emit_type_function({tk_struct, ID, Name, ML}, C, Fd) -> %% struct - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_struct);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), - ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), - ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(ML)]), - emit_struct_members(ML, C, C+1, 0, Fd); - -emit_type_function({tk_enum, ID, Name, MNames}, C, Fd) -> %% enum - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_enum);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), - ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), - ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(MNames)]), - emit_enum_members(MNames, C, 0, Fd), - C+1; - -emit_type_function({tk_array, ET, L}, C, Fd) -> %% array - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_array);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(id());\n",[C]), - ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), - C1 = C+1, - C2 = emit_type_function(ET, C1, Fd), - ic_codegen:emit(Fd, " _tc~p.content_type(_tc~p);\n", [C,C1]), - C2; - -emit_type_function({tk_sequence, ET, L}, C, Fd) -> %% sequence - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_sequence);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(id());\n",[C]), - ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), - C1 = C+1, - C2 = emit_type_function(ET, C1, Fd), - ic_codegen:emit(Fd, " _tc~p.content_type(_tc~p);\n", [C,C1]), - C2; - -emit_type_function({tk_string, L}, C, Fd) -> %% string - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_string);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), - C+1; - -emit_type_function({tk_union, ID, Name, DT, DI, LL}, C, Fd) -> %% union - - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_union);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), - ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), - - C1 = C+1, - C2 = emit_type_function(DT, C1, Fd), - - ic_codegen:emit(Fd, " _tc~p.discriminator_type(_tc~p);\n", [C,C1]), - ic_codegen:emit(Fd, " _tc~p.default_index(~p);\n", [C,DI]), - ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(LL)]), - - emit_union_labels(LL, C, DT, C2, 0, Fd); - -emit_type_function(tk_term, C, Fd) -> %% term, must change it to tk_any - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_any);\n", [C,?ICPACKAGE]), - C+1; - -emit_type_function(TC, C, Fd) -> %% other - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.~p);\n", [C,?ICPACKAGE,TC]), - C+1. - - - -emit_struct_members([], _, TCtr, _, _Fd) -> - TCtr; -emit_struct_members([{Name,MT}|Rest], BTCtr, TCtr, I, Fd) -> - ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,Name]), - TCtr2 = emit_type_function(MT, TCtr, Fd), - ic_codegen:emit(Fd, " _tc~p.member_type(~p,_tc~p);\n", [BTCtr,I,TCtr]), - emit_struct_members(Rest, BTCtr, TCtr2, I+1, Fd). - -emit_enum_members([], _, _, _Fd) -> - ok; -emit_enum_members([Name|Names], BTCtr, I, Fd) -> - ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,Name]), - emit_enum_members(Names, BTCtr, I+1, Fd). - - -emit_union_labels([], _, _, TCtr, _, _) -> - TCtr; -emit_union_labels([{L, LN, LT}|Rest], BTCtr, DT, TCtr, I, Fd) -> - ic_codegen:emit(Fd, " ~sAny _any~p =\n",[?ICPACKAGE,TCtr]), - ic_codegen:emit(Fd, " new ~sAny();\n", [?ICPACKAGE]), - TCtr1 = TCtr+1, - TCtr2 = emit_type_function(LT, TCtr1,Fd), - ic_codegen:emit(Fd, " _any~p.type(_tc~p);\n",[TCtr,TCtr1]), - - case L of - default -> - ic_codegen:emit(Fd, " _any~p.insert_atom(\"default\");\n", [TCtr]); - _ -> - case DT of - tk_boolean -> - ic_codegen:emit(Fd, " _any~p.insert_boolean(~p);\n",[TCtr,L]); - tk_char -> - Default = if is_integer(L) -> - [L]; - true -> - L - end, - ic_codegen:emit(Fd, " _any~p.insert_char('~s');\n",[TCtr,Default]); - tk_ushort -> - ic_codegen:emit(Fd, " _any~p.insert_ushort(~p);\n",[TCtr,L]); - tk_ulong -> - ic_codegen:emit(Fd, " _any~p.insert_ulong(~p);\n",[TCtr,L]); - tk_short -> - ic_codegen:emit(Fd, " _any~p.insert_short(~p);\n",[TCtr,L]); - tk_long -> - ic_codegen:emit(Fd, " _any~p.insert_long(~p);\n",[TCtr,L]); - _ -> - ic_codegen:emit(Fd, " _any~p.insert_string(~p);\n", [TCtr,L]) - end - end, - ic_codegen:emit(Fd, " _tc~p.member_label(~p,_any~p);\n", [BTCtr,I,TCtr]), - ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,LN]), - TCtr3 = emit_type_function(LT, TCtr2, Fd), - ic_codegen:emit(Fd, " _tc~p.member_type(~p,_tc~p);\n", [BTCtr,I,TCtr2]), - emit_union_labels(Rest, BTCtr, DT, TCtr3, I+1, Fd). - - - - - - - - diff --git a/lib/ic/src/ic_noc.erl b/lib/ic/src/ic_noc.erl deleted file mode 100644 index 0e387b5e70..0000000000 --- a/lib/ic/src/ic_noc.erl +++ /dev/null @@ -1,1117 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% --module(ic_noc). - - --export([do_gen/3]). -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --export([unfold/1, mk_attr_func_names/2]). - - --import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). --import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]). --import(ic_codegen, [emit/2, emit/3, nl/1]). --import(ic_options, [get_opt/2]). - - --import(lists, [foreach/2, foldr/3, map/2]). - - --include("icforms.hrl"). --include("ic.hrl"). - - - - -%%------------------------------------------------------------ -%% -%% Generate the client side Erlang stubs. -%% -%% Each module is generated to a separate file. -%% -%% Export declarations for all interface functions must be -%% generated. Each function then needs to generate a function head and -%% a body. IDL parameters must be converted into Erlang parameters -%% (variables, capitalised) and a type signature list must be -%% generated (for later encode/decode). -%% -%%------------------------------------------------------------ - - -do_gen(G, File, Form) -> - G2 = ic_file:filename_push(G, [], mk_oe_name(G, - ic_file:remove_ext(to_list(File))), - erlang), - gen_head(G2, [], Form), - exportDependency(G2), - %% Loop through form and adds inheritence data - ic_pragma:preproc(G2, [], Form), - gen(G2, [], Form), - genDependency(G2), - ic_file:filename_pop(G2, erlang), - ok. - - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = ic:handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, module) -> - CD = ic_code:codeDirective(G,X), - G2 = ic_file:filename_push(G, N, X, CD), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - G3 = ic_file:filename_pop(G2, CD), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, interface) -> - G2 = ic_file:filename_push(G, N, X, erlang), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, - X#interface.inherit_body), - gen_serv(G2, N, X), - G3 = ic_file:filename_pop(G2, erlang), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, const) -> -% N2 = [get_id2(X) | N], - emit_constant_func(G, X#const.id, X#const.val), - gen(G, N, Xs); %% N2 or N? - -gen(G, N, [X|Xs]) when is_record(X, op) -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - - case getNocType(G,X,N) of - transparent -> - emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs); - multiple -> - mark_not_transparent(G,N), - emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs); - _XTuple -> - mark_not_transparent(G,N), - emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs) - end, - - gen(G, N, Xs); - - -gen(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_stub_func/7), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, erlang), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) -> - case may_contain_structs(X) of - true -> icstruct:struct_gen(G, N, X, erlang); - false -> ok - end, - gen(G, N, Xs); - -gen(_G, _N, []) -> ok. - - -may_contain_structs(X) when is_record(X, typedef) -> true; -may_contain_structs(X) when is_record(X, struct) -> true; -may_contain_structs(X) when is_record(X, union) -> true; -may_contain_structs(_X) -> false. - - - -%%-------------------------------------------------------------------- -%% -%% Generate the server side (handle_call and handle_cast) -%% - -gen_serv(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - emit_serv_std(G, N, X), - N2 = [get_id2(X) | N], - gen_calls(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> - gen_calls(G, N2, Body) end, - X#interface.inherit_body), - get_if_gen(G, N2, X), - gen_end_of_call(G, N, X), % Note N instead of N2 - - gen_casts(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> - gen_casts(G, N2, Body) end, - X#interface.inherit_body), - gen_end_of_cast(G, N, X), % Note N instead of N2 - emit_skel_footer(G, N, X); % Note N instead of N2 - false -> - ok - end. - -gen_calls(G, N, [X|Xs]) when is_record(X, op) -> - case is_oneway(X) of - false -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs), - gen_calls(G, N, Xs); - true -> - gen_calls(G, N, Xs) - end; - -gen_calls(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_skel_func/7), - gen_calls(G, N, Xs); - -gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs); -gen_calls(_G, _N, []) -> ok. - -gen_casts(G, N, [X|Xs]) when is_record(X, op) -> - case is_oneway(X) of - true -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs), - gen_casts(G, N, Xs); - false -> - gen_casts(G, N, Xs) - end; - -gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs); -gen_casts(_G, _N, []) -> ok. - -emit_attr(G, N, X, F) -> - XX = #id_of{type=X}, - {GetType, SetType} = mk_attr_func_types(N, X), - lists:foreach(fun(Id) -> - X2 = XX#id_of{id=Id}, - {Get, Set} = mk_attr_func_names(N, get_id(Id)), - F(G, N, X2, Get, [], GetType, []), - case X#attr.readonly of - {readonly, _} -> ok; - _ -> - F(G, N, X2, Set, [mk_name(G, "Value")], - SetType, []) - end end, ic_forms:get_idlist(X)). - - -extract_info(G, _N, X) when is_record(X, op) -> - Name = get_id2(X), - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - ArgNames = mk_erl_vars(G, InArgs), - TypeList = {ic_forms:get_tk(X), - map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), - map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) - }, - {Name, ArgNames, TypeList, OutArgs}. - - - - -emit_serv_std(G, N, X) -> - Fd = ic_genobj:stubfiled(G), - case transparent(G) of - true -> - true; - _XTupleORMultiple -> - Impl = getImplMod(G,X,[get_id2(X)|N]), - TypeID = ictk:get_IR_ID(G, N, X), - - nl(Fd), nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Server implementation."]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), - nl(Fd), - emit(Fd, "typeID() ->\n"), - emit(Fd, " \"~s\".\n", [TypeID]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Server creation functions."]), - nl(Fd), - emit(Fd, "oe_create() ->\n"), - emit(Fd, " start([], []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link() ->\n"), - emit(Fd, " start_link([], []).\n", []), - nl(Fd), - emit(Fd, "oe_create(Env) ->\n"), - emit(Fd, " start(Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link(Env) ->\n"), - emit(Fd, " start_link(Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create(Env, RegName) ->\n"), - emit(Fd, " start(RegName, Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link(Env, RegName) ->\n"), - emit(Fd, " start_link(RegName, Env, []).\n", []), - nl(Fd), - ic_codegen:mcomment(Fd, ["Start functions."]), - nl(Fd), - emit(Fd, "start(Env, Opt) ->\n"), - emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start_link(Env, Opt) ->\n"), - emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start(RegName, Env, Opt) ->\n"), - emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start_link(RegName, Env, Opt) ->\n"), - emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"), - nl(Fd), - ic_codegen:comment(Fd, "Call to implementation init"), - emit(Fd, "init(Env) ->\n"), - emit(Fd, " ~p:~p(Env).\n", [Impl, init]), - nl(Fd), - emit(Fd, "terminate(Reason, State) ->\n"), - emit(Fd, " ~p:~p(Reason, State).\n", - [Impl, terminate]), - nl(Fd), - emit(Fd, "code_change(_OldVsn, State, _Extra) ->\n"), - emit(Fd, " {ok, State}.\n"), - nl(Fd), nl(Fd) - end, - Fd. - - - - -gen_end_of_call(G, _N, _X) -> - case transparent(G) of - true -> - true; - _XTuple -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), - emit(Fd, "handle_call(stop, _From, State) ->\n"), - emit(Fd, " {stop, normal, ok, State}"), - case get_opt(G, serv_last_call) of - exception -> - emit(Fd, ";\n"), - nl(Fd), - emit(Fd, "handle_call(_Req, _From, State) ->\n"), - emit(Fd, " {reply, ~p, State}.\n",[getCallErr()]); - exit -> - emit(Fd, ".\n"), - nl(Fd), - nl(Fd) - end - end, - ok. - - -gen_end_of_cast(G, _N, _X) -> - case transparent(G) of - true -> - true; - _XTuple -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), - emit(Fd, "handle_cast(stop, State) ->\n"), - emit(Fd, " {stop, normal, State}"), - case get_opt(G, serv_last_call) of - exception -> - emit(Fd, ";\n"), - nl(Fd), - emit(Fd, "handle_cast(_Req, State) ->\n"), - emit(Fd, " {reply, ~p, State}.\n",[getCastErr()]); - exit -> - emit(Fd, ".\n"), - nl(Fd), nl(Fd) - end - end, - ok. - - -emit_skel_footer(G, N, X) -> - case transparent(G) of - true -> - true; - _XTuple -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), - case use_impl_handle_info(G, N, X) of - true -> - emit(Fd, "handle_info(X, State) ->\n"), - emit(Fd, " ~p:handle_info(X, State).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - false -> - emit(Fd, "handle_info(_X, State) ->\n"), - emit(Fd, " {reply, ~p, State}.\n\n",[getInfoErr()]) - end - end, - ok. - - -use_impl_handle_info(G, N, X) -> - FullName = ic_util:to_colon([get_id2(X) | N]), - case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of - {_, force_false} -> false; - {false, false} -> false; - _ -> true - end. - - -use_timeout(G, N, _X) -> - FullName = ic_util:to_colon(N), - case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of - {_, force_false} -> false; - {false, false} -> false; - _ -> true - end. - - -get_if_name(G) -> mk_oe_name(G, "get_interface"). - - -%% Generates the get_interface function (for Lars) -get_if_gen(G, N, X) -> - case transparent(G) of - true -> - ok; - _XTuple -> - case ic_genobj:is_stubfile_open(G) of - true -> - IFC_TKS = tk_interface_data(G,N,X), - Fd = ic_genobj:stubfiled(G), - Name = to_atom(get_if_name(G)), - - ic_codegen:mcomment_light(Fd, - [io_lib:format("Standard Operation: ~p", - [Name])]), - - emit(Fd, "handle_call({_~s, ~p, []}, _From, State) ->~n", - [mk_name(G, "Ref"), Name]), - emit(Fd, " {reply, ~p, State};~n", [IFC_TKS]), - nl(Fd), - ok; - - false -> ok - end - end. - - -get_if(G,N,[X|Rest]) when is_record(X, op) -> - R = ic_forms:get_tk(X), - IN = lists:map(fun(P) -> ic_forms:get_tk(P) end, - ic:filter_params([in, inout], X#op.params)), - OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end, - ic:filter_params([out, inout], X#op.params)), - case print_tk(G,N,X) of - true -> - [{get_id2(X), {R, IN, OUT}} | get_if(G,N,Rest)]; - false -> - get_if(G,N,Rest) - end; - -get_if(G,N,[X|Rest]) when is_record(X, attr) -> %% Attributes not handled so far <<<<<<<<<<<<<<<<<<<<<<<< - {GetT, SetT} = mk_attr_func_types([], X), - AList = lists:map(fun(Id) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case X#attr.readonly of - {readonly, _} -> - {Get, GetT}; - _ -> - [{Set, SetT}, {Get, GetT}] - end end, ic_forms:get_idlist(X)), - lists:flatten(AList) ++ get_if(G,N,Rest); - -get_if(G,N,[_X|Rest]) -> get_if(G,N,Rest); -get_if(_,_,[]) -> []. - - - - -%%------------------------------------------------------------ -%% -%% Export stuff -%% -%% Gathering of all names that should be exported from a stub -%% file. -%% - - -gen_head_special(G, N, X) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - NocType = getNocType(G,X,N), - - foreach(fun({Name, Body}) -> - ic_codegen:comment(Fd, "Exports from ~p", - [ic_util:to_colon(Name)]), - ic_codegen:export(Fd, exp_top(G, N, Body, NocType, [])), - nl(Fd) - end, X#interface.inherit_body), - - case transparent(G) of - true -> - nl(Fd), nl(Fd); - _XTuple -> - ic_codegen:comment(Fd, "Type identification function"), - ic_codegen:export(Fd, [{typeID, 0}]), - nl(Fd), - ic_codegen:comment(Fd, "Used to start server"), - ic_codegen:export(Fd, [{start, 2},{start_link, 3}]), - ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1}, - {oe_create_link, 1},{oe_create, 2}, {oe_create_link, 2}]), - nl(Fd), - ic_codegen:comment(Fd, "gen server export stuff"), - emit(Fd, "-behaviour(gen_server).\n"), - ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {code_change, 3}, - {handle_call, 3}, {handle_cast, 2}, {handle_info, 2}]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Object interface functions."]), - nl(Fd), nl(Fd), nl(Fd) - end, - Fd; - - -gen_head_special(_G, _N, _X) -> ok. - - - -%% Shall generate all export declarations -gen_head(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - F = ic_genobj:stubfiled(G), - ic_codegen:comment(F, "Interface functions"), - ic_codegen:export(F, exp_top(G, N, X, getNocType(G,X,N), [])), - nl(F), - gen_head_special(G, N, X); - false -> ok - end. - -exp_top(_G, _N, X, _NT, Acc) when element(1, X) == preproc -> - Acc; -exp_top(G, N, L, NT, Acc) when is_list(L) -> - exp_list(G, N, L, NT, Acc); -exp_top(G, N, M, NT, Acc) when is_record(M, module) -> - exp_list(G, N, get_body(M), NT, Acc); -exp_top(G, N, I, NT, Acc) when is_record(I, interface) -> - exp_list(G, N, get_body(I), NT, Acc); -exp_top(G, N, X, NT, Acc) -> - exp3(G, N, X, NT, Acc). - -exp3(_G, _N, C, _NT, Acc) when is_record(C, const) -> - [{get_id(C#const.id), 0} | Acc]; - -exp3(G, N, Op, NocType, Acc) when is_record(Op, op) -> - FuncName = get_id(Op#op.id), - - TA = case use_timeout(G,N,Op) of - true -> - 1; - false -> - 0 - end, - - case NocType of - transparent -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc]; - multiple -> - case getModType(G, Op, N) of - dt -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc]; - do -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc]; - spt -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc]; - spo -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc] - end; - _ -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc] - end; -exp3(_G, _N, A, _NT, Acc) when is_record(A, attr) -> - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case A#attr.readonly of - {readonly, _} -> [{Get, 1} | Acc2]; - _ -> [{Get, 1}, {Set, 2} | Acc2] - end end, Acc, ic_forms:get_idlist(A)); - -exp3(_G, _N, _X, _NT, Acc) -> Acc. - -exp_list(G, N, L, NT, OrigAcc) -> - lists:foldr(fun(X, Acc) -> exp3(G, N, X, NT, Acc) end, OrigAcc, L). - - - - -%%------------------------------------------------------------ -%% -%% Emit stuff -%% -%% Low level generation primitives -%% - -emit_stub_func(G, N, X, Name, ArgNames, TypeList, _OutArgs) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - StubName = list_to_atom(Name), - This = mk_name(G, "Ref"), - XTuple = getNocType(G,X,N), - CallOrCast = - case is_oneway(X) of - true -> ?CAST; - _ -> ?CALL - end, - - %% Type expand operation on comments - ic_code:type_expand_op(G,N,X,Fd), - - case use_timeout(G,N,X) of - true -> - Timeout = mk_name(G,"Timeout"), - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This, Timeout| ArgNames])]), - emit(Fd, " ~p:~s(~s, ~s, ?MODULE, ~p, ~p, [~s], ~p).\n\n", - [getImplMod(G,X,N), - CallOrCast, - This, - Timeout, - XTuple, - StubName, - mk_list(ArgNames), - tk_operation_data(G, N, X, TypeList)]); - false -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This | ArgNames])]), - - emit(Fd, " ~p:~s(~s, ~p, ?MODULE, ~p, [~s], ~p).\n\n", - [getImplMod(G,X,N), - CallOrCast, - This, - XTuple, - StubName, - mk_list(ArgNames), - tk_operation_data(G, N, X, TypeList)]) - end - end. - - -emit_transparent_func(G, N, X, Name, ArgNames, _TypeList, _OutArgs) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - OpName = list_to_atom(Name), - - ArgList = case use_timeout(G,N,X) of - true -> - mk_list([mk_name(G,"Ref"),mk_name(G,"Timeout")|ArgNames]); - false -> - mk_list([mk_name(G,"Ref")|ArgNames]) - end, - - %% Type expand operation on comments - ic_code:type_expand_op(G,N,X,Fd), - - emit(Fd, "~p(~s) ->\n", [OpName,ArgList]), - emit(Fd, " ~p:~s(~s).\n\n", [getImplMod(G,X,N), OpName, ArgList]) - end. - - - - - - -emit_skel_func(G, N, X, OpName, ArgNames, _TypeList, _OutArgs) -> - case getNocType(G,X,N) of - transparent -> - true; - multiple -> - true; - XTuple -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - Name = list_to_atom(OpName), - This = mk_name(G, "Ref"), - From = mk_name(G, "From"), - State = mk_name(G, "State"), - - %% Type expand handle operation on comments - ic_code:type_expand_handle_op(G,N,X,Fd), - - case is_oneway(X) of - true -> - emit(Fd, "handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s) ->\n", - [This, XTuple, Name, mk_list(ArgNames), State]), - emit(Fd, " ~p:handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s);\n\n", - [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), State]); - false -> - emit(Fd, "handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s) ->\n", - [This, XTuple, Name, mk_list(ArgNames), From, State]), - emit(Fd, " ~p:handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s);\n\n", - [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), From, State]) - end - end - end. - - - -emit_constant_func(G, Id, Val) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - N = list_to_atom(get_id(Id)), - emit_const_comment(G, Fd, Id, N), - emit(Fd, "~p() -> ~p.\n\n", [N, Val]) - end. - - -emit_const_comment(_G, F, _X, Name) -> - ic_codegen:mcomment_light(F, - [io_lib:format("Constant: ~p", [Name])]). - -%%------------------------------------------------------------ -%% -%% Utilities -%% -%% Convenient little go-get functions -%% -%%------------------------------------------------------------ - -%% The automaticly generated get and set operation names for an -%% attribute. -mk_attr_func_names(_Scope, Name) -> - {"_get_" ++ Name, "_set_" ++ Name}. - -%% Returns TK of the Get and Set attribute functions. -mk_attr_func_types(_N, X) -> - TK = ic_forms:get_tk(X), - {{TK, [], []}, {tk_void, [TK], []}}. - - - -%%------------------------------------------------------------ -%% -%% Generation utilities and common stuff -%% -%% Convenient stuff for generation -%% -%%------------------------------------------------------------ - - -%% Input is a list of parameters (in parse form) and output is a list -%% of capitalised variable names. mk_var is in icgen -mk_erl_vars(_G, Params) -> - map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). - - -%% mk_list produces a nice comma separated string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - - -%%------------------------------------------------------------ -%% -%% Parser utilities -%% -%% Called from the yecc parser. Expands the identifier list of an -%% attribute so that the attribute generator never has to handle -%% lists. -%% -%%------------------------------------------------------------ - - -%% Unfold identifier lists or nested lists. Note that many records -%% contain an entry named id that is a list before unfold and a single -%% id afterwards. -unfold(L) when is_list(L) -> - lists:flatten(map(fun(X) -> unfold2(X) end, L)); -unfold(X) -> unfold2(X). - -unfold2(A) when is_record(A, attr) -> - map(fun(Id) -> A#attr{id=Id} end, A#attr.id); -unfold2(M) when is_record(M, member) -> - map(fun(Id) -> M#member{id=Id} end, M#member.id); -unfold2(M) when is_record(M, case_dcl) -> - map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label); -unfold2(T) when is_record(T, typedef) -> - map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id ). - - - - - - -%% Export code produce for dependency function -exportDependency(G) -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:export(Fd, [{oe_dependency, 0}]), - nl(Fd). - -%% Code produce for dependency function -genDependency(G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd),nl(Fd), - ic_codegen:comment(Fd, "Idl file dependency list function"), - emit(Fd, "oe_dependency() ->\n", []), - emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). - - - - - -%%%%%% - - -getImplMod(G,X,Scope) -> %% to_atom(ic_genobj:impl(G)) | ChoicedModuleName - - %% Get actual pragma appliance scope - SpecScope = getActualScope(G,X,Scope), - - %% The "broker" option is passed - %% only by pragmas, seek for module. - case ic_pragma:getBrokerData(G,X,SpecScope) of - {Module,_Type} -> - Module; - _List -> - element(1,ic_pragma:defaultBrokerData(G)) - end. - - -getNocType(G,X,Scope) when is_record(X, interface) -> %% default | specified - OpList = getAllOperationScopes(G,Scope), - getNocType2(G,X,OpList); -getNocType(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN} - getNocType3(G,X,Scope). - -getNocType2(G,X,List) -> - getNocType2(G,X,List,[]). - -getNocType2(_,_,[],Found) -> - selectTypeFromList(Found); -getNocType2(G,X,[OpScope|OpScopes],Found) -> - getNocType2(G,X,OpScopes,[getNocType3(G,X,OpScope)|Found]). - -getNocType3(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN} - - %% Get actual pragma appliance scope - SpecScope = getActualScope(G,X,Scope), - - %% The "broker" option is passed - %% only by pragmas, seek for type. - case ic_pragma:getBrokerData(G,X,SpecScope) of - {_Module,Type} -> - Type; - List -> - selectTypeFromList(List) %%transparent/multiple - end. - - -getModType(G,X,Scope) -> %% default | specified - - %% Get actual pragma appliance scope - SpecScope = getActualScope(G,X,Scope), - - %% The "broker" option is passed - %% only by pragmas, seek for brokerdata. - case ic_pragma:getBrokerData(G,X,SpecScope) of - {Module,Type} -> - case Module == ic_genobj:impl(G) of - true -> - case Type of - transparent -> - dt; %% default + transparent - _ -> - do %% default + opaque - end; - false -> - case Type of - transparent -> - spt; %% specified + transparent - _ -> - spo %% specified + opaque - end - end; - _List -> - dt - end. - - - -%%%% -%% -%% Returns a list of ALL operation full -%% scoped names local and inherited -%% from other interfaces -%% - -getAllOperationScopes(G,Scope) -> - getOperationScopes(G,Scope) ++ - getInhOperationScopes(G,Scope). - - -getOperationScopes(G,Scope) -> - getOpScopes(G, - Scope, - ets:match(ic_genobj:pragmatab(G),{op,'$0',Scope,'_','_'}), - []). - -getOpScopes(_,_,[],OpScopes) -> - OpScopes; -getOpScopes(G,Scope,[[Name]|Names],Found) -> - getOpScopes(G,Scope,Names,[[Name|Scope]|Found]). - - -getInhOperationScopes(G,Scope) -> - getInhOpScopes1(G, - Scope, - ets:match(ic_genobj:pragmatab(G),{inherits,Scope,'$1'}), - []). - -getInhOpScopes1(G,_Scope,[],OpScopes) -> - getInhOpScopes2(G,OpScopes); -getInhOpScopes1(G,Scope,[[SC]|SCs],Found) -> - getInhOpScopes1(G,Scope,SCs,[SC|Found]). - - -getInhOpScopes2(G,Scopes) -> - getInhOpScopes2(G,Scopes,[]). - -getInhOpScopes2(_G,[],Found) -> - Found; -getInhOpScopes2(G,[SC|SCs],Found) -> - getOperationScopes(G,SC) ++ getInhOpScopes2(G,SCs,Found). - -%% -%% -%%%% - - - -%%%% -%% -%% -%% Seek the actual operation scope : -%% -%% * if the operation is inherited, get the real scope for it -%% -%% * if the operation has a specific pragma, apply the real -%% scope, otherwise return the including scope -%% -getActualScope(G, X, Scope) when is_record(X, op) -> - OpScope = getRealOpScope(G,X,Scope), - case ets:match(ic_genobj:pragmatab(G),{codeopt_specific,OpScope}) of - [[]] -> - OpScope; - _ -> - Scope - end; -getActualScope(_G, _X, N) -> - N. - -%% -%% Just seek and return the scope for the operation -%% where it were originaly defined -%% -getRealOpScope(G,X,N) when is_record(X, op) -> - Ptab = ic_genobj:pragmatab(G), - Id = get_id2(X), - - case ets:match(Ptab,{op,Id,N,'_','_'}) of - [[]] -> - [Id|N]; - _ -> - getRealOpScope(G, Ptab, X, N, Id, ets:match(Ptab,{inherits,N,'$1'})) - end; -getRealOpScope(_G,_X,N) -> - N. - -getRealOpScope(_G, _S, _X, N, Id, []) -> - [Id|N]; -getRealOpScope(G, S, X, N, Id, [[OS]|OSs]) -> - case ets:match(S,{op,Id,OS,'_','_'}) of - [[]] -> - [Id|OS]; - _ -> - getRealOpScope(G, S, X, N, Id, OSs) - end. - -selectTypeFromList([]) -> - transparent; -selectTypeFromList([{_,transparent}|Rest]) -> - selectTypeFromList(Rest); -selectTypeFromList([transparent|Rest]) -> - selectTypeFromList(Rest); -selectTypeFromList([_|_Rest]) -> - multiple. - - - -getCallErr() -> - {'ERROR' ,"Bad Operation -- handle call"}. - -getCastErr() -> - {'ERROR' ,"Bad Operation -- handle cast"}. - -getInfoErr() -> - {'ERROR' ,"Bad Operation -- handle info"}. - - - - - - -%% -%% Type code access utilities -%% - -tk_operation_data(G, N, X, TL) -> - case print_tk(G,N,X) of - true -> - TL; - false -> - no_tk - end. - -tk_interface_data(G, N, X) -> - InfoList = - foldr(fun({_Name, Body}, Acc) -> - get_if(G,N,Body)++Acc end, - get_if(G,N,get_body(X)), - X#interface.inherit_body), - case InfoList of - [] -> - no_tk; %%%%%%%% Should be changed to [] <<<<<<<<<<<<<<<<<<<<<<<<<<< Warning ! - _ -> - InfoList - end. - - -print_tk(G, N, X) when is_record(X, op)-> %% operation - case getNocType(G,X,N) of - transparent -> - false; - multiple -> - false; - _XTuple -> %%check if there are any USETK pragmas - operation_usetk(G,N,X) - end; -print_tk(_G, _N, _X) -> %% error - false. - - -operation_usetk(G,N,X) -> - PTab = ic_genobj:pragmatab(G), - OTab = ic_genobj:optiontab(G), - OpName = get_id2(X), -% SID = ic_util:to_colon(N), - Res = case use_tk(OTab,[N]) of - {ok,N} -> - true; - false -> - %% Look if there is an operation with that name - %% which can be found in an included file. - case ets:match(PTab,{file_data_included,'_','_',op,'$3',OpName,'_','_','_'}) of - [] -> - false; - ScopeList -> - case use_tk(OTab,ScopeList) of - %% There is an operation with that name, - %% look if it is inherited by interface "N" - {ok,FoundScope} -> - ic_pragma:is_inherited_by(FoundScope,N,PTab); - false -> - false - end - end - end, - Res. - - -use_tk(_,[]) -> - false; -use_tk(OTab,[[Scope]|Scopes]) -> - SID = ic_util:to_colon(Scope), - case ets:match(OTab,{{option,{use_tk,SID}},true}) of - [] -> - case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of - [] -> - use_tk(OTab,Scopes); - _ -> - {ok,Scope} - end; - _ -> - {ok,Scope} - end; -use_tk(OTab,[Scope|Scopes]) -> - SID = ic_util:to_colon(Scope), - case ets:match(OTab,{{option,{use_tk,SID}},true}) of - [] -> - case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of - [] -> - use_tk(OTab,Scopes); - _ -> - {ok,Scope} - end; - _ -> - {ok,Scope} - end. - - - - - -mark_not_transparent(G,N) -> - - %% Mark that there are multiple - %% functions in interface - S = ic_genobj:pragmatab(G), - ets:insert(S,{no_transparent,N}). - - -transparent(G) -> - - S = ic_genobj:pragmatab(G), - case ets:match_object(S,{no_transparent,'$0'}) of - [] -> - true; - _ -> - false - end. - diff --git a/lib/ic/src/ic_options.erl b/lib/ic/src/ic_options.erl deleted file mode 100644 index d7f56c0d46..0000000000 --- a/lib/ic/src/ic_options.erl +++ /dev/null @@ -1,364 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_options). - --include_lib("ic/src/ic.hrl"). --include_lib("kernel/include/file.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([defaultBe/0, float_to_version/1, get_opt/2, add_opt/3, - read_cfg/2, which_opts/1, allowed_opt/2]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% Option handling -%% -%% Valid options are: (those with * is NotYetImpl) -%% -%% pedantic - makes the compiler really nitty-gritty about its input -%% -%% Wall - those warning options that we feel an IDL programmer should -%% care about. Not as picky as pedantic -%% -%% warn_multi_mod - warn if several modules are declared in the same -%% IDL file -%% -%% warn_nested_mod - warn if there are nested modules. This is not a -%% problem but it breakes the rule that modules are put into one file -%% each. -%% -%% warn_name_shadow - warn if identifiers are shadow through inherited -%% interfaces. Default is true. -%% -%% warn_quoted_atom - warn if atoms needs quote, this makes Erlang -%% code less nice but is certainly no error. -%% -%% nowarn - suppress all warning messages. Will still output warnings -%% if silent2 option is used -%% -%% always_outargs - force object server implementation return the -%% tuple {RetVal, OutArgs, NewState} even if there are no OutArgs. If -%% this option is not set then such an operation implementation is -%% assumed to return {RetVal, NewState} -%% -%% use_proc_dict - use the process dictionary in the client -%% stubs. This means that client stubs return RetVal instead of {ok, -%% RetVal, OutArgs} and that corba:get_outargs() returns OutArgs. The -%% out arguments are stored with the key '$corba_outargs'. -%% -%% module_group - use the top module as file name for both skeletons -%% and stubs. Default value is false which means that each interface -%% is put in a separate file. -%% -%% skel_module_group - group all interfaces in a module in one -%% skeleton file as opposed to one skeleton file for each -%% interface. Defaults to false. -%% -%% stub_module_group - group all interface stubs from a module in one -%% stub file as opposed to one stub file for each interface. Default -%% is false. -%% -%% *help - prints a small summary of the compiler usage -%% -%% silent - suppresses all messages from the compiler -%% -%% silent2 - suppresses all messages from the compiler and returns all -%% warnings or errors as lists. Returns {ok, WarnList} or {error, -%% WarnList, ErrList} -%% -%% *noexec - runs the compiler but does not open files or write to -%% files. -%% -%% {serv, <ModName>} - sets the name of the implementation skeleton -%% file. This defaults to ModName_skel. -%% -%% {impl, <ModName>} - sets the name of the interface server -%% implementation module name. This defaults to InterfaceName_impl -%% -%% {outdir, Dir} - use Dir as the directory to put all generated -%% files. -%% -%% {servdir, Dir} - put all generated skel files in the directory Dir. -%% -%% {stubdir, Dir} - put all generated stub files in the directory Dir. -%% -%% {this, InterfaceOrOpName} - puts the OE_THIS parameter into the -%% impl. call. This option can be used both on whole interfaces an on -%% distinct operations. Fullscoped names must be used (as in {this, -%% "M1::I1::Op"}). The option can be given in 3 ways: {this, Name} -%% means this will be added to all matching Name or as {{this, Name}, -%% true} or this can explicitly be asked to be left out as in {{this, -%% Name}, false} which enables OE_THIS to be passed to all ops of an -%% interface except those set by the false flag. -%% -%% cfgfile - sets the name of the config file that is read at -%% startup. The order of the different ways to set options is: default -%% setting, configuration file, options given when generator is -%% called. Default name for this file is .ic_config -%% -%% serv_last_call - tells what the last handle_call clause should -%% do. It can have the values exception, which makes the last clause -%% return a CORBA exception and exit which does not generate a last clause -%% (which will make the server crash on an unknown call) -%% -%% -%% -- UNDOCUMENTED -- -%% -%% debug - prints debug information -%% -%% tokens - prints the tokens from the tokenizer and then exit -%% -%% form - prints the form from the parser and then exit -%% -%% tform - form returned from type check -%% -%% time - if true then time is measured during compilation -%% -%% -%%-------------------------------------------------------------------- -allowed_opt(default_opts, _V) -> true; -allowed_opt(debug, V) -> is_bool(V); -allowed_opt(tokens, V) -> is_bool(V); -allowed_opt(form, V) -> is_bool(V); -allowed_opt(tform, V) -> is_bool(V); -allowed_opt(time, V) -> is_bool(V); -allowed_opt(maxerrs, V) -> is_intorinfinity(V); -allowed_opt(maxwarns, V) -> is_intorinfinity(V); -allowed_opt(nowarn, V) -> is_bool(V); -allowed_opt(show_opts, V) -> is_bool(V); - -allowed_opt(help, V) -> is_bool(V); -allowed_opt('Wall', V) -> is_bool(V); -allowed_opt(warn_multi_mod, V) -> is_bool(V); -allowed_opt(warn_quoted_atom, V) -> is_bool(V); -allowed_opt(warn_nested_mod, V) -> is_bool(V); -allowed_opt(warn_name_shadow, V) -> is_bool(V); -allowed_opt(module_group, V) -> is_bool(V); -allowed_opt(skel_module_group, V) -> is_bool(V); -allowed_opt(stub_module_group, V) -> is_bool(V); -allowed_opt(always_outargs, V) -> is_bool(V); -allowed_opt(pedantic, V) -> is_bool(V); -%%allowed_opt(gen_serv, V) -> is_bool(V); -%%allowed_opt(gen_stub, V) -> is_bool(V); -allowed_opt(gen_hrl, V) -> is_bool(V); -allowed_opt(serv_last_call, exception) -> true; -allowed_opt(serv_last_call, exit) -> true; -allowed_opt(silent, V) -> is_bool(V); -allowed_opt(silent2, V) -> is_bool(V); -allowed_opt({serv, _}, _V) -> true; -allowed_opt({impl, _}, _V) -> true; -allowed_opt(outdir, _V) -> true; -allowed_opt(servdir, _V) -> true; -allowed_opt(stubdir, _V) -> true; -allowed_opt(cfgfile, _V) -> true; -allowed_opt(use_preproc, V) -> is_bool(V); -allowed_opt(preproc_cmd, _V) -> true; -allowed_opt(preproc_flags, _V) -> true; -allowed_opt(this, _V) -> true; -allowed_opt({this, _}, V) -> is_bool(V); -allowed_opt(from, _V) -> true; -allowed_opt({from, _}, V) -> is_bool(V); -allowed_opt(handle_info, _V) -> true; -allowed_opt({handle_info, _}, V) -> is_bool(V); -allowed_opt(timeout, _V) -> true; -allowed_opt({timeout, _}, V) -> is_bool(V); -allowed_opt(c_timeout, {V1, V2}) -> is_int(V1) and is_int(V2); -allowed_opt(c_timeout, V) -> is_int(V); -allowed_opt(c_report, V) -> is_bool(V); -allowed_opt(scoped_op_calls, V) -> is_bool(V); -% Compatibility option (semantic check limitation) -allowed_opt(scl, V) -> is_bool(V); -% Added switches for non corba generation -allowed_opt(flags, V) -> is_int(V); -allowed_opt(be, erl_corba) -> true; -allowed_opt(be, erl_template) -> true; -allowed_opt(be, erl_genserv) -> true; -allowed_opt(be, c_genserv) -> true; -allowed_opt(be, erl_plain) -> true; -allowed_opt(be, c_server) -> true; -allowed_opt(be, c_client) -> true; -allowed_opt(be, java) -> true; -% Noc backend -allowed_opt(be, noc) -> true; -allowed_opt({broker,_},{_,transparent}) -> true; -allowed_opt({broker,_},{_,Term}) -> is_term(Term); -allowed_opt({use_tk,_},V) -> is_bool(V); -% -% Multiple be -allowed_opt(multiple_be, _List) -> true; -% -allowed_opt(precond, {_M, _F}) -> true; -allowed_opt({precond, _}, {_M, _F}) -> true; -allowed_opt(postcond, {_M, _F}) -> true; -allowed_opt({postcond, _}, {_M, _F}) -> true; -allowed_opt(no_codechange, V) -> is_bool(V); -allowed_opt(user_protocol, _V) -> true; -allowed_opt(light_ifr, V) -> is_bool(V); -allowed_opt(_, _) -> false. - - --define(DEFAULTCFGFILE, ".ic_config"). - -which_opts(G) -> - ets:match(G#genobj.options, {{option, '$1'}, '$2'}). - -add_opt(G, KList, Val) when is_list(KList) -> - lists:foreach(fun({K, V}) -> add_opt(G, K, V); - (K) -> add_opt(G, K, Val) end, - KList); - -add_opt(G, servdir, V) -> - do_add_opt(G, servdir, assure_directory(G, ic_util:to_list(V))); -add_opt(G, stubdir, V) -> - do_add_opt(G, stubdir, assure_directory(G, ic_util:to_list(V))); -add_opt(G, K, V) -> - do_add_opt(G, K, V). - - -assure_directory(_G, Dir) -> - Dirs = filename:split(Dir), - check_dirs(Dirs, [], filename:pathtype(Dir)). - -check_dirs([X | Xs], SoFar, Type) -> - New = if SoFar == [], Type /= absolute -> - X; - true -> - filename:join(SoFar, X) - end, - assert_dir(New), - check_dirs(Xs, New, Type); -check_dirs([], SoFar, _Type) -> - SoFar. - -assert_dir(D) -> - case file:read_file_info(D) of - {ok, X} when X#file_info.type == directory -> ok; - _ -> case file:make_dir(D) of - ok -> ok; - _ -> exit({could_not_create, D}) - end - end. - -do_add_opt(G, handle_info, V) -> - ?insert(G#genobj.options, {option, {handle_info, V}}, true); -do_add_opt(G, {handle_info, V}, false) -> - ?insert(G#genobj.options, {option, {handle_info, V}}, force_false); -do_add_opt(G, timeout, V) -> - ?insert(G#genobj.options, {option, {timeout, V}}, true); -do_add_opt(G, {timeout, V}, false) -> - ?insert(G#genobj.options, {option, {timeout, V}}, force_false); -do_add_opt(G, this, V) -> - ?insert(G#genobj.options, {option, {this, V}}, true); -do_add_opt(G, {this, V}, false) -> - ?insert(G#genobj.options, {option, {this, V}}, force_false); -do_add_opt(G, from, V) -> - ?insert(G#genobj.options, {option, {from, V}}, true); -do_add_opt(G, {from, V}, false) -> - ?insert(G#genobj.options, {option, {from, V}}, force_false); -do_add_opt(G, scoped_op_calls, V) when V /= true, V /= false -> - ?insert(G#genobj.options, {option, {scoped_op_calls, V}}, false); -do_add_opt(G, K, V) -> - case allowed_opt(K, V) of - true -> - case expand_opt(K) of - L when is_list(L) -> - add_opt(G, L, V); - _ -> - %%io:format("Add opt: ~p ~p~n", [K, V]), - ?insert(G#genobj.options, {option, K}, V) - end; - _ -> - ic_error:warn(G, {illegal_opt, K}) - end. - -get_opt(G, K) -> - case ets:lookup(G#genobj.options, {option, K}) of - [] -> false; - [{{_, K}, V}] -> V - end. - -expand_opt(pedantic) -> [warn_multi_mod, warn_quoted_atom, always_outargs]; -expand_opt(module_group) -> [skel_module_group, stub_module_group]; -expand_opt('Wall') -> [warn_multi_mod, warn_nested_mod, warn_name_shadow]; -expand_opt(outdir) -> [servdir, stubdir]; -expand_opt(default_opts) -> - ['Wall', gen_hrl, {serv_last_call, exception}, - {outdir, []}, use_preproc, {preproc_cmd, "erl"}, - {preproc_flags, ""}, {maxerrs, 10}, {maxwarns, infinity}]; -%% gcc preproc command {preproc_cmd, "gcc -x c++ -E"} -expand_opt(Opt) -> Opt. - - -%% Use this if user not provide -%% a backend. -defaultBe() -> erl_corba. - - -%% -%% Read any config file -read_cfg(G, Opts) -> - Name = case lists:keysearch(cfgfile, 1, Opts) of - {value, {_, N}} -> ic_util:to_list(N); - _ -> ?DEFAULTCFGFILE - end, - case file:consult(Name) of - {ok, OptList} -> - add_opt(G, OptList, true); - _X when Name == ?DEFAULTCFGFILE -> ok; -%% {error, X} -> -%% ic_error:warn(G, {cfg_open, X, Name}); - X -> ic_error:warn(G, {cfg_open, X, Name}) - end. - - -float_to_version({_,_,Str}) -> Str. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- -is_bool(true) -> true; -is_bool(false) -> true; -is_bool(_) -> false. - -is_int(V) when is_integer(V) -> true; -is_int(_) -> false. - -is_intorinfinity(X) when is_integer(X) -> true; -is_intorinfinity(infinity) -> true; -is_intorinfinity(_X) -> false. - - -is_term(Term) when is_tuple(Term) -> true; -is_term(_NoTerm) -> false. - diff --git a/lib/ic/src/ic_plainbe.erl b/lib/ic/src/ic_plainbe.erl deleted file mode 100644 index 6875c1314e..0000000000 --- a/lib/ic/src/ic_plainbe.erl +++ /dev/null @@ -1,356 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% --module(ic_plainbe). - - --export([do_gen/3]). -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --import(ic_util, [mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). --import(ic_forms, [get_id/1, get_id2/1, get_body/1]). --import(ic_codegen, [emit/3, nl/1]). - --import(lists, [foreach/2, map/2]). - --include("icforms.hrl"). --include("ic.hrl"). - -%%------------------------------------------------------------ -%% -%% Generate the client side Erlang stubs. -%% -%% Each module is generated to a separate file. -%% -%% Export declarations for all interface functions must be -%% generated. Each function then needs to generate a function head and -%% a body. IDL parameters must be converted into Erlang parameters -%% (variables, capitalised) and a type signature list must be -%% generated (for later encode/decode). -%% -%%------------------------------------------------------------ - - -do_gen(G, File, Form) -> - G2 = ic_file:filename_push(G, [], mk_oe_name(G, - ic_file:remove_ext(to_list(File))), - erlang), - gen_head(G2, [], Form), - exportDependency(G2), - gen(G2, [], Form), - genDependency(G2), - ic_file:filename_pop(G2, erlang), - ok. - - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = ic:handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, module) -> - CD = ic_code:codeDirective(G,X), - G2 = ic_file:filename_push(G, N, X, CD), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - G3 = ic_file:filename_pop(G2, CD), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, interface) -> - %% Add inheritence data to pragmatab - ic_pragma:add_inh_data(G,N,X), - G2 = ic_file:filename_push(G, N, X, erlang), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, - X#interface.inherit_body), - G3 = ic_file:filename_pop(G2, erlang), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, const) -> -% N2 = [get_id2(X) | N], - emit_constant_func(G, X#const.id, X#const.val), - gen(G, N, Xs); %% N or N2? - -gen(G, N, [X|Xs]) when is_record(X, op) -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_func(G, N, X, Name, ArgNames, TypeList, OutArgs), - gen(G, N, Xs); - - -gen(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_func/7), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, erlang), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) -> - case may_contain_structs(X) of - true -> icstruct:struct_gen(G, N, X, erlang); - false -> ok - end, - gen(G, N, Xs); - -gen(_G, _N, []) -> ok. - - -may_contain_structs(X) when is_record(X, typedef) -> true; -may_contain_structs(X) when is_record(X, struct) -> true; -may_contain_structs(X) when is_record(X, union) -> true; -may_contain_structs(_X) -> false. - - -%%------------------------------------------------------------ -%% -%% Export stuff -%% -%% Gathering of all names that should be exported from a stub -%% file. -%% - - -gen_head_special(G, N, X) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - - foreach(fun({Name, Body}) -> - ic_codegen:comment(Fd, "Exports from ~p", - [ic_util:to_colon(Name)]), - ic_codegen:export(Fd, exp_top(G, N, Body, [])), - nl(Fd) - end, X#interface.inherit_body), - Fd; -gen_head_special(_G, _N, _X) -> ok. - - - -%% Shall generate all export declarations -gen_head(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - F = ic_genobj:stubfiled(G), - ic_codegen:comment(F, "Interface functions"), - ic_codegen:export(F, exp_top(G, N, X, [])), - nl(F), - gen_head_special(G, N, X); - false -> ok - end. - -exp_top(_G, _N, X, Acc) when element(1, X) == preproc -> - Acc; -exp_top(G, N, L, Acc) when is_list(L) -> - exp_list(G, N, L, Acc); -exp_top(G, N, M, Acc) when is_record(M, module) -> - exp_list(G, N, get_body(M), Acc); -exp_top(G, N, I, Acc) when is_record(I, interface) -> - exp_list(G, N, get_body(I), Acc); -exp_top(G, N, X, Acc) -> - exp3(G, N, X, Acc). - -exp3(_G, _N, C, Acc) when is_record(C, const) -> - [{get_id(C#const.id), 0} | Acc]; - -exp3(_G, _N, Op, Acc) when is_record(Op, op) -> - FuncName = get_id(Op#op.id), - Arity = length(ic:filter_params([in, inout], Op#op.params)), - [{FuncName, Arity} | Acc]; - -exp3(_G, _N, A, Acc) when is_record(A, attr) -> - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case A#attr.readonly of - {readonly, _} -> [{Get, 1} | Acc2]; - _ -> [{Get, 1}, {Set, 2} | Acc2] - end end, Acc, ic_forms:get_idlist(A)); - -exp3(_G, _N, _X, Acc) -> Acc. - -exp_list(G, N, L, OrigAcc) -> - lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc) end, OrigAcc, L). - - - - -%%------------------------------------------------------------ -%% -%% Emit stuff -%% -%% Low level generation primitives -%% - - -emit_func(G, _N, X, Name, ArgNames, _TypeList, OutArgs) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - OpName = list_to_atom(Name), - ArgList = mk_list(ArgNames), - emit_op_comment(G, Fd, X, OpName, ArgNames, OutArgs), - emit(Fd, "~p(~s) ->\n", [OpName,ArgList]), - emit(Fd, " ~p:~p(~s).\n\n", [to_atom(ic_genobj:impl(G)), OpName, ArgList]) - end. - -emit_attr(G, N, X, F) -> - XX = #id_of{type=X}, - {GetType, SetType} = mk_attr_func_types(N, X), - lists:foreach(fun(Id) -> - X2 = XX#id_of{id=Id}, - {Get, Set} = mk_attr_func_names(N, get_id(Id)), - F(G, N, X2, Get, [], GetType, []), - case X#attr.readonly of - {readonly, _} -> ok; - _ -> - F(G, N, X2, Set, [ic_util:mk_name(G, "Value")], - SetType, []) - end end, ic_forms:get_idlist(X)). - -emit_constant_func(G, Id, Val) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - N = list_to_atom(get_id(Id)), - emit_const_comment(G, Fd, Id, N), - emit(Fd, "~p() -> ~p.\n\n", [N, Val]) - end. - - -emit_const_comment(_G, F, _X, Name) -> - ic_codegen:mcomment_light(F, - [io_lib:format("Constant: ~p", [Name])]). - - -emit_op_comment(G, F, X, Name, InP, OutP) -> - ic_codegen:mcomment_light(F, - [io_lib:format("~s: ~p", [get_title(X), Name]), - "", - get_returns(G, X, InP, OutP) | - get_raises(X)]). - -get_title(X) when is_record(X, attr) -> "Attribute Operation"; -get_title(_X) -> "Operation". - -get_raises(X) when is_record(X, op) -> - if X#op.raises == [] -> []; - true -> - [" Raises: " ++ - mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, X#op.raises))] - end; -get_raises(_X) -> []. - -get_returns(_G, _X, _InP, []) -> - " Returns: RetVal"; -get_returns(G, _X, _InP, OutP) -> - " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]). - - - - -%%------------------------------------------------------------ -%% -%% Utilities -%% -%% Convenient little go-get functions -%% -%%------------------------------------------------------------ - -%% The automaticly generated get and set operation names for an -%% attribute. -mk_attr_func_names(_Scope, Name) -> - {"_get_" ++ Name, "_set_" ++ Name}. - -%% Returns TK of the Get and Set attribute functions. -mk_attr_func_types(_N, X) -> - TK = ic_forms:get_tk(X), - {{TK, [], []}, {tk_void, [TK], []}}. - - - -%%------------------------------------------------------------ -%% -%% Generation utilities and common stuff -%% -%% Convenient stuff for generation -%% -%%------------------------------------------------------------ - - -%% Input is a list of parameters (in parse form) and output is a list -%% of capitalised variable names. mk_var is in icgen -mk_erl_vars(_G, Params) -> - map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). - - -%% mk_list produces a nice comma separated string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - - -%%------------------------------------------------------------ -%% -%% Parser utilities -%% -%% Called from the yecc parser. Expands the identifier list of an -%% attribute so that the attribute generator never has to handle -%% lists. -%% -%%------------------------------------------------------------ - - - - -%% Export code produce for dependency function -exportDependency(G) -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:export(Fd, [{oe_dependency, 0}]), - nl(Fd). - -%% Code produce for dependency function -genDependency(G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd),nl(Fd), - ic_codegen:comment(Fd, "Idl file dependency list function"), - emit(Fd, "oe_dependency() ->\n", []), - emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). - - - - -extract_info(G, _N, X) when is_record(X, op) -> - Name = get_id2(X), - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - ArgNames = mk_erl_vars(G, InArgs), - TypeList = {ic_forms:get_tk(X), - map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), - map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) - }, - {Name, ArgNames, TypeList, OutArgs}. diff --git a/lib/ic/src/ic_pp.erl b/lib/ic/src/ic_pp.erl deleted file mode 100644 index 8c2e3a0ffe..0000000000 --- a/lib/ic/src/ic_pp.erl +++ /dev/null @@ -1,2245 +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% -%% -%% --module(ic_pp). - --export([run/2]). - --define(is_number(X), X >= $0, X =< $9). --define(is_upper(X), X >= $A, X =< $Z). --define(is_lower(X), X >= $a, X =< $z). --define(is_underline(X), X == $_). --define(is_tab(X), X == 9). --define(is_space(X), X == 32). --define(tab, 9). --define(space, 32). - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Preprocessor -%% -%% This preprocessor is equivalent to the gcc-preprocessor. It takes a file name and -%% a list of preprocessor flags as an input and returns a processed text file. -%% -%% The processing is done in two phases. -%% In the first phase the input file is tokenised into a list where all comments are -%% replaced by a space and all "backslash-newline" sequences are removed. -%% -%% In the second phase all macros are expanded. - -%% %% %% NOTE: #if, #else, and #elif are not yet implemented. -%% Only '#if 0' is implemented to be possible to keep old code as a comment for -%% future refence by putting '#if 0' before it and '#endif' after it. -%% -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - - -%%====================================================================================== -%% Variables which are used throughout the program: -%% ------------------------------------------------ -%% -%% Command A preprocessor command -%% Current Temporary variable used when tokenising the file -%% Defs The currently valid macro definitions -%% Err The current list of errors = [{file, line number, error text}, ...] -%% File The tokenised file (or what remains of it when expanding the macros) -%% Flags The preprocessor flags -%% FN or FileName Tbe name of the current file -%% IfCou Used for ifdef/ifndef/endif values: check_all | {endif, Endif, IfLine} -%% Endif = number of matching endif's yet to be found -%% Ifline = the line number for the the first found ifdef/ifndef -%% IncDir Directories to be searched for included files -%% IncFile Stack of included files -%% IncLine The line numer of an include -%% L The current line number -%% Name Name of a macro -%% Nl Number of encountered newlines -%% No_of_para Numer of parameters of the currently expanded macro -%% Out The result of the second step -%% Parameters The parameters of the currently expanded macro -%% PrevFile The name of the "parent" file which includes the currently expanded file -%% Rem Remaining of the file currently being expanded -%% Removed The tokens removed, used when removing tokens to the end of a line -%% Result The current result of something -%% SelfRef List of variables which shoud not be expanded at the rescan to avoid -%% endless loops due to self referencing -%% Str Temporary string -%% Text A variable used for string handling, e.g at error handling -%% Tokens Temoprary list when tokenising -%% War The current list of warnings = [{file, line number, warning text}, ...] -%% X Temporary variable used when the value is not important -%% Y Temporary variable used when the value is not important -%% -%%====================================================================================== - -%% Multiple Include Optimization -%% -%% Algorithm described at: -%% http://gcc.gnu.org/onlinedocs/cppinternals/Guard-Macros.html --record(mio, {valid = true, %% multiple include valid - cmacro, %% controlling macro of the current conditional directive - depth = 0, %% conditional directive depth - included = []}). - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% The main entry for the preprocessor -%% -%% -%% Output {ok, Out, War} | {error, Err} -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -run(FileName, Flags) when is_atom(FileName) -> - run(atom_to_list(FileName), Flags); - -run(FileName, Flags) -> - IncDir = include_dir(Flags), - - case catch file:read_file(FileName) of - {ok, Bin} -> - FileList = binary_to_list(Bin), - run(FileList, FileName, IncDir, Flags); - {error, _} -> - Text = "No such file or directory", - {error, [FileName ++ ": " ++ Text]} - end. - - -run(FileList, FileName, IncDir, Flags) -> - %%---------------------------------------------------------- - %% Run the first phase, i.e tokenise the file - %%---------------------------------------------------------- - File = tokenise(FileList, FileName), - - %%---------------------------------------------------------- - %% Run the second phase, i.e expand macros - %%---------------------------------------------------------- - {Out, Err, War, _Defs, _Mio, IfCou} = expand(File, FileName, IncDir, Flags), - - %%---------------------------------------------------------- - %% Check if all #if #ifdef #ifndef have a matching #endif - %%---------------------------------------------------------- - IfError = case IfCou of - {endif, Endif, IfLine} when Endif > 0 -> - [{FileName, IfLine, "unterminated `#if' conditional"}]; - _ -> - [] - end, - - Err2 = Err++IfError, - - case Err2 of - [] -> - {ok, lists:flatten(lists:reverse(Out)), lists:reverse(War)}; - _ -> - {error, lists:reverse(Err2)} - end. - -%%====================================================================================== -%% The entry for all included files -%% -%% -%% Output {Out, Err, War, Defs, MultipleIncludeValid} -%%====================================================================================== -run_include(FileName, FileList, _Out, Defs, Err, War, IncLine, IncFile, IncDir, Mio) -> - - %%---------------------------------------------------------- - %% Run the first phase, i.e tokenise the file - %%---------------------------------------------------------- - [PrevFile | _T] = IncFile, - {File, FileInfoStart, FileInfoEnd} = - tokenise(FileList, FileName, IncLine, PrevFile), - - %%---------------------------------------------------------- - %% Run the second phase, i.e expand macros - %%---------------------------------------------------------- - {Out2, Err2, War2, Defs2, Mio2, IfCou2} = - expand([FileInfoStart|File]++FileInfoEnd, Defs, Err, War, - [FileName|IncFile], IncDir, - #mio{included=Mio#mio.included}), - - MergeIncluded = sets:to_list(sets:from_list(Mio#mio.included ++ Mio2#mio.included)), - - Mio3 = - case {Mio2#mio.valid, Mio2#mio.cmacro} of - {V, Macro} when V == false; - Macro == undefined -> - update_mio(Mio#mio{included=MergeIncluded}); - {true, _} -> - update_mio({include, FileName}, Mio#mio{included=MergeIncluded}) - end, - - %%---------------------------------------------------------- - %% Check if all #if #ifdef #ifndef have a matching #endif - %%---------------------------------------------------------- - IfError = case IfCou2 of - {endif, Endif, IfLine} when Endif > 0 -> - [{FileName, IfLine, "unterminated `#if' conditional"}]; - _ -> - [] - end, - - {Out2, Defs2, Err2++IfError, War2, Mio3}. - - - - -%%=================================================================================== -%%=================================================================================== -%%=================================================================================== -%% Tokenise the file -%% -%% -%% Output: File -%% -%% Description: -%% The input file is tokenised into a list where all comments are replaced -%% by a space and all "backslash-newline" sequences are removed. -%% -%% A file information is added at start and end of an included file to set the -%% current file name and line number. -%% -%% -%% A token consists of: -%% -------------------- -%% -%% {char, Char} special characters like ()[]{},!%& etc -%% {command,Command} a macro command -%% {expanded,Str} an expanded variable, used to prevent infinite loops -%% at self reference -%% {file_info,FI} start and end information of a file -%% FI is a string of the following format: -%% "# Line FileName Int" were Int is -%% 1 if start of an included file, -%% 2 when returning to "parent" file -%% {nl, L} newline -%% {number,Num) variable, a string starting with a number -%% {self_ref,Var} to allow reference to a variable again, used when expanding -%% self refering macros -%% space a space -%% space_exp a space, special notation to prevent not wanted concatination -%% {string, Str} a (tail of a) string constant -%% {string_part, Str} a head of a string constant defined on several consecutive lines -%% {sys_head, Str} (tail of) the file name of included system file -%% {sys_head_part , Str} the file name of included system file -%% {var,Var} variable, a string starting with minuscular or capital letter or -%% an underline -%% -%% Note, comments are not removed within a character or string constant -%% or inside an include-definition where the file name is delimited with < > -%%=================================================================================== -%%=================================================================================== -%%=================================================================================== - -tokenise(File, FileName) -> - {Result, _L} = token(File, 2, [], not_set, 0), - FI_start = lists:reverse(lists:flatten(io_lib:format("# 1 \"~ts\"~n",[FileName]))), - FileInfoStart = {file_info, FI_start}, - [FileInfoStart | Result]. - -tokenise(File, FileName, IncLine, PrevFile) -> - {Result, _L} = token(File, 2, [], not_set, 0), - FI_start = lists:reverse(lists:flatten(io_lib:format("# 1 \"~ts\" 1~n",[FileName]))), - FileInfoStart = {file_info, FI_start}, - FI_end = lists:reverse(lists:flatten(io_lib:format("# ~p \"~ts\" 2~n~n",[IncLine-1,PrevFile]))), - FileInfoEnd = [{file_info, FI_end}], - {Result, FileInfoStart, FileInfoEnd}. -% [FileInfoStart | Result] ++ FileInfoEnd. - - -%%=================================================================================== -%% token(InputFile, L, Result, Gen) -%% Gen information of the first token on the line, default = not_set -%% -%% Output: File -%%=================================================================================== - -%%================================================================== -%% Normal line -%%================================================================== -%%--------------------------------------- -%% All file tokenised -%%--------------------------------------- -token([], L, [{nl,NL}|Result], _Gen, _BsNl) when L == NL+1-> - {lists:reverse([{nl,NL}|Result]), L}; -token([], L, Result, _Gen, _BsNl) -> - {lists:reverse([{nl,L-1}|Result]), L}; - -%%--------------------------------------- -%% String -%%--------------------------------------- -token(File, L, Result, string, BsNl) -> - case token_string(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {string,Str} | Result], - token(Rem, L+1, Result1, string, BsNl); - {Rem, Str} -> - token(Rem, L, [{string,Str}|Result], not_set, BsNl) - end; - -token([$"|File], L, Result, Gen, BsNl) -> - case token_string(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {string_part,Str} | Result], - token(Rem, L+1, Result1, string, BsNl); - {Rem, Str} -> - token(Rem, L, [{string,Str}|Result], Gen, BsNl) - end; - -%%--------------------------------------- -%% Include with < > -%%--------------------------------------- -token(File, L, Result, include, BsNl) -> - case token_include(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {sys_head,Str} | Result], - token(Rem, L+1, Result1, include, BsNl); - {Rem, Str} -> - token(Rem, L, [{sys_head,Str}|Result], not_set, BsNl) - end; - -token([$<|File], L, [space,{command,"include"}|Result], Gen, BsNl) -> - case token_include(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {sys_head_part,Str}, space, {command,"include"} |Result], - token(Rem, L+1,Result1, include, BsNl); - {Rem, Str} -> - Result1 = [{sys_head,Str}, space, {command,"include"} |Result], - token(Rem, L, Result1, Gen, BsNl) - end; -token([$<|File], L, [{command,"include"}|Result], Gen, BsNl) -> - case token_include(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {sys_head_part,Str}, space, {command,"include"} |Result], - token(Rem, L+1,Result1, include, BsNl); - {Rem, Str} -> - Result1 = [{sys_head,Str}, space, {command,"include"} |Result], - token(Rem, L, Result1, Gen, BsNl) - end; - - - - -%%--------------------------------------- -%% CR (just remove these) -%%--------------------------------------- -token([$\r|File], L, Result, Gen, BsNl) -> -% Bs = lists:duplicate(BsNl+1,{nl,L}), - token(File, L, Result, Gen, BsNl); %% Bs or BsNl? - -%%--------------------------------------- -%% Newline -%%--------------------------------------- -token([$\n|File], L, Result, _Gen, BsNl) -> - Bs = lists:duplicate(BsNl+1,{nl,L}), - token(File, L+1, Bs++Result, not_set, 0); - -token([$\\,$\n|File], L, Result, Gen, BsNl) -> - token(File, L, Result, Gen, BsNl+1); - -%%--------------------------------------- -%% Comments -%%--------------------------------------- -token([$/,$/|File], L, Result, not_set, BsNl) -> - Rem = skip_to_nl(File), - token(Rem, L+1,[{nl, L} | Result], not_set, BsNl); -token([$/,$/|File], L, Result, _Gen, BsNl) -> - Rem = skip_to_nl(File), - token(Rem, L+1,[{nl, L} | Result], not_set, BsNl); - -token([$/,$*|File], L, Result, not_set, BsNl) -> - case token_comment(File) of - {Rem, nl} -> - token(Rem, L+1, [{nl, L} | Result], not_set, BsNl); - Rem -> - token(Rem, L, Result, not_set, BsNl) - end; -token([$/,$*|File], L, Result, Gen, BsNl) -> - case token_comment(File) of - {Rem, nl} -> - token(Rem, L+1, [{nl, L}, space | Result], not_set, BsNl); - Rem -> - token(Rem, L, [space|Result], Gen, BsNl) - end; - -%%--------------------------------------- -%% Variable -%%--------------------------------------- -token([X|File], L, Result, Gen, BsNl) when ?is_upper(X) -> - GenNew = case Gen of not_set -> var; _ -> Gen end, - {Rem, Var} = tok_var(File, [X]), - token(Rem, L, [{var,Var}|Result], GenNew, BsNl); -token([X|File], L, Result, Gen, BsNl) when ?is_lower(X) -> - GenNew = case Gen of not_set -> var; _ -> Gen end, - {Rem, Var} = tok_var(File, [X]), - token(Rem, L, [{var,Var}|Result], GenNew, BsNl); -token([X|File], L, Result, Gen, BsNl) when ?is_underline(X) -> - GenNew = case Gen of not_set -> var; _ -> Gen end, - {Rem, Var} = tok_var(File, [X]), - token(Rem, L, [{var,Var}|Result], GenNew, BsNl); - -%%--------------------------------------- -%% Number -%%--------------------------------------- -token([X|File], L, Result, Gen, BsNl) when ?is_number(X) -> - GenNew = case Gen of not_set -> number; _ -> Gen end, - {Rem, Tokens} = tok_number(File, [X]), - token(Rem, L, [{number,Tokens}|Result], GenNew, BsNl); - -%%--------------------------------------- -%% Space -%%--------------------------------------- -token([X|File], L, [Y|Result], Gen, BsNl) when ?is_space(X) -> - case Y of - space -> - Rem = remove_leading_spaces(File), - token(Rem, L, [Y|Result], Gen, BsNl); - {nl,_,_} -> - Rem = remove_leading_spaces(File), - token(Rem, L, Result, Gen, BsNl); - _ -> - Rem = remove_leading_spaces(File), - token(Rem, L, [space, Y |Result], Gen, BsNl) - end; - -token([X|File], L, [Y|Result], Gen, BsNl) when ?is_tab(X) -> - case Y of - space -> - Rem = remove_leading_spaces(File), - token(Rem, L, [Y|Result], Gen, BsNl); - {nl,_,_} -> - Rem = remove_leading_spaces(File), - token(Rem, L, Result, Gen, BsNl); - _ -> - Rem = remove_leading_spaces(File), - token(Rem, L, [space, Y |Result], Gen, BsNl) - end; - -%%--------------------------------------- -%% Command -%%--------------------------------------- -token([$#|File], L, Result, not_set, BsNl) -> - {Rem, Command} = token_pp_com(File), - case catch list_to_integer(Command) of - {'EXIT', _} -> - token(Rem, L, [{command,Command}|Result], not_set, BsNl); - _Int -> - Result1 = [{number,Command}, {command,"line"}| Result], - token(Rem, L, Result1, not_set, BsNl) - end; - -%%--------------------------------------- -%% Char -%%--------------------------------------- -token([X|File], L, Result, Gen, BsNl) -> - GenNew = case Gen of not_set -> char; _ -> Gen end, - token(File, L, [{char,X}|Result], GenNew, BsNl). - - -%%================================================================== -%% Scan to the end of a token -%%================================================================== -%%--------------------------------------- -%% Number -%%--------------------------------------- -tok_number([], Str) -> - {[], lists:reverse(Str)}; -tok_number([X|File], Str) when ?is_upper(X) -> - tok_number(File, [X|Str]); -tok_number([X|File], Str) when ?is_lower(X) -> - tok_number(File, [X|Str]); -tok_number([X|File], Str) when ?is_underline(X) -> - tok_number(File, [X|Str]); -tok_number([X|File], Str) when ?is_number(X) -> - tok_number(File, [X|Str]); -tok_number(File, Str) -> - {File, lists:reverse(Str)}. - - -%%--------------------------------------- -%% Variable -%%--------------------------------------- -tok_var([], Str) -> - {[], lists:reverse(Str)}; -tok_var([X|File], Str) when ?is_upper(X) -> - tok_var(File, [X|Str]); -tok_var([X|File], Str) when ?is_lower(X) -> - tok_var(File, [X|Str]); -tok_var([X|File], Str) when ?is_underline(X) -> - tok_var(File, [X|Str]); -tok_var([X|File], Str) when ?is_number(X) -> - tok_var(File, [X|Str]); -tok_var(File, Str) -> - {File, lists:reverse(Str)}. - - -%%--------------------------------------- -%% Preprocessor command -%%--------------------------------------- -token_pp_com([X|File]) when ?is_upper(X) -> - tok_var(File, [X]); -token_pp_com([X|File]) when ?is_lower(X) -> - tok_var(File, [X]); -token_pp_com([X|File]) when ?is_underline(X) -> - tok_var(File, [X]); -token_pp_com([X|File]) when ?is_number(X) -> - tok_var(File, [X]); -token_pp_com(File) -> - Rem = remove_leading_spaces(File), - {Rem, "null"}. - - - -%%--------------------------------------- -%% Comment -%%--------------------------------------- -token_comment([]) -> - []; -token_comment([$*,$/|File]) -> - File; -token_comment([$\n|File]) -> - {[$/,$*|File], nl}; -token_comment([$\r,$\n|File]) -> - {[$/,$*|File], nl}; -token_comment([$\\,$\n|File]) -> - {[$/,$*|File], nl}; -%token_comment([$\\,$\n|File]) -> -% token_comment(File); -token_comment([_|File]) -> - token_comment(File). - - -%%--------------------------------------- -%% String -%%--------------------------------------- -token_string([], Str) -> - {[], lists:reverse(Str)}; -token_string([$"|File], Str) -> - {File, lists:reverse(Str)}; -token_string([$\n|File], Str) -> - {File, lists:reverse(Str), nl}; -token_string([$\r,$\n|File], Str) -> - {File, lists:reverse(Str), nl}; -token_string([$\\,$\n|File], Str) -> - token_string(File, Str); -token_string([X|File], Str) -> - token_string(File, [X|Str]). - - -%%--------------------------------------- -%% Include -%%--------------------------------------- -token_include([], Str) -> - {[], lists:reverse(Str)}; -token_include([$>|File], Str) -> - {File, lists:reverse(Str)}; -token_include([$\n|File], Str) -> - {File, lists:reverse(Str), nl}; -token_include([$\r,$\n|File], Str) -> - {File, lists:reverse(Str), nl}; -token_include([$\\,$\n|File], Str) -> - token_include(File, Str); -token_include([X|File], Str) -> - token_include(File, [X|Str]). - - - - -%%=================================================================================== -%% detokenise a list of tokens, until next newline -%% -%% Output: a string -%%=================================================================================== -detokenise(Tokens) -> - detokenise(Tokens, []). - -detokenise([], Result) -> - lists:flatten(Result); -detokenise([space], Result) -> - lists:flatten(Result); -detokenise([space_exp], Result) -> - lists:flatten(Result); -detokenise([space|Rem], Result) -> - detokenise(Rem, Result++[?space]); -detokenise([space_exp|Rem], Result) -> - detokenise(Rem, Result++[?space]); -detokenise([nl|Rem], Result) -> - detokenise(Rem, Result++[$\n]); -detokenise([{_, String}|Rem], Result) -> - detokenise(Rem, Result++[String]). - - -detokenise_pragma(Tokens) -> - detokenise_pragma(Tokens, []). - -detokenise_pragma([], Result) -> - lists:flatten(Result); -detokenise_pragma([space], Result) -> - lists:flatten(Result); -detokenise_pragma([space|Rem], Result) -> - detokenise_pragma(Rem, Result++[?space]); -detokenise_pragma([nl|Rem], Result) -> - detokenise_pragma(Rem, Result++[$\n]); -detokenise_pragma([{string, String}|Rem], Result) -> - detokenise_pragma(Rem, Result++[$"|String]++[$"]); -detokenise_pragma([{_, String}|Rem], Result) -> - detokenise_pragma(Rem, Result++[String]). - - - - - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Expand macros. -%% -%% -%% Output: A text file -%% -%% Description: Expands all macros. All macro definitions are logged in a list 'Defs' -%% and all found errors and warnings are logged in a list 'Err' and 'War', -%% respectively. -%% -%% When a macro name is found in a source line it is expanded according -%% to the current 'Defs'-list. The macro must agree both to the name -%% and number of parameters, otherwise an error is reported. -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - - -expand(List, FileName, IncDir, Flags) -> - %% Get all definitions from preprocessor commnads - %% and merge them on top of the file collected. - CLDefs = get_cmd_line_defs(Flags), - expand(List, [], [], CLDefs, [FileName], IncDir, #mio{}, check_all, [], [], 1, FileName). - -expand(List, Defs, Err, War, [FileName|IncFile], IncDir, Mio) -> - expand(List, [], [], Defs, [FileName|IncFile], IncDir, Mio, check_all, Err, War, 1, FileName). - -%%======================================================= -%% Main loop for the expansion -%%======================================================= -expand([], Out, _SelfRef, Defs, _IncFile, _IncDir, Mio, IfCou, Err, War, _L, _FN) -> -% io:format("~n ===============~n"), -% io:format(" definitions ~p~n",[lists:reverse(Defs)]), -% io:format(" found warnings ~p~n",[lists:reverse(War)]), -% io:format(" found errors ~p~n",[lists:reverse(Err)]), -% io:format(" ===============~n~n~n"), - {Out, Err, War, Defs, Mio, IfCou}; - -expand([{file_info, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, Str++Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); - -%%--------------------------------------- -%% Searching for endif, -%% i.e skip all source lines until matching -%% end if is encountered -%%--------------------------------------- -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) - when Command == "ifdef" -> - {_Removed, Rem2, _Nl} = read_to_nl(Rem), - IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); - - -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) - when Command == "ifndef" -> - {_Removed, Rem2, _Nl} = read_to_nl(Rem), - IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); - - -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) - when Command == "if" -> - case pp_command(Command, Rem, Defs, IncDir, Mio, Err, War, L, FN) of - {{'if', true}, Rem2, Err2, War2, Nl} -> - IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); -%% {{'if', false}, Rem2, Err2, War2, Nl} -> Not implemented yet - {{'if', error}, Rem2, Err2, War2, Nl} -> - IfCou2 = {endif, Endif, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN) - end; - -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) - when Command == "endif" -> - {_Removed, Rem2, Nl} = read_to_nl(Rem), - case Endif of - 1 -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L+Nl, FN); - _ -> - IfCou2 = {endif, Endif-1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L+Nl, FN) - end; - - -expand([{command,_Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> - {_Removed, Rem2, _Nl} = read_to_nl(Rem), - IfCou2 = {endif, Endif, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); - -%% Solves a bug when spaces in front of hashmark ! -expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); - -expand([{nl,_Nl} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); - - -expand([_X | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> - {_Removed, Rem2, Nl} = read_to_nl(Rem), - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); - - - - - -%%--------------------------------------- -%% Check all tokens -%%--------------------------------------- -expand([{nl, _N} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [$\n | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L+1, FN); - -expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); - -expand([space_exp | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); - -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L, FN) -> - case pp_command(Command, Rem, Defs, IncDir, Mio, Err, War, L, FN) of - {define, Rem2, Defs2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); - - {undef, Rem2, Defs2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); - - {{include, ok}, FileName, FileCont, Rem2, Nl, Err2, War2} -> - {Out3, Defs3, Err3, War3, Mio2} = - run_include(FileName, FileCont, Out, Defs, Err2, War2, L+Nl, IncFile, IncDir, Mio), - Nls = [], - Out4 = Out3++Nls++Out, - expand(Rem2, Out4, SelfRef, Defs3, IncFile, IncDir, Mio2, check_all, Err3, War3, L+Nl, FN); - - {{include, error}, Rem2, Nl, Err2, War2} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); - - {{include, skip}, Rem2} -> - Out2 = [$\n|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+1, FN); - - {{ifdef, true}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); - {{ifdef, false}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Mio2 = update_mio(ifdef, Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); - - {{ifndef, true}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); - {{ifndef, false}, Macro, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Mio2 = update_mio({ifndef, Macro}, Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); - - {endif, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Mio2 = update_mio(endif, Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); - - {{'if', true}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); -%% {{'if', false}, Removed, Rem2, Nl} -> Not implemented at present - {{'if', error}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Mio2 = update_mio('if', Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); - - {'else', {_Removed, Rem2, Nl}} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Err2 = {FN, L, "`else' command is not implemented at present"}, - Mio2 = update_mio('else', Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN); - - {'elif', {_Removed, Rem2, Nl}} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Err2 = {FN, L, "`elif' command is not implemented at present"}, - Mio2 = update_mio('elif', Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN); - - {warning, {WarningText, Rem2, Nl}} -> - [FileName|_More] = IncFile, - War2 = {FileName, L, "warning: #warning "++detokenise(WarningText)}, - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, [War2|War], L+Nl, FN); - - {error, {ErrorText, Rem2, Nl}} -> - [FileName|_More] = IncFile, - Err2 = {FileName, L, detokenise(ErrorText)}, - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, [Err2|Err], War, L+Nl, FN); - - {{line, ok}, {_Removed, Rem2, Nl}, L2, FN2, LineText} -> - Out2 = lists:duplicate(Nl,$\n)++LineText++Out, - [_X|IF] = IncFile, - IncFile2 = [FN2|IF], - expand(Rem2, Out2, SelfRef, Defs, IncFile2, IncDir, update_mio(Mio), check_all, Err, War, L2, FN2); - {{line, error}, {_Removed, Rem2, Nl}, Err2} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, [Err2|Err], War, L+Nl, FN); - - hash_mark -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L, FN); - - {pragma, Rem2, Nl, Text} -> - Out2 = lists:duplicate(Nl,$\n)++Text++Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+Nl, FN); - - {ident, Rem2, Nl, Text} -> - Out2 = lists:duplicate(Nl,$\n)++Text++Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+Nl, FN); - - {not_recognised, {Removed, Rem2, Nl}} -> - Text = lists:reverse([$#|Command]), - RemovedS = lists:reverse([?space|detokenise(Removed)]), - Out2 = [$\n|RemovedS]++Text++Out, - Mio2 = update_mio(Mio), - case Command of - [X|_T] when ?is_upper(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); - [X|_T] when ?is_lower(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); - [X|_T] when ?is_underline(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); - _ -> - Err2 = {FN, L, "invalid preprocessing directive name"}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN) - end; - - Else -> -% io:format(" %%%%Else%%%%%% ~p~n",[Else]), - exit(Else) - end; - - -expand([{var, "__LINE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - LL = io_lib:format("~p",[L]), - expand(Rem, [LL | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__FILE__"}|Rem], Out, SelfRef, Defs, IncFile, Mio, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [$",FN,$" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__DATE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - {{Y,M,D},{_H,_Mi,_S}} = calendar:universal_time(), - Date = io_lib:format("\"~s ~p ~p\"",[month(M),D,Y]), - expand(Rem, [Date | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__TIME__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - {{_Y,_M,_D},{H,Mi,S}} = calendar:universal_time(), - HS = if H < 10 -> "0"++integer_to_list(H); - true -> integer_to_list(H) - end, - MiS = if Mi < 10 -> "0"++integer_to_list(Mi); - true -> integer_to_list(Mi) - end, - SS = if S < 10 -> "0"++integer_to_list(S); - true -> integer_to_list(S) - end, - Time = io_lib:format("\"~s:~s:~s\"",[HS,MiS,SS]), - expand(Rem, [Time | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__INCLUDE_LEVEL__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - IL = io_lib:format("~p",[length(IncFile)-1]), - expand(Rem, [IL | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__BASE_FILE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - [BF|_T] = lists:reverse(IncFile), - expand(Rem, [$",BF,$" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, Var} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - {Out2, Err2, War2, Rem2, SelfRef2} = - source_line(Var, Rem, SelfRef, Defs, Err, War, L, FN), - expand(Rem2, [Out2 | Out], SelfRef2, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err2, War2, L, FN); - -expand([{char, Char} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [Char | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{number, Number} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [Number | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{expanded, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [Str | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{self_ref, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - SelfRef2 = lists:delete(Str,SelfRef), - expand(Rem, Out, SelfRef2, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{string, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [$", Str, $" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{string_part, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - {Str2, Rem2, Nl} = expand_string_part([$"|Str], Rem), - expand(Rem2, [Str2| Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L+Nl, FN). - - - - - - - - -%%======================================================================== -%% Expand a line starting as a partial string -%%======================================================================== -expand_string_part(Str, File) -> - expand_string_part(File, Str, 0). - -expand_string_part([{string, Str_part} | Rem], Str, Nl) -> - {Str++Str_part++[$"], Rem, Nl}; -expand_string_part([space | Rem], Str, Nl) -> - expand_string_part(Rem, Str, Nl); -expand_string_part([nl| Rem], Str, Nl) -> - expand_string_part(Rem, Str++[$\n], Nl); -expand_string_part([{string_part, Str_part} | Rem], Str, Nl) -> - expand_string_part(Rem, Str++Str_part, Nl). - - - - - -%%======================================================================== -%% Parse and integrate command line macro directives -%% At this momment, only -D and -U are supported (gcc like) -%%======================================================================== - - -%% Collect all command line macro definitions -get_cmd_line_defs(Flags) -> - Adjusted = parse_cmd_line(Flags,[]), - - {_Out, _Err, _War, Defs, _IfCou, _Mio} = - expand(tokenise(Adjusted,""), - [], - [], - [], - [], - [], - #mio{}, - check_all, - [], - [], - 1, - ""), - Defs. - -%% Parse command line macros -parse_cmd_line([],Found) -> - lists:flatten(lists:reverse(Found)); - -parse_cmd_line([45,68|Rest],Found) -> - {Collected,RestCmds} = collect_define(Rest,[]), - parse_cmd_line(RestCmds,[Collected|Found]); - -parse_cmd_line([45,85|Rest],Found) -> - {Collected,RestCmds} = collect_undefine(Rest,[]), - parse_cmd_line(RestCmds,[Collected|Found]); - -parse_cmd_line([_|Rest],Found) -> - parse_cmd_line(Rest,Found). - - -%% Collect defines and translate them -%% into a text format -collect_define([],Found) -> - { "#define "++lists:reverse(Found)++"\n", [] }; -collect_define([32|Rest],Found) -> - { "#define "++lists:reverse(Found)++"\n", Rest }; -collect_define([61|Rest],[]) -> - { "", Rest }; -collect_define([61|Rest],Found) -> - collect_define(Rest,[32|Found]); -collect_define([C|Rest],Found) -> - collect_define(Rest,[C|Found]). - - -%% Collect undefines and translate them -%% into a text format -collect_undefine([],Found) -> - { "#undef "++lists:reverse(Found)++"\n", [] }; -collect_undefine([32|Rest],Found) -> - { "#undef "++lists:reverse(Found)++"\n", Rest }; -collect_undefine([C|Rest],Found) -> - collect_undefine(Rest,[C|Found]). - - - - - - - - - - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Read a preprocessor command -%% -%% -%% Output: Depending of the command, typically = {Command, Rem, Err, War, Nl} -%% -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - -pp_command(Command, [space|File], Defs, IncDir, Mio, Err, War, L, FN) -> - pp_command(Command, File, Defs, IncDir, Mio, Err, War, L, FN); - -pp_command(Command, File, Defs, IncDir, Mio, Err, War, L, FN) -> - - case Command of - %%---------------------------------------- - %% #define - %%---------------------------------------- - "define" -> - case define(File, Err, War, L, FN) of - {error, Rem, Err2, War2, Nl} -> - {define, Rem, Defs, Err2, War2, Nl}; - {warning, Rem, Name, No_of_para, Parameters, Macro, Err2, War2, Nl} -> - case is_define_ok(Name, No_of_para, Parameters, Macro, Defs) of - {yes, Defs2} -> - {define, Rem, Defs2, Err2, War2, Nl}; - {no, Defs2} -> - Text = lists:flatten(io_lib:format("`~s' redefined",[Name])), - {define, Rem, Defs2, Err2, [{FN, L, Text}|War2], Nl}; - {error, Text, Defs2} -> - {define, Rem, Defs2, [{FN, L, Text}|Err2], War2, Nl} - end; - {ok, Rem, Name, No_of_para, Parameters, Macro, Err2, War2, Nl} -> - case is_define_ok(Name, No_of_para, Parameters, Macro, Defs) of - {yes, Defs2} -> - {define, Rem, Defs2, Err2, War2, Nl}; - {no, Defs2} -> - Text = lists:flatten(io_lib:format("`~s' redefined",[Name])), - {define, Rem, Defs2, Err2, [{FN, L, Text}|War2], Nl}; - {error, Text, Defs2} -> - {define, Rem, Defs2, [{FN, L, Text}|Err2], War2, Nl} - end - end; - - %%---------------------------------------- - %% #undef - %%---------------------------------------- - "undef" -> - case undef(File, Err, War, L, FN) of - {error, Rem, Err2, War2, Nl} -> - {undef, Rem, Defs, Err2, War2, Nl}; - {ok, Rem, Name, Err2, War2, Nl} -> - Defs2 = lists:keydelete(Name, 1, Defs), - {undef, Rem, Defs2, Err2, War2, Nl} - end; - - %%---------------------------------------- - %% #include - %%---------------------------------------- - "include" -> - case include(File, IncDir, Mio) of - {error, Rem, Nl, Err2} -> - {{include, error}, Rem, Nl, [{FN, L, Err2}|Err], War}; - {error, Rem, Nl, Err2, NameNl} -> - {{include, error}, Rem, Nl, [{FN, L+ NameNl, Err2}|Err], War}; - {ok, FileNamePath, FileCont, Rem, Nl} -> - {{include, ok}, FileNamePath, FileCont, Rem, Nl, Err, War}; - {skip, Rem} -> - {{include, skip}, Rem} - end; - - %%---------------------------------------- - %% #ifdef - %%---------------------------------------- - "ifdef" -> - case define(File, Err, War, L, FN) of - {error, Rem, Err2, War2, Nl} -> - {{ifdef, false}, Rem, Defs, Err2, War2, Nl}; - {warning, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> - case is_defined_before(Name, No_of_para, Defs) of - yes -> - {{ifdef, false}, Rem, Err2, War2, Nl}; - no -> - {{ifdef, true}, Rem, Err2, War2, Nl} - end; - {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> - case is_defined_before(Name, No_of_para, Defs) of - yes -> - {{ifdef, false}, Rem, Err2, War2, Nl}; - no -> - {{ifdef, true}, Rem, Err2, War2, Nl} - end - end; - - - - %%---------------------------------------- - %% #ifndef - %%---------------------------------------- - "ifndef" -> - case define(File, Err, War, L, FN) of - {error, Rem, Err2, War2, Nl} -> - {{ifndef, false}, Rem, Defs, Err2, War2, Nl}; - {warning, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> - case is_defined_before(Name, No_of_para, Defs) of - yes -> - {{ifndef, true}, Rem, Err2, War2, Nl}; - no -> - {{ifndef, false}, Name, Rem, Err2, War2, Nl} - end; - {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> - case is_defined_before(Name, No_of_para, Defs) of - yes -> - {{ifndef, true}, Rem, Err2, War2, Nl}; - no -> - {{ifndef, false}, Name, Rem, Err2, War2, Nl} - end - end; - - - %%---------------------------------------- - %% #endif - %%---------------------------------------- - "endif" -> - {Removed, Rem, Nl} = read_to_nl(File), - case Removed of - [] -> - {endif, Rem, Err, War, 1}; - _ -> - Text = "ignoring the tail of the line", - {ok, Rem, Err, [{FN, L, Text}|War], Nl} - end; - - - %%---------------------------------------- - %% #if - %%---------------------------------------- - "if" -> - case if_zero(File, Err, War, L, FN) of - {error, Rem2, _Removed, Nl} -> - Err2 = {FN, L, "only '#if 0' is implemented at present"}, - {{'if', error}, Rem2, [Err2 | Err], War, Nl}; - {ok, Rem2, 0, _Removed, Nl} -> - {{'if', true}, Rem2, Err, War, Nl}; - {ok, Rem2, _Num, _Removed, Nl} -> - Err2 = {FN, L, "only '#if 0' is implemented at present"}, - {{'if', error}, Rem2, [Err2 | Err], War, Nl} - end; - - %%---------------------------------------- - %% #else - %%---------------------------------------- - "else" -> - {'else', read_to_nl(File)}; - - %%---------------------------------------- - %% #elif - %%---------------------------------------- - "elif" -> - {'elif', read_to_nl(File)}; - - %%---------------------------------------- - %% #pragma - %%---------------------------------------- - "pragma" -> - {Removed, Rem, Nl} = read_to_nl(File), - {pragma, Rem, Nl, lists:reverse("#pragma " ++ detokenise_pragma(Removed))}; - - %%---------------------------------------- - %% #ident - %%---------------------------------------- - "ident" -> - {Removed, Rem, Nl} = read_to_nl(File), - {ident, Rem, Nl, lists:reverse("#ident " ++ detokenise_pragma(Removed))}; - - %%---------------------------------------- - %% #warning - %%---------------------------------------- - "warning" -> - {warning, read_to_nl(File)}; - - %%---------------------------------------- - %% #error - %%---------------------------------------- - "error" -> - {error, read_to_nl(File)}; - - %%---------------------------------------- - %% #line - %%---------------------------------------- - "line" -> - line(File, L, FN); - - %%---------------------------------------- - %% # - %%---------------------------------------- - "null" -> - hash_mark; - - %%---------------------------------------- - %% not recognised preprocessor commands - %%---------------------------------------- - _Else -> - {not_recognised, read_to_nl(File)} - end. - - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% if -%% -%% Only #if 0 is implemented at the time to be able to use if -%% to comment some code parts. -%%=============================================================== -%%=============================================================== -%%=============================================================== - -if_zero(File, _Err, _War, _L, _FN) -> - case if_zero(File) of - {ok, Remain, Num, Removed, Nl} -> - case catch list_to_integer(Num) of - {'EXIT', _} -> - {Removed2, Rem2, Nl2} = read_to_nl(File), - {error, Rem2, Removed2, Nl2}; - Int -> - {ok, Remain, Int, Removed, Nl} - end; - E -> - E - end. - -if_zero([{number,Num}]) -> - {ok, [], Num, [], 0}; -if_zero([{number,Num}, space]) -> - {ok, [], Num, [], 0}; -if_zero([{number,Num} | Rem]) -> - {Removed, Rem2, Nl} = read_to_nl(Rem), - {ok, Rem2, Num, Removed, Nl}; -%if_zero([{number,Num}, {nl,_X} | Rem]) -> -% {ok, Rem, Num, [], 1}; -if_zero(Rem) -> - {Removed, Rem2, Nl} = read_to_nl(Rem), - {error, Rem2, Removed, Nl}. - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% Define macro -%% -%% Check the syntax of the macro, extract the parameters if any. -%% If valid macro it is added to the Defs-list. -%% If a macro is redefined, a warning will be given, the latest -%% definition is always the valid one. -%%=============================================================== -%%=============================================================== -%%=============================================================== - -define(File, Err, War, L, FN) -> - case define_name(File) of - {ok, Rem, Name, No_of_para, Parameters, Macro, Nl} -> - {ok, Rem, Name, No_of_para, Parameters, Macro, Err, War, Nl}; - {{warning,no_space}, Rem, Name, No_of_para, Parameters, Macro, Nl} -> - Text = lists:flatten(io_lib:format("missing white space after `#define ~s'",[Name])), - {warning, Rem, Name, No_of_para, Parameters, Macro, Err, [{FN, L, Text}|War], Nl}; - {error, invalid_name, Nl} -> - Text = "invalid macro name", - {_Removed, Rem, Nl2} = read_to_nl(File), - {error, Rem, [{FN, L, Text}|Err], War, Nl+Nl2}; - {error, invalid_name, Name, Nl} -> - Text = lists:flatten(io_lib:format("invalid macro name `~s'",[Name])), - {_Removed, Rem, Nl2} = read_to_nl(File), - {error, Rem, [{FN, L, Text}|Err], War, Nl+Nl2}; - {error, illegal_arg} -> - {Removed, Rem, Nl} = read_to_nl(File), - RemovedS = detokenise(Removed), - Text = lists:flatten(io_lib:format("Invalid argument list ~s",[RemovedS])), - {error, Rem, [{FN, L, Text}|Err], War, Nl} - end. - - - -%%=========================================================== -%% Check if valid macro -%%=========================================================== -define_name([]) -> - {warning, no_macro}; -define_name([space]) -> - {warning, no_macro}; -%% Macro with parameters -define_name([{var,Name},{char,$(}|Rem]) -> - case read_para([{char,$(}|Rem]) of - {ok, Rem2, Para, NoOfPara} -> - {Removed, Rem3, _Nl} = read_to_nl(Rem2), - {ok, Rem3, Name, NoOfPara, Para, Removed, 1}; - Error -> - Error - end; -%% Macro without parameters -define_name([{var,Name}]) -> - {ok, [], Name, 0, [], [], 0}; -define_name([{var,Name}, space | Rem]) -> - {Removed, Rem2, Nl} = read_to_nl(Rem), - {ok, Rem2, Name, 0, [], Removed, Nl}; -define_name([{var,Name}, {nl,_X} | Rem]) -> - {ok, Rem, Name, 0, [], [], 1}; -define_name([{var,Name} | Rem]) -> - {Removed, Rem2, Nl} = read_to_nl(Rem), - {{warning,no_space}, Rem2, Name, 0, [], Removed, Nl}; -%% Invalid macro name -define_name([{number, Name} | _Rem]) -> - {error, invalid_name, Name, 0}; -define_name(_Rem) -> - {error, invalid_name, 0}. - - - - - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% Undefine macro -%% -%% If it is a valid undef command the macro name will be deleted -%% from the Defs-list -%%=============================================================== -%%=============================================================== -%%=============================================================== - -undef(File, Err, War, L, FN) -> - case undef(File) of - {ok, Rem, Name, Nl} -> - {ok, Rem, Name, Err, War, Nl}; - {warning, Rem, Name, Nl} -> - Text = "ignoring the tail of the line", - {ok, Rem, Name, Err, [{FN, L, Text}|War], Nl}; - {error, invalid_name} -> - Text = "invalid macro name", - {_Removed, Rem, Nl} = read_to_nl(File), - {error, Rem, [{FN, L, Text}|Err], War, Nl}; - {error, invalid_name, Name} -> - Text = lists:flatten(io_lib:format("invalid macro name `~s'",[Name])), - {_Removed, Rem, Nl} = read_to_nl(File), - {error, Rem, [{FN, L, Text}|Err], War, Nl} - end. - -%%------------------------------------------------- -%% Check if valid macro name -%%------------------------------------------------- -undef([]) -> - {error, invalid_name, []}; -%% Valid name -undef([{var,Name}]) -> - {ok, [], Name, 0}; -undef([{var,Name}, {nl,_X} | Rem]) -> - {ok, Rem, Name, 1}; -undef([{var,Name}, space, {nl,_X} | Rem]) -> - {ok, Rem, Name, 1}; -undef([{var,Name} | Rem]) -> - {_Removed, Rem2, Nl} = read_to_nl(Rem), - {warning, Rem2, Name, Nl}; -%% Invalid macro name -undef([{number, Name} | _Rem]) -> - {error, invalid_name, Name}; -undef(_Rem) -> - {error, invalid_name}. - - - - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% Include macro -%% -%% Read the included file -%%=============================================================== -%%=============================================================== -%%=============================================================== - -include(File, IncDir, Mio) -> - case include2(File) of - {ok, FileName, Rem, Nl, FileType} -> - Result = read_inc_file(FileName, IncDir, Mio), - case {Result, Nl, FileType} of - {{ok, FileNamePath, FileCont}, _, _} -> - {ok, FileNamePath, FileCont, Rem, Nl}; - {skip, _, _} -> - {skip, Rem}; - {{error, Text}, _, own_file} -> - NameNl = count_nl(FileName,0), - Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), - {error, Rem, Nl, Error, NameNl}; - {{error, Text}, 1, sys_file} -> - NameNl = count_nl(FileName,0), - Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), - {error, Rem, Nl, Error, NameNl}; - {{error, _Text}, _, sys_file} -> - {error, Rem, Nl, "`#include' expects \"FILENAME\" or <FILENAME>"} - end; - {error, {_Removed, Rem, Nl}} -> - {error, Rem, Nl, "`#include' expects \#FILENAME\" or <FILENAME>"} - end. - - - -count_nl([],Nl) -> - Nl; -count_nl([$\n|T],Nl) -> - count_nl(T,Nl+1); -count_nl([_H|T],Nl) -> - count_nl(T,Nl). - -%%================================================= -%% Extract the file name from the token list -%%================================================= -include2([space|Rem]) -> - include2(Rem); - -include2([{string, FileName}]) -> - {ok, FileName, [], 1, own_file}; -include2([{string, FileName}, space]) -> - {ok, FileName, [], 1, own_file}; -include2([{string, FileName}, {nl, _X} | Rem]) -> - {ok, FileName, Rem, 1, own_file}; -include2([{string, FileName}, space, {nl, _X} | Rem]) -> - {ok, FileName, Rem, 1, own_file}; -include2([{string, _FileName}, _No_nl | Rem]) -> - {error, read_to_nl(Rem)}; -include2([{string_part, File_part}, {nl, _X} | Rem]) -> - case include_read_string_file_name(File_part++[$\n], Rem, 1) of - {ok, FileName, Rem2, Nl} -> - {ok, FileName, Rem2, Nl, own_file}; - error -> - {error, read_to_nl([{string_part,File_part} | Rem])} - end; -include2([{sys_head, FileName}]) -> - {ok, FileName, [], 1, sys_file}; -include2([{sys_head, FileName}, space]) -> - {ok, FileName, [], 1, sys_file}; -include2([{sys_head, FileName}, {nl, _X} | Rem]) -> - {ok, FileName, Rem, 1, sys_file}; -include2([{sys_head, FileName}, space, {nl, _X} | Rem]) -> - {ok, FileName, Rem, 1, sys_file}; -include2([{sys_head, _FileName}, _No_nl | Rem]) -> - {error, read_to_nl(Rem)}; -include2([{sys_head_part ,File_part}, {nl, _X} | Rem]) -> - case include_read_sys_file_name(File_part++[$\n], Rem, 1) of - {ok, FileName, Rem2, Nl} -> - {ok, FileName, Rem2, Nl, sys_file}; - error -> - {error, read_to_nl([{sys_head_part, File_part} | Rem])} - end; -include2(Rem) -> - {error, read_to_nl(Rem)}. - - - -%%------------------------------------------------- -%% File name framed by " " -%%------------------------------------------------- -include_read_string_file_name(File, [{string, File_part}, {nl,_X} | Rem], Nl) -> - {ok, File++File_part, Rem, Nl+1}; -include_read_string_file_name(File, [{string_part, File_part}, {nl,_X} | Rem], Nl) -> - include_read_string_file_name(File++File_part++[$\n], Rem, Nl+1); -include_read_string_file_name(_File, _X, _Nl) -> - error. - -%%------------------------------------------------- -%% File name framed by < > -%%------------------------------------------------- -include_read_sys_file_name(File, [{sys_head, File_part}, {nl,_X} | Rem], Nl) -> - {ok, File++File_part, Rem, Nl+1}; -include_read_sys_file_name(File, [{sys_head_part, File_part}, {nl,_X} | Rem], Nl) -> - include_read_sys_file_name(File++File_part++[$\n], Rem, Nl+1); -include_read_sys_file_name(_File, _X, _Nl) -> - error. - - - - - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% Line macro -%% -%% The line macro may redefine both the current line number and -%% the current file name: #line ' new_line_nr' 'new_file_name' -%%=============================================================== -%%=============================================================== -%%=============================================================== - -line(File, L, FN) -> - line(File, L, FN, not_defined, not_defined). - - - -line([], L, FN, _Line, _File) -> - {{line, error}, {[],[],0}, {FN,L,"invalid format `#line' directive"}}; - -line([space|Rem], L, FN, Line, File) -> - line(Rem, L, FN, Line, File); - -%%------------------------------ -%% Line number expected -%%------------------------------ -line([{number,Number}|Rem], L, FN, not_defined, File) -> - case catch list_to_integer(Number) of - {'EXIT', _} -> - {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}; - Int -> - line(Rem, L, FN, Int, File) - end; -line(Rem, L, FN, not_defined, _File) -> - {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}; - -%%------------------------------ -%% File name or newline expected -%%------------------------------ -line([{nl, _NL}|Rem], _L, FN, Line, not_defined) -> - {{line, ok}, {[],Rem,1}, Line, FN, io_lib:format("~n~p ~p #",[FN, Line-1])}; -line([{string,NewFN}|Rem], _L, _FN, Line, not_defined) -> - {{line, ok}, read_to_nl(Rem), Line, NewFN, io_lib:format("~n~p ~p #",[NewFN, Line-1])}; -line(Rem, L, FN, _Line, _File) -> - {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}. - - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Source line -%% -%% -%% Output: {Str, Err, War, Rem, SelfRef} -%% -%% Description: The input source line is searched for macros. If a macro is found it -%% is expanded. The result of an expansion is rescanned for more macros. -%% To prevent infinite loops if the macro is self referring -%% an extra token is put into the Rem list. The variable SelfRef -%% contains all the macros which are inhibited to be expanded. -%% A special specae token is also inserted to prevent not wanted -%% concatinations if one of the variables to be concatinated is expanded. -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - -source_line(Str, Rem, SelfRef, Defs, Err, War, L, FN) -> - {Rem2, Para, No_of_para} = case read_para(Rem) of - {ok, RemT, ParaT, No_of_paraT} -> - {RemT, ParaT, No_of_paraT}; - {error, illegal_arg} -> - {[], [], 0} - end, - - - %%------------------------------------------------- - %% Check if a valid macro - %%------------------------------------------------- - case lists:keysearch(Str, 1, Defs) of - %% a macro without parameters - {value, {Str, 0, _MacroPara, Macro}} -> - case lists:member(Str, SelfRef) of - true -> - {[Str], Err, War, Rem, SelfRef}; - false -> - ExpandedRes2 = sl_mark_expanded(Macro, Str), - {[], Err, War, ExpandedRes2 ++ [{self_ref,Str}|Rem], [Str|SelfRef]} - end; - - %% a macro with parameters - {value, {Str, N, _MacroPara, Macro}} when N == No_of_para -> - case lists:member(Str, SelfRef) of - true -> - {[Str], Err, War, Rem, SelfRef}; - false -> - ExpandedRes = sl_macro_expand(Macro, Para, Defs), - ExpandedRes2 = sl_mark_expanded(ExpandedRes, Str), - {[], Err, War, ExpandedRes2 ++ [{self_ref,Str}|Rem2], [Str|SelfRef]} - end; - - %% a variable, because it doesn't have any parameters - {value, {Str, _N, _MacroPara, _Macro}} when No_of_para == 0 -> - {Str, Err, War, Rem, SelfRef}; - - %% illegal no of parameters - {value, {Str, N, _MacroPara, _Macro}} when No_of_para < N -> - Text = io_lib:format(" macro `~s' used with just ~p arg",[Str,No_of_para]), - Err2 = {FN, L, lists:flatten(Text)}, - {Str, [Err2|Err], War, Rem, SelfRef}; - {value, {Str, _N, _MacroPara, _Macro}} -> - Text = io_lib:format(" macro `~s' used with too many (~p) args",[Str,No_of_para]), - Err2 = {FN, L, lists:flatten(Text)}, - {Str, [Err2|Err], War, Rem, SelfRef}; - - %% no macro - false -> - {Str, Err, War, Rem, SelfRef} - end. - - - - - -%%================================================= -%% Expand a macro -%%================================================= -sl_macro_expand(Macro, Para, Defs) -> - sl_macro_expand(Macro, Para, Defs, []). - - -%%................... -%% End -%%................... -sl_macro_expand([], _Para, _Defs, Res) -> - lists:reverse(Res); - -%%................... -%% Concatination -%%................... -%% para ## para -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> - Exp = sl_para_para({para, N},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% para## para -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> - Exp = sl_para_para({para, N},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% para ##para -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> - Exp = sl_para_para({para, N},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% para##para -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> - Exp = sl_para_para({para, N},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); - -%% para ## var -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, {var, Var}|T], Para, Defs, Res) -> - Exp = sl_para_var({para, N}, {var, Var}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% para## var -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, {var, Var} | T], Para, Defs, Res) -> - [{var, VarN}] = lists:nth(N,Para), - sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); -%% para ##var -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, {var, Var} | T], Para, Defs, Res) -> - [{var, VarN}] = lists:nth(N,Para), - sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); -%% para##var -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, {var, Var} | T], Para, Defs, Res) -> - [{var, VarN}] = lists:nth(N,Para), - sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); - -%% var ## para -sl_macro_expand([{var, Var}, space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> - Exp = sl_var_para({var, Var},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% var## para -sl_macro_expand([{var, Var}, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> - Exp = sl_var_para({var, Var},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% var ##para -sl_macro_expand([{var, Var}, space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> - Exp = sl_var_para({var, Var},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% var##para -sl_macro_expand([{var, Var}, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> - Exp = sl_var_para({var, Var},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); - -%% expanded ## para -sl_macro_expand([space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> - [{var, VarM}] = lists:nth(M,Para), - sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); -%% expanded## para -sl_macro_expand([{char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> - [{var, VarM}] = lists:nth(M,Para), - sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); -%% expanded ##para -sl_macro_expand([space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> - [{var, VarM}] = lists:nth(M,Para), - sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); -%% expanded##para -sl_macro_expand([{char,$#}, {char,$#}, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> - [{var, VarM}] = lists:nth(M,Para), - sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); - -%% para ## ? -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, X | T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); -%% para## ? -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, X | T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); -%% para ##? -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, X | T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); -%% para##? -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, X | T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); - -sl_macro_expand([{char,$#}, {char,$#}, space |T], Para, Defs, [space|Res]) -> - sl_macro_expand(T, Para, Defs, Res); -sl_macro_expand([{char,$#}, {char,$#} |T], Para, Defs, [space|Res]) -> - sl_macro_expand(T, Para, Defs, Res); -sl_macro_expand([{char,$#}, {char,$#}, space |T], Para, Defs, Res) -> - sl_macro_expand(T, Para, Defs, Res); -sl_macro_expand([{char,$#}, {char,$#} |T], Para, Defs, Res) -> - sl_macro_expand(T, Para, Defs, Res); - -%%................... -%% Stringification -%%................... -sl_macro_expand([{char,$#}, {para, N}|T], Para, Defs, Res) -> - Nth = lists:nth(N,Para), - Tokens = detokenise(Nth), - sl_macro_expand(T, Para, Defs, [{string,Tokens}|Res]); -sl_macro_expand([{char,$#}, space, {para, N}|T], Para, Defs, Res) -> - Nth = lists:nth(N,Para), - Tokens = detokenise(Nth), - sl_macro_expand(T, Para, Defs, [{string,Tokens}|Res]); - -%%................... -%% A parameter -%%................... -sl_macro_expand([{para, N}|T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand(T, Para, Defs, lists:flatten([Reexp|Res])); - -%%................... -%% No parameter -%%................... -sl_macro_expand([H|T], Para, Defs, Res) -> - sl_macro_expand(T, Para, Defs, [H|Res]). - - - -%%------------------------------------------------- -%% Expand parameters -%%------------------------------------------------- -sl_para_para({para, N}, {para, M}, Para) -> - case sl_para_1st(lists:nth(N,Para)) of - {ok, Para1st} -> - Para1st ++ sl_para_2nd(lists:nth(M,Para)); - {exp, Para1st} -> - Para1st ++ sl_para_2nd(lists:nth(M,Para)) ++ [space_exp]; - {space, Para1st} -> - Para1st ++ [space_exp | sl_para_2nd(lists:nth(M,Para))] - end. - - -sl_var_para(Var, {para, M}, Para) -> - [Var|sl_para_2nd(lists:nth(M,Para))]. - - -sl_para_var({para, N}, Var, Para) -> - case sl_para_1st(lists:nth(N,Para)) of - {ok, Para1st} -> - Para1st ++ [Var]; - {exp, Para1st} -> - Para1st ++ [Var | space_exp]; - {space, Para1st} -> - Para1st ++ [space_exp | Var] - end. - - -sl_para_1st([{var, Var}]) -> - {ok,[{expanded,Var}]}; -sl_para_1st([{var, Var}, space]) -> - {ok,[{expanded,Var}]}; -sl_para_1st([{var, Var}, space_exp]) -> - {exp, [{expanded,Var}]}; -sl_para_1st(L) -> - {space, L}. - -sl_para_2nd([{var, Var}]) -> - [{expanded,Var}]; -sl_para_2nd([{var, Var}, space_exp]) -> - [{expanded,Var}]; -sl_para_2nd([space, {var, Var}]) -> - [{expanded,Var}]; -sl_para_2nd([space_exp, {var, Var}]) -> - [{expanded,Var}]; -sl_para_2nd(L) -> - L++[space]. - - - -%%------------------------------------------------- -%% Check if the expansion is a valid macro, -%% do not reexpand if concatination -%%------------------------------------------------- -sl_macro_reexpand([], _Defs, Result) -> - Result; -sl_macro_reexpand([{var,Var}|Rem], Defs, Result) -> - case lists:keysearch(Var, 1, Defs) of - {value, {Var, 0, _MacroPara, Macro}} -> - Rem2 = case Rem of - [space | RemT] -> - [space_exp | RemT]; - _ -> - [space_exp | Rem] - end, - sl_macro_reexpand(Macro++Rem2, Defs, Result); - _ -> - sl_macro_reexpand(Rem, Defs, [{var,Var}|Result]) - end; -sl_macro_reexpand([H|Rem], Defs, Result) -> - sl_macro_reexpand(Rem, Defs, [H|Result]). - - - -%%------------------------------------------------- -%% Self referring macros are marked not be reexpanded -%%------------------------------------------------- -sl_mark_expanded(QQ, Str) -> - sl_mark_expanded(QQ, Str, []). - -sl_mark_expanded([], _Str, Res) -> - lists:reverse(Res); -sl_mark_expanded([H|T], Str, Res) -> - case H of - {_,Str} -> - sl_mark_expanded(T, Str, [{expanded, Str}|Res]); - _ -> - sl_mark_expanded(T, Str, [H|Res]) - end. - - - - - - - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Misceleaneous functions -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - - -%%=============================================================== -%% Check the Flags for include directories -%%=============================================================== -include_dir(Flags) when is_list(Flags)-> - include_dir(Flags,[]); -include_dir(_Flags) -> - []. - -include_dir(Flags,IncDirs) -> - case string:str(Flags,"-I") of - 0 -> - lists:reverse(IncDirs); - X -> - {NewDir, RemainingFlags} = - gobble_inc_dir(string:sub_string(Flags, X+2),nq,[]), - include_dir(RemainingFlags, [NewDir|IncDirs]) - end. - -% nq = not-quoted, q = quoted. -% Possible strange scenarios: -% /usr/test\ ing/ -% "/usr/test ing/" -% /usr/test\"ing/ -% "/usr/test\"ing/" -gobble_inc_dir([],nq,Acc) -> - % Only accept nq here, if we end up here in q mode the user has missed a " - {lists:reverse(Acc),[]}; -gobble_inc_dir([$\\,$"|R],Q,Acc) -> - gobble_inc_dir(R,Q,[$"|Acc]); -gobble_inc_dir([$"|R],nq,Acc) -> - gobble_inc_dir(R,q,Acc); -gobble_inc_dir([$"|R],q,Acc) -> - gobble_inc_dir(R,nq,Acc); -gobble_inc_dir([$\\,$ |R],nq,Acc) -> - gobble_inc_dir(R,nq,[$ |Acc]); -gobble_inc_dir([$ |R],nq,Acc) -> - {lists:reverse(Acc),R}; -gobble_inc_dir([C|R],Q,Acc) -> - gobble_inc_dir(R,Q,[C|Acc]). - - -%%=============================================================== -%% Read a included file. Try current dir first then the IncDir list -%%=============================================================== - -read_inc_file(FileName, IncDir, Mio) -> - case find_inc_file(FileName, IncDir) of - {ok, AbsFile} -> - %% is included before? - case lists:member(FileName, Mio#mio.included) of - false -> - case catch file:read_file(AbsFile) of - {ok, Bin} -> - FileList = binary_to_list(Bin), - {ok, AbsFile, FileList}; - {error, Text} -> - {error, Text} - end; - true -> - skip - end; - {error, Text} -> - {error, Text} - end. - -find_inc_file(FileName, IncDir) -> - case catch file:read_file_info(FileName) of - {ok, _} -> - {ok, FileName}; - {error, _} -> - find_inc_file2(FileName, IncDir) - end. - -find_inc_file2(_FileName, []) -> - {error, "No such file or directory"}; -find_inc_file2(FileName, [D|Rem]) -> - Dir = case lists:last(D) of - $/ -> - D; - _ -> - D++"/" - end, - case catch file:read_file_info(Dir++FileName) of - {ok, _} -> - {ok, Dir++FileName}; - {error, _} -> - find_inc_file2(FileName, Rem) - end. - - -%%=============================================================== -%% Read parameters of a macro or a variable in a source line -%%=============================================================== -read_para([{char,$(} | Rem]) -> - read_para(Rem, 1, [], [], 1); -read_para([space,{char,$(} | Rem]) -> - read_para(Rem, 1, [], [], 1); -read_para(_Rem) -> - {ok, [], [], 0}. - - -%% Abrupt end of the list -read_para([], _NoOfParen, _Current, _Para, _NoOfPara) -> - {error, illegal_arg}; -%% All parameters checked -read_para([{char,$)}|Rem], 1, [], Para, NoOfPara) -> - {ok, Rem, lists:reverse(Para), NoOfPara}; -read_para([{char,$)}|Rem], 1, Current, Para, NoOfPara) -> - {ok, Rem, lists:reverse([Current|Para]), NoOfPara}; - -%% Continue reading -read_para([{char,$)}|Rem], NoOfParen, Current, Para, NoOfPara) -> - read_para(Rem, NoOfParen-1, Current++[{char,$)}], Para, NoOfPara); -read_para([{char,$(}|Rem], NoOfParen, Current, Para, NoOfPara) -> - read_para(Rem, NoOfParen+1, Current++[{char,$(}], Para, NoOfPara); -read_para([{char,$,}|Rem], NoOfParen, Current, Para, NoOfPara) when NoOfParen == 1 -> - read_para(Rem, NoOfParen, [], [Current|Para], NoOfPara+1); -read_para([space|Rem], NoOfParen, [], Para, NoOfPara) -> - read_para(Rem, NoOfParen, [], Para, NoOfPara); -read_para([X|Rem], NoOfParen, Current, Para, NoOfPara) -> - read_para(Rem, NoOfParen, Current++[X], Para, NoOfPara). - - - - - - -%%=================================================================================== -%% check if a macro is already defined -%%=================================================================================== -is_define_ok(Name, No_of_para, Parameters, Macro, Defs) -> - - case lists:keysearch(Name, 1, Defs) of - {value, {Name, No_of_para, _MacroPara, Macro}} -> - {yes, Defs}; - {value, _} -> - Defs2 = lists:keydelete(Name, 1, Defs), - NewMacro = is_define_ok_check_para(Parameters, Macro, []), - case is_stringify_ok(NewMacro) of - yes -> - {no, [{Name, No_of_para, Parameters, NewMacro}|Defs2]}; - no -> - ErrorText = "`#' operator is not followed by a macro argument name", - {error, ErrorText, [{Name, No_of_para, Parameters, NewMacro}|Defs2]} - end; - false -> - NewMacro = is_define_ok_check_para(Parameters, Macro, []), - case is_stringify_ok(NewMacro) of - yes -> - {yes, [{Name, No_of_para, Parameters, NewMacro}|Defs]}; - no -> - ErrorText = "`#' operator is not followed by a macro argument name", - {error, ErrorText, [{Name, No_of_para, Parameters, NewMacro}|Defs]} - end - end. - -is_define_ok_check_para(_Para, [], Result) -> - lists:reverse(Result); - -is_define_ok_check_para(Para, [H|T], Result) -> - case define_arg_para_number(1, Para, H) of - no_para -> - is_define_ok_check_para(Para, T, [H|Result]); - N -> - is_define_ok_check_para(Para, T, [{para,N}|Result]) - end. - -define_arg_para_number(_N, [], _Current) -> - no_para; -define_arg_para_number(N, [H|_Para], Current) when H == [Current] -> - N; -define_arg_para_number(N, [_H|Para], Current) -> - define_arg_para_number(N+1, Para, Current). - - -is_stringify_ok([]) -> - yes; -is_stringify_ok([{char,$#},{char,$#}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},space,{para,_X}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},{para,_X}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},space,{var,_X}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},{var,_X}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},space,{nl,_X}|_T]) -> - no; -is_stringify_ok([{char,$#},{nl,_X}|_T]) -> - no; -is_stringify_ok([{char,$#}|_T]) -> - no; -is_stringify_ok([_H|T]) -> - is_stringify_ok(T). - -%%=================================================================================== -%% check if a macro is already defined -%%=================================================================================== -is_defined_before(Name, No_of_para, Defs) -> - case lists:keysearch(Name, 1, Defs) of - {value, {Name, No_of_para, _MacroPara, _Macro}} -> - yes; - {value, _} -> - no; - false -> - no - end. - - - - -%%=================================================================================== -%% read_to_nl(File) -%%=================================================================================== -read_to_nl([space|Rem]) -> - read_to_nl(Rem, [], 1); -read_to_nl(Rem) -> - read_to_nl(Rem, [], 1). - -read_to_nl([], Result, Nl) -> - {lists:reverse(Result), [], Nl}; -read_to_nl([{nl, _N}|Rem], [{string_part,String} | Result], Nl) -> - read_to_nl(Rem, [nl, {string_part,String}|Result], Nl+1); -read_to_nl([{nl, _N}|Rem], [{sys_head_part,String} | Result], Nl) -> - read_to_nl(Rem, [nl, {sys_head_part,String}|Result], Nl+1); -read_to_nl([{nl, _N}|Rem], Result, Nl) -> - {lists:reverse(Result), Rem, Nl}; -read_to_nl([space|Rem], Result, Nl) -> - read_to_nl(Rem, [space|Result], Nl); -read_to_nl([{X,String}|Rem], Result, Nl) -> - read_to_nl(Rem, [{X,String}|Result], Nl). - - - - -%%=========================================================== -%% Read characters until next newline -%%=========================================================== -%read_to_nl2(Str) -> read_to_nl2([],Str). - -%read_to_nl2(Line, []) -> {Line,[]}; -%read_to_nl2(Line, [$\n|Str]) -> {Line, Str}; -%read_to_nl2(Line, [X|Str]) -> read_to_nl2([X|Line], Str). - - - - -%%=========================================================== -%% Remove leading spaces from a list -%%=========================================================== -remove_leading_spaces([?space|List]) -> - remove_leading_spaces(List); -remove_leading_spaces([?tab|List]) -> - remove_leading_spaces(List); -remove_leading_spaces(List) -> - List. - - - - -%%=========================================================== -%% Skip characters until next newline -%%=========================================================== -skip_to_nl([]) -> []; -skip_to_nl([$\n | Str]) -> Str; -skip_to_nl([$\\,$\n | Str]) -> [$/,$/|Str]; -skip_to_nl([_|Str]) -> skip_to_nl(Str). - - - - -month(1) -> "Jan"; -month(2) -> "Feb"; -month(3) -> "Mar"; -month(4) -> "Apr"; -month(5) -> "May"; -month(6) -> "Jun"; -month(7) -> "Jul"; -month(8) -> "Aug"; -month(9) -> "Sep"; -month(10) -> "Oct"; -month(11) -> "Nov"; -month(12) -> "Dec". - - -%% Multiple Include Optimization -%% -%% Algorithm described at: -%% http://gcc.gnu.org/onlinedocs/cppinternals/Guard-Macros.html -update_mio({include, FileName}, #mio{included=Inc}=Mio) -> - Mio#mio{valid=false, included=[FileName|Inc]}; - -%% valid=false & cmacro=undefined indicates it is already decided this file is -%% not subject to MIO -update_mio(_, #mio{valid=false, depth=0, cmacro=undefined}=Mio) -> - Mio; - -%% if valid=true, there is no non-whitespace tokens before this ifndef -update_mio({'ifndef', Macro}, #mio{valid=true, depth=0, cmacro=undefined}=Mio) -> - Mio#mio{valid=false, cmacro=Macro, depth=1}; - -%% detect any tokens before top level #ifndef -update_mio(_, #mio{valid=true, depth=0, cmacro=undefined}=Mio) -> - Mio#mio{valid=false}; - -%% If cmacro is alreay set, this is after the top level #endif -update_mio({'ifndef', _}, #mio{valid=true, depth=0}=Mio) -> - Mio#mio{valid=false, cmacro=undefined}; - -%% non-top level conditional, just update depth -update_mio({'ifndef', _}, #mio{depth=D}=Mio) when D > 0 -> - Mio#mio{depth=D+1}; -update_mio('ifdef', #mio{depth=D}=Mio) -> - Mio#mio{depth=D+1}; -update_mio('if', #mio{depth=D}=Mio) -> - Mio#mio{depth=D+1}; - -%% top level #else #elif invalidates multiple include optimization -update_mio('else', #mio{depth=1}=Mio) -> - Mio#mio{valid=false, cmacro=undefined}; -update_mio('else', Mio) -> - Mio; -update_mio('elif', #mio{depth=1}=Mio) -> - Mio#mio{valid=false, cmacro=undefined}; -update_mio('elif', Mio) -> - Mio; - -%% AT exit to top level, if the controlling macro is not set, this could be the -%% end of a non-ifndef conditional block, or there were tokens before entering -%% the #ifndef block. In either way, this invalidates the MIO -%% -%% It doesn't matter if `valid` is true at the time of exiting, it is set to -%% true. This will be used to detect if more tokens are following the top -%% level #endif. -update_mio('endif', #mio{depth=1, cmacro=undefined}=Mio) -> - Mio#mio{valid=false, depth=0}; -update_mio('endif', #mio{depth=1}=Mio) -> - Mio#mio{valid=true, depth=0}; -update_mio('endif', #mio{depth=D}=Mio) when D > 1 -> - Mio#mio{valid=true, depth=D-1}; - -%%if more tokens are following the top level #endif. -update_mio('endif', #mio{depth=1, cmacro=undefined}=Mio) -> - Mio#mio{valid=false, depth=0}; -update_mio('endif', #mio{depth=D}=Mio) when D > 0 -> - Mio#mio{valid=true, depth=D-1}; -update_mio(_, Mio) -> - Mio#mio{valid=false}. - -%% clear `valid`, this doesn't matter since #endif will restore it if -%% appropriate -update_mio(Mio) -> - Mio#mio{valid=false}. - - diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl deleted file mode 100644 index 13c02cfcba..0000000000 --- a/lib/ic/src/ic_pragma.erl +++ /dev/null @@ -1,1957 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% --module(ic_pragma). - - --export([pragma_reg/2,pragma_cover/3]). --export([pragma_prefix/3,pragma_version/3,pragma_id/3]). --export([mk_alias/3,get_alias/2,scope2id/2,id2scope/2,mk_scope/1]). --export([mk_ref/3,get_incl_refs/1,get_local_refs/1]). --export([get_dependencies/1, add_inh_data/3, preproc/3]). --export([getBrokerData/3,defaultBrokerData/1,list_to_term/1]). --export([get_local_c_headers/2,get_included_c_headers/1,is_inherited_by/3]). --export([no_doubles/1,fetchRandomLocalType/1,fetchLocalOperationNames/2]). --export([is_local/2]). - -%% Debug --export([print_tab/1,slashify/1,is_short/1]). - --import(lists,[suffix/2,delete/2,reverse/1,keysearch/3,member/2,last/1,flatten/1]). --import(string,[tokens/2]). --import(ets,[insert/2,lookup/2]). - --import(ic_forms, [get_id2/1, get_body/1, get_line/1]). --import(ic_util, [to_atom/1]). --import(ic_genobj, [idlfile/1]). --import(ic_options, [get_opt/2]). - --include("icforms.hrl"). --include("ic.hrl"). - - - - -%% Initialization of the pragma table and -%% start of pragma registration. -%% NOTE : this pragma registration is build -%% as a separate stage under compilation. -%% If it is to be optimised, it should be -%% embodied in one of other compiling stages. -pragma_reg(G,X) -> - S = ic_genobj:pragmatab(G), - init_idlfile(G,S), - init_pragma_status(S), - registerOptions(G,S), - pragma_reg_all(G, S, [], X), - denote_specific_code_opts(G), - case get_pragma_compilation_status(S) of - true -> - %% Remove ugly pragmas from form - PragmaCleanForm = cleanup(X), - {ok,PragmaCleanForm}; - false -> - ErrorNr = get_pragma_error_nr(S), - %% Just print the number of errors found - case ErrorNr > 1 of - true -> - io:format("There were ~p errors found on file ~p~n", - [ErrorNr,get_idlfile(S)]), - error; - false -> - io:format("There were ~p error found on file ~p~n", - [ErrorNr,get_idlfile(S)]), - error - end - end. - - - -registerOptions(G,S) -> - OptList = ets:tab2list(ic_genobj:optiontab(G)), - registerOptions(G,S,OptList). - - -registerOptions(_G,_S,[]) -> - true; -registerOptions(G,S,[{{option,{broker,Scope}},{Mod,Type}}|Rest]) -> - insert(S, - {codeopt, - reverse(tokens(Scope,":")), - {broker,{Mod,Type}}, - -1, - nil, - nil}), - registerOptions(G,S,Rest); -registerOptions(G,S,[_|Rest]) -> - registerOptions(G,S,Rest). - - -%% Decide if to apply pragmas -%% by checking backend switch -applyPragmasInBe(G) -> - case get_opt(G, be) of - erl_plain -> - false; - _ -> - true - end. - - -%% Decide if the code option directive -%% is allowed to change backend -applyCodeOpt(G) -> - case get_opt(G, be) of - erl_corba -> %% Does not support codeopt - false; - erl_plain -> %% Does not support codeopt - false; - c_native -> %% Does not support codeopt - false; - _ -> - true - end. - - - -%% This removes all pragma records from the form. -%% When debugged, it can be enbodied in pragma_reg_all. -cleanup(undefined,C) -> C; -cleanup([],C) -> C; -cleanup([X|Xs],CSF) -> - cleanup(Xs, CSF++cleanup(X)). - -cleanup(X) when is_list(X) -> cleanup(X,[]); -cleanup(X) when is_record(X, preproc) -> [X]; -cleanup(X) when is_record(X, pragma) -> []; -cleanup(X) when is_record(X, op) -> % Clean inside operation parameters - [ X#op{params = cleanup(X#op.params,[])}]; - -cleanup(X) when is_record(X, module) -> % Clean inside module body - [ X#module{body = cleanup(X#module.body,[])}]; - -cleanup(X) when is_record(X, interface) -> % Clean inside interface body - [ X#interface{body = cleanup(X#interface.body,[])}]; - -cleanup(X) when is_record(X, except) -> % Clean inside exception body - [ X#except{body = cleanup(X#except.body,[])}]; - -cleanup(X) when is_record(X, struct) -> % Clean inside struct body - [ X#struct{body = cleanup(X#struct.body,[])}]; - -cleanup(X) when is_record(X, case_dcl) -> % Clean inside union body - [ X#case_dcl{label = cleanup(X#case_dcl.label,[])}]; - -cleanup(X) when is_record(X, union) -> % Clean inside union body - [ X#union{body = cleanup(X#union.body,[])}]; - -cleanup(X) when is_record(X, enum) -> % Clean inside enum body - [ X#enum{body = cleanup(X#enum.body,[])}]; - -cleanup(X) -> [X]. - - - - -%% pragma_reg_all is top level registration for pragmas -pragma_reg_all(_G, _S, _N, []) -> ok; -pragma_reg_all(G, S, N, [X|Xs]) -> - pragma_reg(G, S, N, X), - pragma_reg_all(G, S, N, Xs). - - -%% pragma_reg is top level registration for pragmas -pragma_reg(G, S, N, X) when is_list(X) -> pragma_reg_list(G, S, N, X); -pragma_reg(_G, S, _N, X) when element(1, X) == preproc -> - case X#preproc.aux of - [{_, _, "1"}] -> - IncludeEntryLNr = get_line(X#preproc.id), - IncludeFileName = element(3,element(3,X)), - insert(S,{includes,get_idlfile(S),IncludeFileName,IncludeEntryLNr}); - _Other -> - ok - end, - set_idlfile(S,element(3,element(3,X))); -pragma_reg(G, S, N, X) when element(1, X) == pragma -> - case applyPragmasInBe(G) of - - %% Pragmas are allowed to be - %% applied in this this backend. - true -> - - File = get_idlfile(S), % The current file or an included one. - Type = case idlfile(G) of % Local/Included flag - File -> - local; - _ -> - included - end, - - %% Register pragmas into pragmatab. - case X of - {pragma,{_,LineNr,"prefix"}, _To, _Apply} -> - insert(S,{prefix,X,LineNr,N,File,Type}); - - {pragma,{_,_,"ID"},_,_} -> - pragma_reg_ID(G, S, N, X); - - {pragma,{_,_,"version"},_,_} -> - pragma_reg_version(G, S, N, X ); - - {pragma,{_,_,"CODEOPT"},_,_} -> - pragma_reg_codeOpt(G,S,N,X); - - {pragma,{_,LineNr,BadPragma}, _To, _Apply} -> - io:format("Warning : on file ~p :~n",[get_idlfile(S)]), - io:format(" Unknown pragma directive ~p on line ~p, ignored.~n", - [BadPragma,LineNr]) - end; - - %% Pragmas are not to be applied in - %% this backend, ignore all pragmas. - false -> - true - end, - ok; - -pragma_reg(G, S, N, X) when is_record(X, module) -> - mk_ref(G,[get_id2(X) | N],mod_ref), - mk_file_data(G,X,N,module), - pragma_reg_all(G, S, [get_id2(X) | N], get_body(X)); - -pragma_reg(G, S, N, X) when is_record(X, interface) -> - mk_ref(G,[get_id2(X) | N],ifc_ref), - mk_file_data(G,X,N,interface), - pragma_reg_all(G, S, [get_id2(X) | N], get_body(X)); - -pragma_reg(G, S, N, X) when is_record(X, op) -> - %% Add operation in table - insert(S,{op, - get_id2(X), - N, - get_idlfile(S), - get_filepath(S)}), - mk_file_data(G,X,N,op), - pragma_reg_all(G, S, N, X#op.params); - -pragma_reg(G, S, N, X) when is_record(X, except) -> - mk_ref(G,[get_id2(X) | N],except_ref), - mk_file_data(G,X,N,except), - pragma_reg_all(G, S, N, X#except.body); - -pragma_reg(G, _S, N, X) when is_record(X, const) -> - mk_ref(G,[get_id2(X) | N],const_ref), - mk_file_data(G,X,N,const); - -pragma_reg(G, _S, N, X) when is_record(X, typedef) -> - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> - mk_ref(G,[get_id2(Id) | N],typedef_ref), - mk_file_data(G,XX#id_of{id=Id},N,typedef) - end, - ic_forms:get_idlist(X)); - -pragma_reg(G, S, N, X) when is_record(X, enum) -> - mk_ref(G,[get_id2(X) | N],enum_ref), - mk_file_data(G,X,N,enum), - pragma_reg_all(G, S, N, X#enum.body); - -pragma_reg(G, S, N, X) when is_record(X, union) -> - mk_ref(G,[get_id2(X) | N],union_ref), - mk_file_data(G,X,N,union), - pragma_reg_all(G, S, N, X#union.body); - -pragma_reg(G, S, N, X) when is_record(X, struct) -> - mk_ref(G,[get_id2(X) | N],struct_ref), - mk_file_data(G,X,N,struct), - case X#struct.body of - undefined -> - ok; - _ -> - pragma_reg_all(G, S, N, X#struct.body) - end; - -pragma_reg(G, _S, N, X) when is_record(X, attr) -> - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> - mk_ref(G,[get_id2(Id) | N],attr_ref), - mk_file_data(G,XX#id_of{id=Id},N,attr) - end, - ic_forms:get_idlist(X)); - -pragma_reg(_G, _S, _N, _X) -> ok. - - - - -pragma_reg_list(_G, _S, _N, []) -> ok; -pragma_reg_list(G, S, N, List ) -> - CurrentFileName = get_idlfile(S), - pragma_reg_list(G, S, N, CurrentFileName, List). - -pragma_reg_list(_G, _S, _N, _CFN, []) -> ok; -pragma_reg_list(G, S, N, CFN, [X | Xs]) -> - case X of - {preproc,_,{_,_,FileName},_} -> - set_idlfile(S,FileName), - pragma_reg(G, S, N, X), - pragma_reg_list(G, S, N, FileName, Xs); - _ -> - pragma_reg(G, S, N, X), - pragma_reg_list(G, S, N, CFN, Xs) - end. - - - - - -pragma_reg_ID(G, S, N, X) -> - {pragma,{_,LineNr,"ID"}, _To, Apply} = X, - - - File = get_idlfile(S), % The current file or an included one. - Type = case idlfile(G) of % Local/Included flag - File -> - local; - _ -> - included - end, - - %% Check if ID is one of the allowed types : - %% * OMG IDL - %% * DCE UUID - %% * LOCAL - case tokens(element(3,Apply),":") of - ["IDL",_,_] -> - insert(S,{id,X,LineNr,N,File,Type}); - ["DCE",_,VSN] -> - case is_short(VSN) of - true -> - insert(S,{id,X,LineNr,N,File,Type}); - false -> - set_compilation_failure(S), - io:format("Error on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad pragma ID ~p on line ~p,~n", - [element(3,Apply),LineNr]), - io:format(" the version part of ID is not a short integer.~n") - end; - ["LOCAL"|_] -> - insert(S,{id,X,LineNr,N,File,Type}); - _ -> - set_compilation_failure(S), - io:format("Error on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad pragma ID ~p on line ~p.~n", - [element(3,Apply),LineNr]) - end. - - - -pragma_reg_version(G, S, N, X) -> - {pragma,{_,LineNr,"version"}, _To, Apply} = X, - - File = get_idlfile(S), % The current file or an included one. - Type = case idlfile(G) of % Local/Included flag - File -> - local; - _ -> - included - end, - - case tokens(Apply,".") of - [Major,Minor] -> - case is_short(Major) and is_short(Minor) of - true -> - insert(S,{version,X,LineNr,N,File,Type}); - false -> - set_compilation_failure(S), - io:format("Error on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad pragma version ~p on line ~p,~n", - [Apply,LineNr]), - io:format(" the version is not valid.~n") - end; - _ -> - set_compilation_failure(S), - io:format("Error on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad pragma version ~p on line ~p,~n", - [Apply,LineNr]), - io:format(" the version is not valid.~n") - end. - - -pragma_reg_codeOpt(G, S, _N, {pragma,{_,LineNr,"CODEOPT"},_,Apply} )-> - case applyCodeOpt(G) of - true -> - {_,_,OptionList_str} = Apply, - case list_to_term(OptionList_str) of - error -> - ic_error:error(G,{pragma_code_opt_bad_option_list,LineNr}); - OptionList -> - case lists:keysearch(be,1,OptionList) of - false -> - %% Add the terms of the option list - %% to the compiler option list - applyCodeOpts(G,S,LineNr,OptionList); - {value, {be,Type}} -> - %% If backend is set from user, - %% let the same backend be otherwize - %% set backend by codeOpt directive - case get_opt(G, be) of - false -> - %% Add the terms of the option list - %% to the compiler option list - applyCodeOpts(G,S,LineNr,OptionList); - _ -> - %% Add all the terms of the option list - %% to the compiler option list but the - %% backend option - applyCodeOpts(G, - S, - LineNr, - lists:delete({be,Type},OptionList)) - end - end - end; - false -> - true - end. - - - -applyCodeOpts(_,_,_,[]) -> - true; -applyCodeOpts(G,S,LNr,[{{broker,Scope},{M,T}}|Xs]) -> - ScopedId = reverse(tokens(Scope,":")), - case ets:match(S, - {codeopt,ScopedId, - '$1','$2','_','_'}) of - [] -> - %% Add pragma in table - insert(S, - {codeopt, - ScopedId, - {broker,{M,T}}, - LNr, - get_idlfile(S), - get_filepath(S)}), - %% Continue - applyCodeOpts(G,S,LNr,Xs); - _ -> - %% Use the code option - %% from user and continue - applyCodeOpts(G,S,LNr,Xs) - end; -applyCodeOpts(G,S,LNr,[X|Xs]) -> - case is_allowed_opt(X) of - true -> - %% Add that term of the option list - %% to the compiler option list - ic_options:add_opt(G, [X], true), - %% Continue - applyCodeOpts(G,S,LNr,Xs); - false -> - %% Print warning and continue - io:format("Warning on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad option in pragma : ~p, ignored !~n",[X]), - applyCodeOpts(G,S,LNr,Xs) - end. - - -is_allowed_opt({X,Y}) -> - ic_options:allowed_opt(X,Y); -is_allowed_opt(_X) -> - false. - - - -%% Returns a tuple { PFX, VSN, ID }, that is the -%% pragma prefix, version and id coverages of -%% the scope SCOPE. This is done by use of the -%% function pragma_cover/4. -pragma_cover(G,Scope,Object) -> - pragma_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). - -%% Returns a tuple { PFX, VSN, ID }, that is the -%% pragma prefix, version and id coverages of -%% the scope SCOPE -pragma_cover(PragmaTab,Name,Scope,LineNr) -> - PFX = pragma_prefix_cover(PragmaTab,Name,Scope,LineNr), - VSN = pragma_version_cover(PragmaTab,Name,Scope,LineNr), - ID = pragma_id_cover(PragmaTab,Name,Scope,LineNr), - { PFX, VSN, ID }. - - - -%% Finds out which pragma PREFIX that affects -%% the scope Scope -pragma_prefix(G,Scope,Object) -> - pragma_prefix_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). - - -%% Finds out which pragma PREFIX that affects -%% the scope Scope -pragma_prefix_cover(PragmaTab,Name,Scope,LineNr) -> - case lookup(PragmaTab,prefix) of - [] -> - none; - PragmaPrefixList -> - FilteredPragmaPrefixList = - filter_pragma_prefix_list(PragmaTab,Name,Scope,PragmaPrefixList), - case most_local(FilteredPragmaPrefixList,Scope) of - [] -> - none; - MostLocalList -> - case dominant_prefix(MostLocalList,LineNr) of - none -> - none; - - %% Just filter empty pragma prefix - {prefix,{pragma,{_,_,_},_,{'<string_literal>',_,[]}},_,_,_,_} -> - none; - - DP -> - %% Return the scoped id (reversed list of - %% path elements, but remember to remove - %% '[]' that represents the top level - slashify(lists:sublist(Scope, 1, - length(Scope) - length(element(4,DP))) ++ - [ element(3,element(4,element(2,DP)))]) - end - end - end. - - -%% Returns a slashified name, [I1, M1] becomes "M1/I1" -slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, - hd(List), tl(List)). - - -%% Finds out which pragma VERSION that affects -%% the scope Scope -pragma_version(G,Scope,Object) -> - pragma_version_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). - -%% Finds out which pragma VERSION that affects -%% the scope Scope -pragma_version_cover(PragmaTab,Name,Scope,LineNr) -> - case lookup(PragmaTab,version) of - [] -> - default_version(); - PragmaVersionList -> - case all_actual_for_version_or_id( PragmaVersionList, Name ) of - [] -> - default_version(); - ActualVersionList -> - case most_local(ActualVersionList,Scope) of - [] -> - default_version(); - MostLocalList -> - case dominant_version(MostLocalList,LineNr) of - DV -> - element(4,element(2,DV)) - end - end - end - end. - - -default_version() -> "1.0". - - - -%% Finds out which pragma ID that affects -%% the scope Scope -pragma_id(G,Scope,Object) -> - pragma_id_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). - -%% Finds out which pragma ID that affects -%% the scope Scope -pragma_id_cover(PragmaTab,Name,Scope,LineNr) -> - case lookup(PragmaTab,id) of - [] -> - none; - PragmaIdList -> - case all_actual_for_version_or_id( PragmaIdList, Name ) of - [] -> - none; - ActualIdList -> - case most_local(ActualIdList,Scope) of - [] -> - none; - MostLocalList -> - case dominant_id(MostLocalList,LineNr) of - PI -> - element(3,element(4,element(2,PI))) - end - end - end - end. - - - - -%% Finds out which pragma VERSION ( or ID ) that -%% that affects the scope object with name NAME -all_actual_for_version_or_id(NList, Name) -> - all_actual_for_version_or_id( NList, [], Name ). - -all_actual_for_version_or_id([], Actual, _) -> - Actual; -all_actual_for_version_or_id([First|Rest], Found, Name) -> - case is_actual_for_version_or_id(First,Name) of - true -> - all_actual_for_version_or_id(Rest, [First|Found], Name); - false -> - all_actual_for_version_or_id(Rest, Found, Name) - end. - -is_actual_for_version_or_id( Current, Name ) -> - case element(3,element(3,element(2,Current))) of - Name -> - true; - OtherName -> - suffix([Name],tokens(OtherName,"::")) - end. - - - - -%% Find the most locally defind pragmas -%% to the scope SCOPE -most_local( SList, Scope ) -> - case SList of - [] -> - []; - [First|Rest] -> - case suffix( element(4,First), Scope ) of - true -> - most_local( Rest, First, Scope, [First] ); - false -> - most_local( Rest, Scope ) - end - end. - -%% Returns a list of all pragmas found in the -%% same scope. Should choose the right one by looking -%% att the position of the pragma in relation to -%% the current object..... ( For hairy cases ). -most_local( SList, Current, Scope, AllFound ) -> - case SList of - [] -> - AllFound; - [First|Rest] -> - FirstScope = element(4,First), - case suffix( FirstScope, Scope ) of - true -> - CurrentScope = element(4,Current), - case suffix( CurrentScope, FirstScope ) of - true -> - case length( CurrentScope ) == length( FirstScope ) of - true -> %% SAME SCOPE ! KEEP BOTH - most_local( Rest, Current, Scope, [First|AllFound] ); - false -> - most_local( Rest, First, Scope, [First] ) - end; - false -> - most_local( Rest, Current, Scope, AllFound ) - end; - false -> - most_local( Rest, Current, Scope, AllFound ) - end - end. - - - - -%% Find the most dominant prefix pragmas -%% located onto the SAME scope. Now -%% we look att the line number, the position -%% on the file. -dominant_prefix(SList,LineNr) -> - case SList of - [First|Rest] -> - dominant_prefix(Rest,First,LineNr) - end. - - -dominant_prefix([],{prefix,X,PLNr,N,F,T},LineNr) -> - case LineNr > PLNr of - true -> - {prefix,X,PLNr,N,F,T}; - false -> - none - end; -dominant_prefix([{prefix,FX,FPLNr,FN,F1,T1}|Rest],{prefix,CX,CPLNr,CN,F2,T2},LineNr) -> - case LineNr > FPLNr of % Check if FIRST before the object - true -> - case FPLNr > CPLNr of % Check if FIRST after CURRENT - true -> - dominant_prefix(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr); - false -> - dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) - end; - false -> % FIRST does not affect the object - dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) - end. - - - - -%% Find the most dominant version pragmas -%% located onto the SAME scope. Now -%% we look att the line number, the position -%% on the file. -dominant_version(SList,LineNr) -> - case SList of - [First|Rest] -> - dominant_version(Rest,First,LineNr) - end. - - -dominant_version([],Current,_) -> Current; -dominant_version([{version,FX,FPLNr,FN,F1,T1}|Rest],{version,CX,CPLNr,CN,F2,T2},LineNr) -> - case FPLNr > CPLNr of % Check if FIRST after CURRENT - true -> - dominant_version(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr); - false -> - dominant_version(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) - end. - - - - -%% Find the most dominant id pragmas -%% located onto the SAME scope. Now -%% we look att the line number, the position -%% on the file. -dominant_id(SList,LineNr) -> - case SList of - [First|Rest] -> - dominant_id(Rest,First,LineNr) - end. - - -dominant_id([],Current,_) -> Current; -dominant_id([{id,FX,FPLNr,FN,F1,T1}|Rest],{id,CX,CPLNr,CN,F2,T2},LineNr) -> - case FPLNr > CPLNr of % Check if FIRST after CURRENT - true -> - dominant_id(Rest,{id,FX,FPLNr,FN,F1,T1},LineNr); - false -> - dominant_id(Rest,{id,CX,CPLNr,CN,F2,T2},LineNr) - end. - - - - - -%% This registers a module defined inside the file or -%% an included file. A tuple that describes the module -%% is added to the table. -%% Observe that the modules registered are ONLY those -%% who are in the top level, not definedd inside others ! -mk_ref(G,Name,Type) -> - case length(Name) > 1 of - true -> %% The interface is NOT defined att top level - true; - false -> - S = ic_genobj:pragmatab(G), - File = get_idlfile(S), % The current file or an included one. - case idlfile(G) of % The current file to be compiled. - File -> - insert(S,{Type,Name,File,local}); - _ -> - insert(S,{Type,Name,File,included}) - end - end. - - -%% The same as mk_ref/3 but this registers everything with -%% all vital information available inside files. -%% Registers ESSENTIAL data for included files -mk_file_data(G,X,Scope,Type) -> - S = ic_genobj:pragmatab(G), - Name = get_id2(X), - PreprocFile = get_idlfile(S), % The current file or an included one. - CompFile = idlfile(G), % The current file compiled - Depth = length(Scope), % The depth of the scope - ScopedName = ic_util:to_undersc([Name|Scope]), - Line = ic_forms:get_line(X), - case PreprocFile of - CompFile -> - insert(S,{file_data_local,CompFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line}); - PreprocFile -> - insert(S,{file_data_included,PreprocFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line}) - end. - - - -%% Return a list with all the headers from -%% the local file that represent the module -%% or interface that is preciding the current -get_local_c_headers(G,X) -> - S = ic_genobj:pragmatab(G), - Local = lookup(S,file_data_local), - FoundLocal = get_local_c_headers(X,Local,Local), - no_doubles(FoundLocal). - -get_local_c_headers(X,Local,Local) -> - get_local_c_headers(X,Local,Local,[]). - -get_local_c_headers(_X,[],_All,Found) -> - Found; -get_local_c_headers(X,[{file_data_local,_PF_idl,_,module,_,_,SN,_,Line}|Hs],All,Found)-> - case ic_forms:get_line(X) > Line of - true -> - get_local_c_headers(X,Hs,All,[SN|Found]); - false -> - get_local_c_headers(X,Hs,All,Found) - end; -get_local_c_headers(X,[{file_data_local,_PF_idl,_,interface,_,_,SN,_,Line}|Hs],All,Found)-> - case ic_forms:get_line(X) > Line of - true -> - get_local_c_headers(X,Hs,All,[SN|Found]); - false -> - get_local_c_headers(X,Hs,All,Found) - end; -get_local_c_headers(X,[_|Hs],All,Found) -> - get_local_c_headers(X,Hs,All,Found). - - - -%% Return a list with all the headers from -%% the included file that represent the module -%% or interface that have to be included -get_included_c_headers(G) -> - S = ic_genobj:pragmatab(G), - Included = lookup(S,file_data_included), - FoundIncluded = get_included_c_headers(Included,Included), - no_doubles(FoundIncluded). - -get_included_c_headers(Included,Included) -> - get_included_c_headers(Included,Included,[]). - -get_included_c_headers([],_All,Found) -> - Found; -get_included_c_headers([{file_data_included,PF_idl,_CF_idl,T,_S,_N,SN,0,_}|Hs],All,Found) -> - Len = length(PF_idl), - FN = string:sub_string(PF_idl,1,Len-4), - case only_top_level(PF_idl,All) of - true -> - %% - L = string:tokens(FN,"/"), - FN2 = lists:last(L), - %% - get_included_c_headers(Hs,All,["oe_"++FN2|Found]); - false -> - case T of - module -> - case contains_interface(PF_idl,All) of - true -> - %% - L = string:tokens(FN,"/"), - FN2 = lists:last(L), - %% - get_included_c_headers(Hs,All,["oe_"++FN2|Found]); - false -> - get_included_c_headers(Hs,All,[SN|Found]) - end; - interface -> - case contains_interface(PF_idl,All) of - true -> - %% - L = string:tokens(FN,"/"), - FN2 = lists:last(L), - %% - get_included_c_headers(Hs,All,["oe_"++FN2|Found]); - false -> - get_included_c_headers(Hs,All,[SN|Found]) - end; - _ -> - get_included_c_headers(Hs,All,["oe_"++FN|Found]) - end - end; -get_included_c_headers([{file_data_included,_PF_idl,_,module,_,_,SN,_,_}|Hs],All,Found)-> - get_included_c_headers(Hs,All,[SN|Found]); -get_included_c_headers([{file_data_included,_PF_idl,_,interface,_,_,SN,_,_}|Hs],All,Found)-> - get_included_c_headers(Hs,All,[SN|Found]); -get_included_c_headers([_|Hs],All,Found) -> - get_included_c_headers(Hs,All,Found). - -%% Help functions for the above - -only_top_level(_PF_idl,[]) -> - true; -only_top_level(PF_idl,[H|Hs]) -> - case element(2,H) of - PF_idl -> - case element(8,H) > 0 of - true -> - false; - false -> - only_top_level(PF_idl,Hs) - end; - _ -> - only_top_level(PF_idl,Hs) - end. - -contains_interface(_PF_idl,[]) -> - false; -contains_interface(PF_idl,[H|Hs]) -> - case element(2,H) of - PF_idl -> - case element(4,H) of - interface -> - case element(8,H) > 0 of - true -> - true; - false -> - contains_interface(PF_idl,Hs) - end; - _ -> - contains_interface(PF_idl,Hs) - end; - _ -> - contains_interface(PF_idl,Hs) - end. - - - -%% This returns a list of everything defined in an included file. -get_incl_refs(G) -> - S = ic_genobj:pragmatab(G), - - RefList = - ets:match(S,{mod_ref,'$0','_',included}) ++ - ets:match(S,{ifc_ref,'$0','_',included}) ++ - ets:match(S,{const_ref,'$0','_',included}) ++ - ets:match(S,{typedef_ref,'$0','_',included}) ++ - ets:match(S,{except_ref,'$0','_',included}) ++ - ets:match(S,{struct_ref,'$0','_',included}) ++ - ets:match(S,{union_ref,'$0','_',included}) ++ - ets:match(S,{enum_ref,'$0','_',included}) ++ - ets:match(S,{attr_ref,'$0','_',included}), - - case RefList of - [] -> - none; - _ -> - RefList - end. - - - -%% This returns a list of everything locally defined. -get_local_refs(G) -> - S = ic_genobj:pragmatab(G), - - RefList = - ets:match(S,{mod_ref,'$0','_',local}) ++ - ets:match(S,{ifc_ref,'$0','_',local}) ++ - ets:match(S,{const_ref,'$0','_',local}) ++ - ets:match(S,{typedef_ref,'$0','_',local}) ++ - ets:match(S,{except_ref,'$0','_',local}) ++ - ets:match(S,{struct_ref,'$0','_',local}) ++ - ets:match(S,{union_ref,'$0','_',local}) ++ - ets:match(S,{enum_ref,'$0','_',local}) ++ - ets:match(S,{attr_ref,'$0','_',local}), - - case RefList of - [] -> - none; - _ -> - RefList - end. - - - - - -%% This is intented to be used for solving the identification -%% problem introduced by pragmas. It creates aliases between -%% scoped and "final" identities. -mk_alias(G,PragmaId,ScopedId) -> - %io:format("~nMaking alias -> ~p~n",[PragmaId]), - S = ic_genobj:pragmatab(G), - insert(S,{alias,ScopedId,PragmaId}). - - -%% This is used to find out if the object described with -%% the scoped id is created. If this is the case, it should -%% be registered as an alias and the identity of the object -%% is returned. Otherwize "none" is returned. -get_alias(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - case ets:match(S,{alias,ScopedId,'$1'}) of - [] -> - none; - [[IfrId]] -> - %io:format("~nFound alias -> ~p~n",[IfrId]), - IfrId - end. - - - -%% Returns the alias id or constructs an id -scope2id(G,ScopedId) -> - case get_alias(G,ScopedId) of - none -> - case is_included(G,ScopedId) of - true -> %% File included - get_included_IR_ID(G,ScopedId); - false -> %% File local - NewIfrId = mk_id(ScopedId), % Create a "standard" id - mk_alias(G,NewIfrId,ScopedId), % Create an alias - NewIfrId - end; - IfrId -> - IfrId - end. - - - - -is_included(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - Name = ic_util:to_undersc(ScopedId), - case ets:match(S,{file_data_included,'_','_','_','_','_',Name,'_','_'}) of - [[]] -> - true; - _ -> - false - end. - - - -get_included_IR_ID(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - ScopedName = ic_util:to_undersc(ScopedId), - [[Scope,Name,LNr]] = ets:match(S,{file_data_included,'_','_','_','$3','$4',ScopedName,'_','$7'}), - {Prefix,Vsn,Id} = pragma_cover(S,Name,Scope,LNr), - case Id of - none -> - case Prefix of - none -> - IR_ID = - lists:flatten(io_lib:format("IDL:~s:~s",[ScopedName, Vsn])), - ic_pragma:mk_alias(G,IR_ID,ScopedId), - IR_ID; - _ -> - IR_ID = - lists:flatten(io_lib:format("IDL:~s:~s",[Prefix ++ "/" ++ ScopedName, Vsn])), - ic_pragma:mk_alias(G,IR_ID,ScopedId), - IR_ID - end; - _ -> - ic_pragma:mk_alias(G,Id,ScopedId), - Id - end. - - - - - -%% Returns the scope for object -id2scope(G,IfrId) -> - S = ic_genobj:pragmatab(G), - case lookup(S,alias) of - [] -> - mk_scope(IfrId); - AliasList -> - case keysearch(IfrId,3,AliasList) of - false -> - mk_scope(IfrId); - {value,{alias,ScopedId,_}} -> - ScopedId - end - end. - -%% Returns a "standard" IDL ID by getting the scope list -mk_id(ScopedId) -> - "IDL:" ++ ic_pragma:slashify(ScopedId) ++ ":" ++ default_version(). - -%% Returns the scope of an object when getting a "standard" IDL ID -mk_scope(IfrId) -> - [_,Body,_] = tokens(IfrId,":"), - reverse(tokens(Body,"/")). - - - -%% This is used to note the exact compiled file -%% under pragma creation. There are two options, the -%% main file or files included by the main file. This -%% just denotes the CURRENT file, the main file or -%% the included ones. A very usual field is the file -%% path that shows the include path of the file - -init_idlfile(G,S) -> - IdlFile = idlfile(G), - insert(S,{file,IdlFile,[]}). - -set_idlfile(S,FileName) -> - FilePath = get_filepath(S), - case FilePath of - [] -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}); - _ -> - case hd(FilePath) of - [] -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}); - _ -> - case tl(FilePath) of - [] -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}); - _ -> - case hd(tl(FilePath)) of - [] -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}); - FileName -> - ets:delete(S,file), - insert(S,{dependency,FilePath}), % Add dependency branch - insert(S,{file,FileName,tl(FilePath)}); - _ -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}) - end - end - end - end. - -get_idlfile(S) -> - [FT] = lookup(S,file), - element(2,FT). - -get_filepath(S) -> - [FT] = lookup(S,file), - element(3,FT). - - -%% This returns a list of file names -%% that direct or indirect the current -%% compiled file is depended on. -get_dependencies(G) -> - S = ic_genobj:pragmatab(G), - case lookup(S,dependency) of - [] -> - []; - Dependencies -> - {get_idlfile(S),get_dependencies(Dependencies,[])} - end. - -get_dependencies([],Dependencies) -> - no_doubles(Dependencies); -get_dependencies([{dependency,Path}|Tail],Current) -> - get_dependencies(Tail,[hd(Path)|Current]). - - -no_doubles(List) -> - no_doubles(List,[]). - -no_doubles([],NoDoubles) -> - NoDoubles; -no_doubles([X|Xs],Current) -> - case member(X,Xs) of - true -> - no_doubles(Xs,Current); - false -> - no_doubles(Xs,[X|Current]) - end. - - - - -%% Pragma compilation status initialization -init_pragma_status(S) -> - insert(S,{status,true,0}). - -%% Pragma compilation status set to failure -%% and count up the number of errors -set_compilation_failure(S) -> - [{status,_,ErrorNr}] = lookup(S,status), - ets:delete(S,status), - insert(S,{status,false,ErrorNr+1}). - -%% Pragma compilation status set to lookup -get_pragma_compilation_status(S) -> - [Status] = lookup(S,status), - element(2,Status). - -%% Pragma error number -get_pragma_error_nr(S) -> - [Status] = lookup(S,status), - element(3,Status). - - -%% Short check -is_short(N_str) when is_list(N_str) -> - case is_short_decimal_str(N_str) of - true -> - true; - false -> - false - end; -is_short(N) when is_integer(N)-> - (N < 65535) and (N > -65536); -is_short(_) -> false. - - -%% Check if the string is a -%% list of characters representing -%% a short. Avoid crash !. -is_short_decimal_str(N_str) -> - case is_decimal_str(N_str) of - true -> - N = list_to_integer(N_str), - (N < 65535) and (N > -65536); - false -> - false - end. - -%% Check if the string is a -%% list of characters representing -%% decimals. -is_decimal_str([]) -> - true; -is_decimal_str([First|Rest]) -> - case is_decimal_char(First) of - true -> - is_decimal_str(Rest); - false -> - false - end. - -%% True if D is a character -%% representing a decimal (0-9). -is_decimal_char(D) -> - case (48=<D) and (D=<57) of - true -> - true; - false -> - false - end. - - -%% Prints out all the table -print_tab(G) -> - io:format("~nPragmaTab = ~p~n",[ets:tab2list(ic_genobj:pragmatab(G))]). - - -list_to_term(List) -> - case catch erl_scan:string(List) of - {ok, Tokens, _} -> - case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of - {ok,Term} -> - Term; - _ -> - error - end; - _ -> - error - end. - - - -%% Cleanup all other code options for a specified scope -%% in the same file, but the most dominant. -cleanup_codeOptions(G,S,ScopedId) -> - case ets:match(S,{codeopt,ScopedId,'$1','$2',idlfile(G),'$4'}) of - [] -> - %% No codeOpt directive is placed inside the - %% currently compiled file. Try to find other - %% directives located in included files. - true; - List -> - %% A codeOpt directive is placed inside the - %% currently compiled file. This dominates - %% all other directives. - CodeOption = best_positioned_codeOpt(List), - %% Remove code options that do not affect - %% the code production (redundant) - remove_redundant_codeOpt(S,[ScopedId|CodeOption]) - end. - - -%% Best positioned is the codeopt located -%% "highest" on the SAME file, the one with -%% lowest line number. -best_positioned_codeOpt([X|Xs]) -> - best_positioned_codeOpt(Xs,X). - -best_positioned_codeOpt([],Found) -> - Found; -best_positioned_codeOpt([X|Xs],Current) -> - case hd(tl(X)) > hd(tl(Current)) of - true -> - best_positioned_codeOpt(Xs,Current); - false -> - best_positioned_codeOpt(Xs,X) - end. - - -remove_redundant_codeOpt(S,[ScopedId,CodeOption,LNr,FilePath]) -> - ets:match_delete(S,{codeopt,ScopedId,'$1','$2','$3','$4'}), - ets:insert(S,{codeopt,ScopedId,CodeOption,LNr,last(FilePath),FilePath}). - - - - -add_inh_data(G,InclScope,X) -> - S = ic_genobj:pragmatab(G), - case X#interface.inherit of - [] -> - true; - [InhBody] -> - Scope = [get_id2(X)|InclScope], - insert(S,{inherits,Scope,InhBody}); - InhList -> - add_inh_data(G, S, InclScope, X, InhList) - end. - -add_inh_data(_,_,_,_,[]) -> - true; -add_inh_data(G, S, InclScope, X, [InhBody|InhBodies]) -> - Scope = [get_id2(X)|InclScope], - insert(S, {inherits,Scope,InhBody}), - add_inh_data(G, S, InclScope, X, InhBodies). - - -%% Returns a default broker data -defaultBrokerData(G) -> - {to_atom(ic_genobj:impl(G)),transparent}. - - -%% Loops through the form and sdds inheritence data -preproc(G, N, [X|Xs]) when is_record(X, interface) -> - %% Add inheritence data to pragmatab - ic_pragma:add_inh_data(G,N,X), - N2 = [get_id2(X) | N], - preproc(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> preproc(G, N2, Body) end, - X#interface.inherit_body), - preproc(G, N, Xs); - -preproc(G,N,[X|Xs]) when is_record(X, module) -> - N2 = [get_id2(X) | N], - preproc(G, N2, get_body(X)), - preproc(G,N,Xs); - -preproc(G,N,[_X|Xs]) -> - preproc(G,N,Xs); - -preproc(_G, _N, []) -> - ok. - - -%% Returns a tuple / list of tuples { Mod, Type } -%% Does not check overridence because it is the -%% top scope for the module to be produced and -%% cannot be overriden. -getBrokerData(G,X,Scope) -> - S = ic_genobj:pragmatab(G), - cleanup_codeOptions(G,S,Scope), - - %% Check if it is an operation denoted - case isOperation(S,Scope) of - %% Yes, check options - true -> - %% Look if there is a specific code option on top file - case hasSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G),Scope) of - true -> - %% Yes, let it work - getBrokerData(G,S,X,Scope,[Scope],[]); - false -> - %% No, try to see if there is codeoption on top file - case hasNonSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G)) of - true -> - %% Yes, override every other specific code option - [_H|T] = Scope, - getBrokerData(G,S,X,Scope,[T],[]); - false -> - %% No, let inherited specific code options work - getBrokerData(G,S,X,Scope,[Scope],[]) - end - end; - %% No, continue - false -> - getBrokerData(G,S,X,Scope,[Scope],[]) - end. - -%% Returns a tuple / list of tuples { Mod, Type } -%% Inside loop, uses overridence. -getBrokerData(G,X,RS,Scope,CSF) -> - S = ic_genobj:pragmatab(G), - cleanup_codeOptions(G,S,Scope), - OvScope = overridedFrom(S,RS,Scope), - getBrokerData(G,S,X,RS,[OvScope],[OvScope|CSF]). - - - -getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) when is_integer(First) -> - Scope = [[First]|Rest], - case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of - [] -> - case ets:match(S,{inherits,Scope,'$1'}) of - [] -> %% No inheritence, no pragma codeopt - defaultBrokerData(G); %% Default - [InhScope] -> - getBrokerData(G,S,X,RS,InhScope,CSF); - InhList -> - getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) - end; - [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt - {Module,Type}; - List -> %% Multiple branches with pragma codeopt - flatten(List) - end; - -getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) -> - getBrokerDataLoop(G,S,X,RS,[[First]|Rest],CSF); - -getBrokerData(G,S,X,RS,[Scope],CSF) -> - %io:format(" 1"), - case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of - [] -> - %io:format(" 2"), - case ets:match(S,{inherits,Scope,'$1'}) of - [] -> %% No inheritence, no pragma codeopt - %io:format(" 5"), - defaultBrokerData(G); %% Default - [InhScope] -> - %io:format(" 6"), - getBrokerData(G,S,X,RS,InhScope,CSF); - InhList -> - %io:format(" 7"), - getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) - end; - [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt - %io:format(" 3"), - {Module,Type}; - List -> %% Multiple branches with pragma codeopt - %io:format(" 4"), - flatten(List) - end. - - -%% Special treatment when X is an operation -getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) when is_record(X,op)-> - %io:format(" 8"), - case ets:match(S,{op,get_id2(X),'$1','_','_'}) of - [] -> - %io:format(" 10"), - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF); - - [[Scope]] -> - %io:format(" 11"), - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF); - - [[OpScope]] -> - %io:format(" 12"), - case member([OpScope],InhList) of - true -> - %io:format(" 14"), - %% No inherited scopes - getBrokerData(G,X,RS,OpScope,CSF); - false -> - %io:format(" 15"), - %% Inherited scopes - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF) - end; - - ListOfOpScopes -> - %io:format(" 13"), - case get_inherited(S,Scope,ListOfOpScopes) of - [[OpScope]] -> - case member([OpScope],InhList) of - true -> - getBrokerData(G,X,RS,OpScope,CSF); - false -> - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF) - end; - _ -> - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF) - end - end; -%% Just add InhList after removing all inherited -getBrokerDataInh(G,S,X,RS,_Scope,CSF,InhList) -> - %io:format(" 9"), - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF). - - - - -%% Loops over a list of scopes -getBrokerDataLoop(G,S,X,RS,List,CSF) -> - getBrokerDataLoop(G,S,X,RS,List,[],CSF). - -getBrokerDataLoop(G,_,_X,_RS,[],BrokerDataList,_CSF) -> - case no_doubles(BrokerDataList) of - [BrokerData] -> %% No pragma codeopt / Multiple branches with pragma codeopt - BrokerData; - List -> - DefaultBD = defaultBrokerData(G), - case member(DefaultBD,List) of - true -> - %% Remove default, choose codeoption - NewList = delete(DefaultBD,List), - case NewList of - [BData] -> %% A branch only, with pragma codeopt - BData; - _Other -> %% Multiple branches with pragma codeopt - %%io:format("Multiple branches ~p~n",[Other]), - NewList - end; - false -> %% Multiple branches with pragma codeopt - flatten(List) - end - end; - -getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],_Found,CSF) when is_integer(Scope) -> - getBrokerData(G,S,X,RS,[[Scope]|Scopes],CSF); - -getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],Found,CSF) -> - %% Start from the beginning, check for overridings - case member(overridedFrom(S,RS,Scope),CSF) of %% Avoid infinite loops - true -> - getBrokerDataLoop(G,S,X,RS,Scopes,Found,CSF); - false -> - BrokerData = getBrokerData(G,X,RS,Scope,CSF), - getBrokerDataLoop(G,S,X,RS,Scopes,[BrokerData|Found],[Scope|CSF]) - end. - - - - -%%%-------------------------------------- -%%% Finds out the overrider of a scope -%%%-------------------------------------- -overridedFrom(S,RS,Scope) -> - overridedFrom(S,RS,Scope,Scope). - -overridedFrom(S,RS,Last,Scope) -> - case ets:match(S,{inherits,'$0',Scope}) of - [] -> - %% No inheritence, no pragma codeopt, - %% choose the last scope. - Last; - - [[RS]] -> - %% Garbage, unused interface with pragma - %% code option ! Danger ! - Last; - - [[InhScope]] -> - case ets:match(S,{codeopt,InhScope,'$1','_','_','_'}) of - [] -> - %% InhScope has no code options, keep Last. - overridedFrom(S,RS,Scope,InhScope); - _ -> - %% InhScope has code option, Last = InhScope. - overridedFrom(S,RS,InhScope,InhScope) - end; - List -> - %% Several inherit from Scope, choose the one feeseble, - %% the one DIRECTLY inherited by Scope and not through - %% other interface. - case remove_inheriters(S,RS,List) of - [] -> - Scope; - Removed -> - Removed - end - end. - -%%%------------------------------------------------------ -%%% Removes all the scopes that inherit from others -%%%------------------------------------------------------ -remove_inheriters(S,RS,InheriterList) -> - DominantList = - dominantList(S,InheriterList), - ReducedInhList = - [X || X <- InheriterList, - member(X,DominantList)], - - case ReducedInhList of - [] -> - []; - [_OneOnly] -> - ReducedInhList; - _Other -> - CleanList = - ets:match_object(S, {inherits,'_','_'}), -% CodeOptList = -% [X || X <- EtsList, element(1,X) == codeopt], - NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList), - - [ [X] || [X] <- NoInheriters, - inherits(RS,X,CleanList)] - end. - -remove_inheriters2(_,[A],_) -> - [A]; -remove_inheriters2(_S,[A,B],EtsList) -> - case remove_inh(A,B,[A,B],EtsList) of - [[X]] -> - X; - List -> - List - end; -remove_inheriters2(S,[A,B|Rest],EtsList) -> - case remove_inh(A,B,[A,B|Rest],EtsList) of - [A,B|Rest] -> - [A,B|Rest]; - NewList -> - remove_inheriters2(S,NewList,EtsList) - end. - -remove_inh([X],[Y],List,EtsList) -> - case inherits(X,Y,EtsList) of - true -> - delete([X],List); - false -> - case inherits(Y,X,EtsList) of - true -> - delete([Y],List); - false -> - List - end - end. - - - -%%%---------------------------------------------- -%%% Should remove all scope links that inherit -%%% from others in the list -%%%---------------------------------------------- -remove_inherited(S,InheriterList) -> - CleanList = - ets:match_object(S, {inherits, '_', '_'}), - remove_inherited(S,InheriterList,CleanList). - - -remove_inherited(_S,[A,B],EtsList) -> - case remove_inhed(A,B,[A,B],EtsList) of - [[X]] -> - [[X]]; - List -> - List - end; -remove_inherited(S,[A,B|Rest],EtsList) -> - case remove_inhed(A,B,[A,B|Rest],EtsList) of - [A,B|Rest] -> - [A,B|Rest]; - NewList -> - remove_inherited(S,NewList,EtsList) - end. - - -remove_inhed([X],[Y],List,EtsList) -> - case inherits(X,Y,EtsList) of - true -> - delete([Y],List); - false -> - case inherits(Y,X,EtsList) of - true -> - delete([X],List); - false -> - List - end - end. - - - - - - - -%%%---------------------------------------------- -%%% Should return all scope links that is -%% are inherited from scope in the list -%%%---------------------------------------------- -get_inherited(S,Scope,OpScopeList) -> - EtsList1 = ets:match(S, {inherits, Scope, '$1'}), - [X || X <- EtsList1, member(X, OpScopeList)]. - - - - - - - -%%%--------------------------------------------------- -%%% Returns a the list of scopes that have codeoption -%%% from a list of scopes -%%%--------------------------------------------------- -dominantList(S,IL) -> - dominantList(S,IL,[]). - -dominantList(_S,[],Found) -> - Found; -dominantList(S,[[X]|Xs],Found) -> - case ets:match(S,{codeopt,X,'$1','_','_','_'}) of - [] -> - dominantList(S,Xs,Found); - _ -> - dominantList(S,Xs,[[X]|Found]) - end. - - - - -%%%--------------------------------------------------- -%%% Returns true if X direct or indirect inherits Y -%%%--------------------------------------------------- -inherits(X,Y,EtsList) -> - case member({inherits,X,Y},EtsList) of - true -> - %% Direct inherited - true; - false -> - %% Indirectly inherited - AllInh = [ B || {inherits,A,B} <- EtsList, A == X ], - inherits(X,Y,AllInh,EtsList) - end. - -inherits(_X,_Y,[],_EtsList) -> - false; -inherits(X,Y,[Z|Zs],EtsList) -> - case inherits2(X,Y,Z,EtsList) of - true -> - true; - false -> - inherits(X,Y,Zs,EtsList) - end. - -inherits2(_X,Y,Z,EtsList) -> - case member({inherits,Z,Y},EtsList) of - true -> - true; - false -> - inherits(Z,Y,EtsList) - end. - - - -%% -%% is_inherited_by/3 -%% -%% Returns : -%% -%% true if the first parameter is -%% inherited by the second one -%% -%% false otherwise -%% -is_inherited_by(Interface1,Interface2,PragmaTab) -> - InheritsList = ets:match_object(PragmaTab, {inherits, '_', '_'}), - inherits(Interface2,Interface1,InheritsList). - - - - -%% Filters all pragma prefix from list not in same file -%% the object - -filter_pragma_prefix_list(PragmaTab, Name, Scope, List) -> - IdlFile = scoped_names_idl_file(PragmaTab, Name, Scope), - filter_pragma_prefix_list2(PragmaTab,IdlFile,List,[]). - - -filter_pragma_prefix_list2(_,_,[],Found) -> - Found; -filter_pragma_prefix_list2(PT, IdlFile, [PP|PPs], Found) -> - case PP of - {prefix,_,_,_,IdlFile,_} -> %% Same file as the Object, keep - filter_pragma_prefix_list2(PT, IdlFile, PPs, [PP|Found]); - - _Other -> %% NOT in same file as the Object, throw away - filter_pragma_prefix_list2(PT, IdlFile, PPs, Found) - end. - -scoped_names_idl_file(PragmaTab, Name, Scope) -> - case ets:match(PragmaTab,{'_','$0','_','$2',Scope,Name,'_','_','_'}) of - [[IdlFile, _Type]] -> %% Usual case - IdlFile; - [[_File,module]|_Files] -> %% Multiple modules, get LOCAL file - case ets:match(PragmaTab,{file_data_local,'$0','_',module,Scope,Name,'_','_','_'}) of - [[LocalIdlFile]] -> - LocalIdlFile; - _ -> %% Should NEVER occur - error - end; - - _ -> - error %% Should NEVER occur - end. - - - - - - -%%------------------------------------------------- -%% -%% Register specific pragma code options -%% -%% If there is an operation with that -%% scope, denote this as {codeopt_specific,Scope} -%% -%%------------------------------------------------- -denote_specific_code_opts(G) -> - case ic_options:get_opt(G, be) of - noc -> - S = ic_genobj:pragmatab(G), - COList = ets:match(S,{codeopt,'$0','_','_','_','_'}), - OPList = ets:match(S,{op,'$0','$1','_','_'}), - denote_specific_code_opts(S,COList,OPList); - _ -> - ok - end. - -denote_specific_code_opts(_,_,[]) -> - ok; -denote_specific_code_opts(S,COList,[[OpN,OpS]|OPSs]) -> - case lists:member([[OpN|OpS]],COList) of - true -> - insert(S, {codeopt_specific,[OpN|OpS]}); - false -> - ok - end, - denote_specific_code_opts(S,COList,OPSs). - - - -%%--------------------------------------------- -%% -%% Returns true/false if it denotes an operation -%% -%%--------------------------------------------- -isOperation(_S,[]) -> - false; -isOperation(_S,[_]) -> - false; -isOperation(S,[H|T]) -> - case ets:match(S,{op,H,T,'$2','$3'}) of - [] -> - false; - _ -> - true - end. - - -hasSpecificCodeoptionOnTopFile(S,File,Scope) -> - case ets:match(S,{codeopt,Scope,'_','$2',File,[File]}) of - [] -> - false; - _ -> - true - end. - - -hasNonSpecificCodeoptionOnTopFile(S,File) -> - case ets:match(S,{codeopt,'_','_','$2',File,[File]}) of - [] -> - false; - _ -> - true - end. - - - -%%--------------------------------------------- -%% -%% Returns {ok,IfrId}/error when searching a random local type -%% -%%--------------------------------------------- - - -fetchRandomLocalType(G) -> - - S = ic_genobj:pragmatab(G), - - case ets:match(S,{file_data_local,'_','_','$2','$3','$4','_','_','_'}) of - [] -> - false; - - List -> - fetchRandomLocalType(S,List) - end. - - -fetchRandomLocalType(_,[]) -> - false; -fetchRandomLocalType(S,[[module|_]|Tail]) -> - fetchRandomLocalType(S,Tail); -fetchRandomLocalType(S,[[_,Scope,Name]|Tail]) -> - case ets:match(S,{alias,[Name|Scope],'$1'}) of - [] -> - fetchRandomLocalType(S,Tail); - [[IfrId]] -> - {ok,IfrId} - end. - - - -%%--------------------------------------------- -%% -%% Returns A list of local operation mapping -%% for a given scope -%% -%%--------------------------------------------- - - -fetchLocalOperationNames(G,I) -> - S = ic_genobj:pragmatab(G), - case ets:match(S,{file_data_local,'_','_',op,I,'$4','_','_','_'}) of - [] -> - []; - List -> - fetchLocalOperationNames2(List,[]) - end. - -fetchLocalOperationNames2([],Found) -> - lists:reverse(Found); -fetchLocalOperationNames2([[Name]|Names],Found) -> - fetchLocalOperationNames2(Names,[Name|Found]). - - - -%%------------------------------------------------ -%% -%% Returns a true if this scoped id is a local -%% one, false otherwise -%% -%%------------------------------------------------ -is_local(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - Name = ic_util:to_undersc(ScopedId), - case ets:match(S,{file_data_local,'_','_','_',tl(ScopedId),'_',Name,'_','_'}) of - [[]] -> - true; - _ -> - false - end. diff --git a/lib/ic/src/ic_sequence_java.erl b/lib/ic/src/ic_sequence_java.erl deleted file mode 100644 index f4873a0691..0000000000 --- a/lib/ic/src/ic_sequence_java.erl +++ /dev/null @@ -1,240 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - --module(ic_sequence_java). - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/4]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: gen/4 -%%----------------------------------------------------------------- -gen(G, N, X, SequenceName) when is_record(X, sequence) -> - emit_holder_class(G, N, X, SequenceName), - emit_helper_class(G, N, X, SequenceName); -gen(_G, _N, _X, _SequenceName) -> - ok. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, X, SequenceName) -> - SName = string:concat(SequenceName, "Holder"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - SequenceType = ic_java_type:getType(G, N, X), - - ic_codegen:emit(Fd, ["final public class ",SequenceName,"Holder {\n" - " // instance variables\n" - " public ",SequenceType," value;\n\n" - " // constructors\n" - " public ",SequenceName,"Holder() {}\n" - " public ",SequenceName,"Holder(",SequenceType," initial) {\n" - " value = initial;\n" - " }\n\n" - - " // methods\n" - - " public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception{\n" - " ",SequenceName,"Helper.marshal(out, value);\n" - " }\n\n" - - " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" - " value = ",SequenceName,"Helper.unmarshal(in);\n" - " }\n\n" - "}\n"]), - file:close(Fd). - - - -emit_helper_class(G, N, X, SequenceName) -> - SName = string:concat(SequenceName, "Helper"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - SequenceType = ic_java_type:getType(G, N, X), - ElementType = ic_forms:get_type(X), - - ic_codegen:emit(Fd, ["public class ",SequenceName,"Helper {\n" - - " // constructors\n" - " private ",SequenceName,"Helper() {}\n\n" - - " // methods\n" - " public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",SequenceType," _value) \n" - " throws java.lang.Exception {\n\n"]), - - emit_sequence_marshal_function(G, N, X, Fd, SequenceName, ElementType), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static ",SequenceType," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in) \n" - " throws java.lang.Exception {\n\n"]), - - emit_sequence_unmarshal_function(G, N, X, Fd, SequenceName, ElementType), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static String id() {\n" - " return \"",ic_pragma:scope2id(G, [SequenceName | N]),"\";\n" - " }\n\n" - - " public static String name() {\n" - " return \"",SequenceName,"\";\n" - " }\n\n"]), - - ic_jbe:emit_type_function(G, N, X, Fd), - - ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",SequenceType," _this)\n" - " throws java.lang.Exception {\n\n" - - " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" - " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" - - " _any.type(type());\n" - " marshal(_os, _this);\n" - " _any.insert_Streamable(_os);\n" - " }\n\n" - - " public static ",SequenceType," extract(",?ICPACKAGE,"Any _any)\n" - " throws java.lang.Exception {\n\n" - - " return unmarshal(_any.extract_Streamable());\n" - " }\n\n" - - - %% In corba mapping there is also a _type function here. - "}\n\n"]), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_sequence_marshal_function/6 -%%----------------------------------------------------------------- -emit_sequence_marshal_function(G, N, X, Fd, _SequenceName, ElementType) -> - ic_codegen:emit(Fd, [" int _length = _value.length;\n\n" - - " _out.write_list_head(_length);\n\n" - - " if (_length > 0) {\n" - " for(int _tmp = 0; _tmp < _length; _tmp++)\n"]), - - case ic_java_type:isBasicType(G, N, ElementType) of - true -> - ic_codegen:emit(Fd, [" _out",ic_java_type:marshalFun(G, N, X, ElementType),"(_value[_tmp]);\n\n"]); - false -> - ic_codegen:emit(Fd, [" ",ic_java_type:marshalFun(G, N, X, ElementType),"(_out, _value[_tmp]);\n\n"]) - end, - - ic_codegen:emit(Fd, [" _out.write_nil();\n" - " }\n\n"]). - - - - -%%----------------------------------------------------------------- -%% Func: emit_sequence_unmarshal_function/6 -%%----------------------------------------------------------------- -emit_sequence_unmarshal_function(G, N, X, Fd, _SequenceName, ElementType) -> - - SequenceElementType = ic_java_type:getType(G, N, ElementType), - - ic_codegen:emit(Fd, [" int _tag,_length;\n" - " ",SequenceElementType," _sequence[];\n" - " _tag = _in.peek();\n\n"]), - - case ic_java_type:isIntegerType(G, N, ElementType) of - true -> - ic_codegen:emit(Fd, [" switch(_tag) {\n" - " case ",?ERLANGPACKAGE,"OtpExternal.stringTag:\n" - " byte _compressed[] = (_in.read_string()).getBytes();\n" - " _length = _compressed.length;\n" - " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" - - " for(int _tmp = 0; _tmp < _length; _tmp++)\n" - " _sequence[_tmp] = (",ic_java_type:getType(G, N, ElementType),")(_compressed[_tmp] & 0xff);\n\n" - - " break;\n" - " default:\n" - " _length = _in.read_list_head();\n" - " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" - - " if(_length > 0) {\n" - " for(int _tmp = 0; _tmp < _length; _tmp++)\n" - " _sequence[_tmp] = _in",ic_java_type:unMarshalFun(G, N, X, ElementType),";\n\n" - - " _in.read_nil();\n" - " }\n" - " }\n"]); - false -> - ic_codegen:emit(Fd, [" _length = _in.read_list_head();\n" - " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" - - " if(_length > 0) {\n" - " for(int _tmp = 0; _tmp < _length; _tmp++)\n"]), - case ic_java_type:isBasicType(G, N, ElementType) of - true -> - ic_codegen:emit(Fd, [" _sequence[_tmp] = _in",ic_java_type:unMarshalFun(G, N, X, ElementType),";\n\n"]); - _ -> - ic_codegen:emit(Fd, [" _sequence[_tmp] = ",ic_java_type:getUnmarshalType(G, N, X, ElementType),".unmarshal(_in);\n\n"]) - end, - - ic_codegen:emit(Fd, [" _in.read_nil();\n" - " }\n\n"]) - end, - - ic_codegen:emit(Fd, " return _sequence;\n"). - - - - -%%--------------------------------------------------- -%% Utilities -%%--------------------------------------------------- - - - - - - - - - diff --git a/lib/ic/src/ic_struct_java.erl b/lib/ic/src/ic_struct_java.erl deleted file mode 100644 index 94b98f6c52..0000000000 --- a/lib/ic/src/ic_struct_java.erl +++ /dev/null @@ -1,315 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - --module(ic_struct_java). - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- -gen(G, N, X) when is_record(X, struct) -> - StructName = ic_forms:get_java_id(X), - WireStructName = ic_forms:get_id2(X), - emit_struct_class(G, N, X, StructName), - emit_holder_class(G, N, X, StructName), - emit_helper_class(G, N, X, StructName, WireStructName), - N2 = [StructName ++ "Package" |N], - ic_jbe:gen(G, N2, ic_forms:get_body(X)); -gen(_G, _N, _X) -> - ok. - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: emit_struct_class/4 -%%----------------------------------------------------------------- -emit_struct_class(G, N, X, StructName) -> - {Fd, _}= ic_file:open_java_file(G, N, StructName), - - MList = struct_member_list(G, N, X), - ArgList = gen_parameter_list(G, [ StructName ++ "Package" |N], X, MList), - - ic_codegen:emit(Fd, ["final public class ",StructName," {\n" - " // instance variables\n"]), - - emit_struct_members_declarations(G, [StructName ++ "Package" |N], - X, Fd, MList), - - ic_codegen:emit(Fd, ["\n // constructors\n" - " public ",StructName,"() {}\n\n" - - " public ",StructName,"(",ArgList,") {\n"]), - - emit_struct_members_initialisation(G, N, X, Fd, MList), - - ic_codegen:emit(Fd, [" }\n\n" - - "}\n\n"]), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, _X, StructName) -> - SName = string:concat(StructName, "Holder"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - ic_codegen:emit(Fd, ["final public class ",StructName,"Holder {\n" - - " // instance variables\n" - " public ",StructName," value;\n\n" - - " // constructors\n" - " public ",StructName,"Holder() {}\n\n" - - " public ",StructName,"Holder(",StructName," initial) {\n" - " value = initial;\n" - " }\n\n" - - " // methods\n"]), - - ic_codegen:emit(Fd, [" public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception {\n" - " ",StructName,"Helper.marshal(out, value);\n" - " }\n\n" - - " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" - " value = ",StructName,"Helper.unmarshal(in);\n" - " }\n" - - "}\n\n"]), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_helper_class/5 -%%----------------------------------------------------------------- -emit_helper_class(G, N, X, StructName, WireStructName) -> - SName = string:concat(StructName, "Helper"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - ic_codegen:emit(Fd, ["public class ",StructName,"Helper {\n" - - " // constructors\n" - " private ",StructName,"Helper() {}\n\n" - - " // methods\n"]), - - MList = struct_member_list(G, N, X), - - ic_codegen:emit(Fd, [" public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",StructName," _value)\n" - " throws java.lang.Exception {\n\n"]), - - emit_struct_marshal_function(G, N, X, Fd, StructName, WireStructName, MList), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static ",StructName," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in)\n" - " throws java.lang.Exception {\n\n"]), - - emit_struct_unmarshal_function(G, N, X, Fd, StructName, WireStructName, MList), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static String id() {\n" - " return \"",ictk:get_IR_ID(G, N, X),"\";\n" - " }\n\n" - - " public static String name() {\n" - " return \"",StructName,"\";\n" - " }\n\n"]), - - ic_jbe:emit_type_function(G, N, X, Fd), - - ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",StructName," _this)\n" - " throws java.lang.Exception {\n\n" - - " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" - " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" - - " _any.type(type());\n" - " marshal(_os, _this);\n" - " _any.insert_Streamable(_os);\n" - " }\n\n" - - " public static ",StructName," extract(",?ICPACKAGE,"Any _any)\n" - " throws java.lang.Exception {\n\n" - - " return unmarshal(_any.extract_Streamable());\n" - " }\n\n" - - - %% In corba mapping there is also a _type function here. - "}\n"]), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_struct_members_declarations/ -%%----------------------------------------------------------------- -emit_struct_members_declarations(_, _, _, _, []) -> - ok; -emit_struct_members_declarations(G, N, X, Fd, [{Member, _Type, Id} | MList]) -> - ic_codegen:emit(Fd, [" public ",ic_java_type:getType(G, N, Member)," ",Id,";\n"]), - emit_struct_members_declarations(G, N, X, Fd, MList). - - - -%%----------------------------------------------------------------- -%% Func: emit_struct_members_initialisation/5 -%%----------------------------------------------------------------- -emit_struct_members_initialisation(_, _, _, _, []) -> - ok; -emit_struct_members_initialisation(G, N, X, Fd, [{_Member, _Type, Id} | MList]) -> - ic_codegen:emit(Fd, [" ",Id," = _",Id,";\n"]), - emit_struct_members_initialisation(G, N, X, Fd, MList). - - - - -%%----------------------------------------------------------------- -%% Func: emit_struct_marshal_function/7 -%%----------------------------------------------------------------- -emit_struct_marshal_function(G, N, X, Fd, StructName, WireStructName, MList) -> - - ic_codegen:emit(Fd, [" _out.write_tuple_head(",integer_to_list(length(MList) + 1),");\n" - " _out.write_atom(\"",ic_util:to_undersc([WireStructName|N]),"\");\n\n"]), - - emit_struct_marshal_function_loop(G, [StructName ++ "Package" |N], - X, Fd, MList, 1). - -%%----------------------------------------------------------------- -%% Func: emit_struct_marshal_function_loop/6 -%%----------------------------------------------------------------- -emit_struct_marshal_function_loop(_, _, _, Fd, [], _) -> - ic_codegen:nl(Fd); -emit_struct_marshal_function_loop(G, N, X, Fd, [{Member, Type, Id} |MList], Num) -> - - case ic_java_type:isBasicType(G, N, Member) of - true -> - ic_codegen:emit(Fd, [" _out",ic_java_type:marshalFun(G, N, Member, Type),"(_value.",Id,");\n"]); - _ -> - if (element(1,hd(element(3,Member))) == array) -> - ic_codegen:emit(Fd, - [" ", - ic_util:to_dot(G,[ic_forms:get_id2(Member)|N]), - "Helper.marshal(_out, _value.",Id,");\n"]); - true -> - ic_codegen:emit(Fd, [" ", - ic_java_type:marshalFun(G, N, Member, Type), - "(_out, _value.",Id,");\n"]) - end - end, - - emit_struct_marshal_function_loop(G, N, X, Fd, MList, Num+1). - - - - -%%----------------------------------------------------------------- -%% Func: emit_struct_unmarshal_function/7 -%%----------------------------------------------------------------- -emit_struct_unmarshal_function(G, N, X, Fd, StructName, WireStructName, MList) -> - - ic_codegen:emit(Fd, [" _in.read_tuple_head();\n\n" - - " if ((_in.read_atom()).compareTo(\"", - ic_util:to_undersc([WireStructName|N]), - "\") != 0)\n" - " throw new java.lang.Exception(\"\");\n\n" - - " ",StructName," _value = new ",StructName,"();\n"]), - - emit_struct_unmarshal_function_loop(G, [StructName ++ "Package"|N], - X, Fd, MList, 1), - - ic_codegen:emit(Fd, " return _value;\n"). - -%%----------------------------------------------------------------- -%% Func: emit_union_unmarshal_function_loop/6 -%%----------------------------------------------------------------- -emit_struct_unmarshal_function_loop(_, _, _, Fd, [], _) -> - ic_codegen:nl(Fd); -emit_struct_unmarshal_function_loop(G, N, X, Fd, [{Member, Type, Id} |MList], Num) -> - - case ic_java_type:isBasicType(G, N, Member) of - true -> - ic_codegen:emit(Fd, [" _value.",Id," = _in",ic_java_type:unMarshalFun(G, N, Member, Type),";\n"]); - _ -> - if (element(1,hd(element(3,Member))) == array) -> - ic_codegen:emit(Fd, - [" _value.",Id," = ",ic_util:to_dot(G,[ic_forms:get_id2(Member)|N]),"Helper.unmarshal(_in);\n"]); - true -> - ic_codegen:emit(Fd, - [" _value.",Id," = ",ic_java_type:getUnmarshalType(G, N, Member, Type),".unmarshal(_in);\n"]) - end - end, - - emit_struct_unmarshal_function_loop(G, N, X, Fd, MList, Num +1). - - - -%%----------------------------------------------------------------- -%% Func: gen_parameter_list/4 -%%----------------------------------------------------------------- -gen_parameter_list(G, N, _X, [{Member, _Type, Id}]) -> - ic_java_type:getType(G,N,Member) ++ - " _" ++ - ic_util:to_list(Id); -gen_parameter_list(G, N, X, [{Member, _Type, Id} | MList]) -> - ic_java_type:getType(G,N,Member) ++ - " _" ++ - ic_util:to_list(Id) ++ - ", " ++ - gen_parameter_list(G, N, X, MList). - - -%%----------------------------------------------------------------- -%% Func: struct_member_list/3 -%%----------------------------------------------------------------- -struct_member_list(_G, _N, X) -> - M = lists:map( - fun(Member) -> - lists:map( - fun(Id) -> - Type = ic_forms:get_type(Member), - { Member, Type, ic_forms:get_java_id(Id)} - end, - ic_forms:get_idlist(Member)) - end, - ic_forms:get_body(X)), - lists:flatten(M). - - - diff --git a/lib/ic/src/ic_symtab.erl b/lib/ic/src/ic_symtab.erl deleted file mode 100644 index 037d004049..0000000000 --- a/lib/ic/src/ic_symtab.erl +++ /dev/null @@ -1,235 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_symtab). - - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([new/0, store/3, retrieve/2, soft_retrieve/2, intf_resolv/3]). --export([get_full_scoped_name/3, scoped_id_new_global/1, scoped_id_new/1]). --export([scoped_id_strip/1,symtab_add_faked_included_types/1]). --export([scoped_id_is_global/1, scoped_id_add/2]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - - -%%-------------------------------------------------------------------- -%% -%% Symbol table routines -%% -%% Symbol tables handles mappings Id -> Value, where Id is an -%% ordinary Id from the parser (or a string) and value is an -%% arbitrary term. -%% -%%-------------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: new/0 (used to be symtab_new) -%%----------------------------------------------------------------- -new() -> - ets:new(symtab, [set, public]). - -%%----------------------------------------------------------------- -%% Func: store/3 (used to be symtab_store) -%%----------------------------------------------------------------- -store(G, N, X) -> - Name = [ic_forms:get_id2(X) | N], - %%io:format("Adding id: ~p~n", [N]), - case soft_retrieve(G, Name) of - {error, _} -> - ets:insert(G#genobj.symtab, {Name, X}); - {ok, Y} when is_record(Y, forward) -> - ets:insert(G#genobj.symtab, {Name, X}); - {ok, Y} when is_record(Y, constr_forward) -> - ets:insert(G#genobj.symtab, {Name, X}); - {ok, _Y} -> - ic_error:error(G, {multiply_defined, X}) - end. - - -%%----------------------------------------------------------------- -%% Func: retrieve/2 (used to be symtab_retrieve) -%% -%% Makes a lookup in the symbol table for Id. Will throw -%% not_found if it fails. -%%----------------------------------------------------------------- -retrieve(G, Id) -> - case ets:lookup(G#genobj.symtab, Id) of - [{_, Val}] -> Val; - [] -> ic_error:error(G, {symtab_not_found, Id}) - end. - - -%%----------------------------------------------------------------- -%% Func: soft_retrieve/2 (used to be symtab_soft_retrieve) -%% -%% Same as retrieve but will use tagged return values. -%% -%%----------------------------------------------------------------- -soft_retrieve(G, Id) -> - case ets:lookup(G#genobj.symtab, Id) of - [{_, Val}] -> {ok, Val}; - [] -> {error, {symtab_not_found, Id}} - end. - - -%%----------------------------------------------------------------- -%% Func: intf_resolv/3 and resolv2/3 -%% (used to be symtab_intf_resolv and symtab_intf_resolv2) -%% -%% Tries to resolv the interface identifier reference. The id can -%% be either a scoped name or an standard identifier. The -%% function returns a global reference to the id. -%% -%% Will throw not_found if the id really cannot be found. Will -%% throw illegal_forward if any forward references are founf in -%% the inheritance list. -%% -%%----------------------------------------------------------------- -intf_resolv(G, Scope, Id) -> - case scoped_id_is_global(Id) of - true -> - retrieve(G, Id), - Id; - false -> - intf_resolv2(G, Scope, Id) - end. - -intf_resolv2(G, Scope, Id) -> - N = scoped_id_add(Scope, Id), - case soft_retrieve(G, scoped_id_strip(N)) of - {ok, F} when is_record(F, forward) -> - ic_error:error(G, {illegal_forward, Id}), []; - {ok, _Val} -> - scoped_id_mk_global(N); - _ -> - case scoped_id_is_top(Scope) of - false -> - intf_resolv2(G, scoped_id_up_one(Scope), Id); - true -> - ic_error:error(G, {symtab_not_found, Id}), [] - end - end. - - - -%%-------------------------------------------------------------------- -%% -%% Scoped id routines -%% -%% A scoped id is an id written as M::Id in IDL. Scoped ids are -%% implemented as lists of id in reverse order, so M1::F1 becomes -%% [F1, M1]. -%% -%%-------------------------------------------------------------------- - -get_full_scoped_name(G, N, S) when element(1, S) == scoped_id -> - ictype:scoped_lookup(G, ic_genobj:tktab(G), N, S). - -scoped_id_new_global(Id) -> - X=scoped_id_new(Id), X#scoped_id{type=global}. - -scoped_id_new(Id) -> - #scoped_id{line=ic_forms:get_line(Id), id=[ic_forms:get_id(Id)]}. - -%% Adds one more id to the list of ids -scoped_id_add(S1, S2) when is_record(S2, scoped_id) -> - S1#scoped_id{id=S2#scoped_id.id ++ S1#scoped_id.id, - line=S2#scoped_id.line}; -scoped_id_add(S, Id) -> - S#scoped_id{id=[ic_forms:get_id(Id) | S#scoped_id.id], line=ic_forms:get_line(Id)}. - - -scoped_id_mk_global(S) -> S#scoped_id{type=global}. - -scoped_id_is_global(S) when is_record(S, scoped_id), S#scoped_id.type==global -> - true; -scoped_id_is_global(_) -> false. - -%% Top level scope (i.e no more cd ..) -scoped_id_is_top(S) when S#scoped_id.id==[] -> true; -scoped_id_is_top(_) -> false. - - -scoped_id_up_one(S) -> S#scoped_id{id=tl(S#scoped_id.id)}. % cd .. in scope -%%scoped_id_get_def(S) -> hd(S#scoped_id.id). % Last added id -scoped_id_strip(S) -> S#scoped_id.id. % Strips all junk - - - - -% Add CORBA::<Types> that as if they -% were defined in an included file. -% This is only supported in the case -% of Corba backend -symtab_add_faked_included_types(G) -> - case ic_options:get_opt(G, be) of - false -> - %% Add TypeCode as if it were defiend in included file - ets:insert(G#genobj.symtab, {["CORBA"], - {interface,{'<identifier>',0,"TypeCode"}, - [], - [], - [], - {tk_objref, - "IDL:omg.org/CORBA/TypeCode:1.0", - "TypeCode"}}}); - erl_corba -> - %% Add TypeCode as if it were defiend in included file - ets:insert(G#genobj.symtab, {["CORBA"], - {interface,{'<identifier>',0,"TypeCode"}, - [], - [], - [], - {tk_objref, - "IDL:omg.org/CORBA/TypeCode:1.0", - "TypeCode"}}}); - erl_template -> - %% Add TypeCode as if it were defiend in included file - ets:insert(G#genobj.symtab, {["CORBA"], - {interface,{'<identifier>',0,"TypeCode"}, - [], - [], - [], - {tk_objref, - "IDL:omg.org/CORBA/TypeCode:1.0", - "TypeCode"}}}); - _ -> - ok - end. - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_union_java.erl b/lib/ic/src/ic_union_java.erl deleted file mode 100644 index 14d585b0a4..0000000000 --- a/lib/ic/src/ic_union_java.erl +++ /dev/null @@ -1,755 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% - - --module(ic_union_java). - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: gen/3 -%%----------------------------------------------------------------- -gen(G, N, X) when is_record(X, union) -> - - %% Create a TK value if not existed - %% Should be integrated in fetchTk - %% instead - NewX = case ic_forms:get_tk(X) of - undefined -> - S = ic_genobj:tktab(G), - Tk = ictype:tk(G, S, N, X), - #union{ id = X#union.id, - type = X#union.type, - body = X#union.body, - tk = Tk }; - _Tk -> - X - end, - - UnionName = ic_forms:get_java_id(NewX), - WiredUnionName = ic_forms:get_id2(NewX), - N2 = [UnionName ++ "Package"|N], - %%?PRINTDEBUG2("Recursive call over type ~p", - %% [[ic_forms:get_type(NewX)]]), - ic_jbe:gen(G, N, [ic_forms:get_type(NewX)]), - %%?PRINTDEBUG2("Recursive call over body: ~p", - %% [ic_forms:get_body(NewX)]), - ic_jbe:gen(G, N2, ic_forms:get_body(NewX)), - - emit_union_class(G, N, NewX, UnionName), - emit_holder_class(G, N, NewX, UnionName), - emit_helper_class(G, N, NewX, UnionName, WiredUnionName); -gen(_G, _N, _X) -> - ok. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: emit_union_class/4 -%%----------------------------------------------------------------- -emit_union_class(G, N, X, UnionName) -> - {Fd, _} = ic_file:open_java_file(G, N, UnionName), - - DiscrType = ic_java_type:getType(G, [UnionName ++ "Package"|N], - ic_forms:get_type(X)), - - MList = union_member_list(G, N, X, DiscrType), - - ic_codegen:emit(Fd, "final public class ~s {\n",[UnionName]), - - ic_codegen:emit(Fd, " // instance variables\n", []), - ic_codegen:emit(Fd, " private boolean _initialized;\n", []), - ic_codegen:emit(Fd, " private ~s _discriminator;\n", [DiscrType]), - ic_codegen:emit(Fd, " private java.lang.Object _value;\n", []), - - {tk_union,_, _,DiscrTk, _, _} = ic_forms:get_tk(X), - - DV = get_default_val(G, [UnionName |N], DiscrType, DiscrTk, MList), - - case DV of - none -> %% all values in case - ok; - _ -> - ic_codegen:emit(Fd, " private ~s _default = ~s;\n", - [DiscrType, DV]) - end, - - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, " // constructors\n", []), - - ic_codegen:emit(Fd, " public ~s() {\n", [UnionName]), - ic_codegen:emit(Fd, " _initialized = false;\n", []), - ic_codegen:emit(Fd, " _value = null;\n", []), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // discriminator access\n", []), - - ic_codegen:emit(Fd, " public ~s discriminator() " - "throws java.lang.Exception {\n", [DiscrType]), - ic_codegen:emit(Fd, " if (!_initialized) {\n", []), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n",[]), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:emit(Fd, " return _discriminator;\n", []), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - - emit_union_members_functions(G, [UnionName ++ "Package"|N], X, - Fd, UnionName, DiscrType, MList, MList), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, "}\n", []), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, _X, UnionName) -> - UName = string:concat(UnionName, "Holder"), - {Fd, _} = ic_file:open_java_file(G, N, UName), - - ic_codegen:emit(Fd, "final public class ~sHolder {\n",[UnionName]), - - ic_codegen:emit(Fd, " // instance variables\n"), - ic_codegen:emit(Fd, " public ~s value;\n", [UnionName]), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // constructors\n"), - ic_codegen:emit(Fd, " public ~sHolder() {}\n", [UnionName]), - ic_codegen:emit(Fd, " public ~sHolder(~s initial) {\n", - [UnionName, UnionName]), - ic_codegen:emit(Fd, " value = initial;\n"), - ic_codegen:emit(Fd, " }\n"), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // methods\n"), - - ic_codegen:emit(Fd, " public void _marshal(~sOtpOutputStream out) throws java.lang.Exception {\n", - [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " ~sHelper.marshal(out, value);\n", [UnionName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public void _unmarshal(~sOtpInputStream in) throws java.lang.Exception {\n", - [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " value = ~sHelper.unmarshal(in);\n", [UnionName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n"), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_helper_class/4 -%%----------------------------------------------------------------- -emit_helper_class(G, N, X, UnionName, WiredUnionName) -> - UName = string:concat(UnionName, "Helper"), - {Fd, _} = ic_file:open_java_file(G, N, UName), - - DiscrType = ic_java_type:getType(G, [ UnionName ++ "Package" |N], - ic_forms:get_type(X)), - - ic_codegen:emit(Fd, "public class ~sHelper {\n",[UnionName]), - - ic_codegen:emit(Fd, " // constructors\n", []), - ic_codegen:emit(Fd, " private ~sHelper() {}\n", [UnionName]), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // methods\n", []), - MList = union_member_list(G, N, X, DiscrType), - - ic_codegen:emit(Fd, " public static void marshal(~sOtpOutputStream _out, ~s _value)\n", - [?ERLANGPACKAGE, UnionName]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - emit_union_marshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static ~s unmarshal(~sOtpInputStream _in)\n", - [UnionName, ?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - emit_union_unmarshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static String id() {\n"), - ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, X)]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static String name() {\n"), - ic_codegen:emit(Fd, " return ~p;\n",[UnionName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_jbe:emit_type_function(G, N, X, Fd), - - - ic_codegen:emit(Fd, " public static void insert(~sAny _any, ~s _this)\n", - [?ICPACKAGE,UnionName]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " ~sOtpOutputStream _os = \n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " new ~sOtpOutputStream();\n\n",[?ERLANGPACKAGE]), - - ic_codegen:emit(Fd, " _any.type(type());\n"), - ic_codegen:emit(Fd, " marshal(_os, _this);\n"), - ic_codegen:emit(Fd, " _any.insert_Streamable(_os);\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static ~s extract(~sAny _any)\n", - [UnionName,?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " return unmarshal(_any.extract_Streamable());\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static int discriminatorAsInt(~s _discriminator)\n", - [DiscrType]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - emit_discriminator_as_int(G, N, ic_forms:get_type(X), Fd), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n"), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_union_members_functions/7 -%%----------------------------------------------------------------- -emit_union_members_functions(_, _, _, _, _, _, [], _) -> - ok; -emit_union_members_functions(G, N, X, Fd, UnionName, DiscrType, - [{Label, Case, TypeDef, Id, Ls} | MList], MListTot) -> - - CaseId = Case#case_dcl.id, %% Maybe Array - CaseType = Case#case_dcl.type, %% Maybe Sequence - - Type = if element(1,CaseId) == array -> - ic_java_type:getType(G, N, TypeDef) ++ - ic_java_type:getdim(CaseId#array.size); - true -> - ic_java_type:getType(G, N, TypeDef) - end, - - HolderType = - if element(1,CaseId) == array -> - ic_java_type:getHolderType(G, N, CaseId); - true -> - if element(1,CaseType) == sequence -> - ic_util:to_dot(G,[Id|N]) ++"Holder"; - true -> - ic_java_type:getHolderType(G, N, TypeDef) - end - end, - - %% - %% Set method - %% - ic_codegen:emit(Fd, " // ~s access and set functions\n",[Id]), - ic_codegen:emit(Fd, " public void ~s(~s value) " - "throws java.lang.Exception {\n", - [Id, Type]), - ic_codegen:emit(Fd, " _initialized = true;\n", []), - case Label of - "default" -> - ic_codegen:emit(Fd, " _discriminator = (~s) _default;\n", - [DiscrType]); - _ -> - case ic_java_type:isBasicType(G, N, ic_forms:get_type(X)) of - true -> - ic_codegen:emit(Fd, " _discriminator = (~s) " - "~s;\n", - [DiscrType, Label]); - _ -> - ic_codegen:emit(Fd, " _discriminator = (~s) " - "~s.~s;\n", - [DiscrType, DiscrType, Label]) - end - end, - ic_codegen:emit(Fd, " _value = new ~s(value);\n", - [HolderType]), - ic_codegen:emit(Fd, " }\n", []), - - %% - %% Check this entry has more than one label and the generate an extra set method. - %% - case Ls of - [] -> - ok; - _ -> - ic_codegen:emit(Fd, " public void ~s(~s discriminator, ~s value) " - "throws java.lang.Exception {\n", - [Id, DiscrType, Type]), - ic_codegen:emit(Fd, " _initialized = true;\n", []), - ic_codegen:emit(Fd, " _discriminator = (~s) discriminator;\n", - [DiscrType]), - ic_codegen:emit(Fd, " _value = new ~s(value);\n", - [HolderType]), - ic_codegen:emit(Fd, " }\n", []) - end, - - %% - %% Get method - %% - ic_codegen:emit(Fd, " public ~s ~s() throws java.lang.Exception {\n", - [Type, Id]), - ic_codegen:emit(Fd, " if (!_initialized) {\n", []), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n",[]), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:emit(Fd, " switch (~sHelper.discriminatorAsInt" - "(discriminator())) {\n", - [UnionName]), - if - Label == "default" -> - ic_codegen:emit(Fd, " default:\n", []), - ic_codegen:emit(Fd, " break;\n", []), - emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, - MListTot), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n", []); - true -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, Label)]), - ic_codegen:emit(Fd, " break;\n", []), - ic_codegen:emit(Fd, " default:\n", []), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n", []) - end, - ic_codegen:emit(Fd, " }\n", []), - - ic_codegen:emit(Fd, " return ((~s) _value).value;\n", - [HolderType]), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - emit_union_members_functions(G, N, X, Fd, UnionName, DiscrType, MList, - MListTot). - - -%%----------------------------------------------------------------- -%% Func: emit_default_access_fun_switch_cases/6 -%%----------------------------------------------------------------- -emit_default_access_fun_switch_cases(_G, _N, _X, _Fd, _DiscrType, []) -> - ok; -emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, - [{"default", _, _, _, _} |MList]) -> - emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, MList); -emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, - [{Label, _Case, _TypeDef, _Id, _} | MList]) -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, Label)]), - emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, MList). - - - -%%----------------------------------------------------------------- -%% Func: emit_union_unmarshal_function/5 -%%----------------------------------------------------------------- -emit_union_unmarshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList) -> - DiscrTypeForm = ic_forms:get_type(X), - DiscrType = ic_java_type:getType(G, [UnionName ++ "Package"|N], - DiscrTypeForm), - - ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), - - ic_codegen:emit(Fd, " if ((_in.read_atom()).compareTo(~p) != 0)\n", - [ic_util:to_undersc([WiredUnionName|N])]), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n\n",[]), - - ic_codegen:emit(Fd, " ~s _value = new ~s();\n", [UnionName, UnionName]), - - %% Decode discriminator - case ic_java_type:isBasicType(G, N, DiscrTypeForm) of - true -> - ic_codegen:emit(Fd, " ~s _discriminator = _in~s;\n\n", - [DiscrType, - ic_java_type:unMarshalFun(G, N, X, DiscrTypeForm)]); - _ -> - ic_codegen:emit(Fd, " ~s _discriminator = ~s.unmarshal(_in);\n\n", - [DiscrType,ic_java_type:getUnmarshalType(G, N, X, DiscrTypeForm)]) - end, - - ic_codegen:emit(Fd, " switch (~sHelper.discriminatorAsInt(_discriminator)) {\n", - [UnionName]), - - emit_union_unmarshal_function_loop(G, [UnionName ++ "Package"|N], X, - Fd, DiscrType, MList), - - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " return _value;\n"). - -%%----------------------------------------------------------------- -%% Func: emit_union_unmarshal_function_loop/6 -%%----------------------------------------------------------------- -emit_union_unmarshal_function_loop(_, _, _, _, _, []) -> - ok; -emit_union_unmarshal_function_loop(G, N, X, Fd, DiscrType, - [{Label, Case, Type, Id, Ls} |MList]) -> - case Label of - "default" -> - ic_codegen:emit(Fd, " default:\n"); - _ -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, Label)]) - end, - - gen_multiple_cases(G, N, X, Fd, DiscrType, Ls), - - CaseId = Case#case_dcl.id, %% Maybe Array - CaseType = Case#case_dcl.type, %% Maybe Sequence - - case element(1,CaseId) of - array -> - ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", - [Id, - ic_java_type:getUnmarshalType(G, N, Case, CaseId)]); - - _ -> - case element(1, CaseType) of - sequence -> - ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", - [Id, - ic_java_type:getUnmarshalType(G, N, Case, CaseType)]); - _ -> - case ic_java_type:isBasicType(G, N, CaseType) of - true -> - ic_codegen:emit(Fd, " _value.~s(_in~s);\n", - [Id, - ic_java_type:unMarshalFun(G, N, X, Type)]); - false -> - ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", - [Id, - ic_java_type:getUnmarshalType(G, N, X, Type)]) - end - end - end, - - ic_codegen:emit(Fd, " break;\n", []), - emit_union_unmarshal_function_loop(G, N, X, Fd, DiscrType, MList). - - - - - -%%----------------------------------------------------------------- -%% Func: emit_union_marshal_function/6 -%%----------------------------------------------------------------- -emit_union_marshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList) -> - - DiscrTypeForm = ic_forms:get_type(X), - DiscrType = ic_java_type:getType(G, [UnionName ++ "Package" |N], - DiscrTypeForm), - - ic_codegen:emit(Fd, " _out.write_tuple_head(3);\n"), - ic_codegen:emit(Fd, " _out.write_atom(~p);\n", - [ic_util:to_undersc([WiredUnionName|N])]), - - case ic_java_type:isBasicType(G, N, DiscrTypeForm) of - true -> - ic_codegen:emit(Fd, " _out~s(_value.discriminator());\n\n", - [ic_java_type:marshalFun(G, N, X, DiscrTypeForm)]); - false -> - ic_codegen:emit(Fd, " ~s(_out, _value.discriminator());\n\n", - [ic_java_type:marshalFun(G, N, X, DiscrTypeForm)]) - end, - - ic_codegen:emit(Fd, " switch(~sHelper.discriminatorAsInt(_value.discriminator())) {\n", - [UnionName]), - - emit_union_marshal_function_loop(G, - [ UnionName ++ "Package"|N], - X, - Fd, - DiscrType, - MList), - - ic_codegen:emit(Fd, " }\n\n", []). - - -%%----------------------------------------------------------------- -%% Func: emit_union_marshal_function_loop/ -%%----------------------------------------------------------------- -emit_union_marshal_function_loop(_, _, _, _, _, []) -> - ok; -emit_union_marshal_function_loop(G, N, X, Fd, DiscrType, - [{Label, Case, Type, Id, Ls} |MList]) -> - case Label of - "default" -> - ic_codegen:emit(Fd, " default:\n", - []); - _ -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, Label)]) - end, - - gen_multiple_cases(G, N, X, Fd, DiscrType, Ls), - - - CaseId = Case#case_dcl.id, %% Maybe Array - CaseType = Case#case_dcl.type, %% Maybe Sequence - - case element(1,CaseId) of - array -> - ic_codegen:emit(Fd, " ~s(_out, _value.~s());\n", - [ic_java_type:marshalFun(G, N, Case, CaseId), - Id]); - _ -> - case element(1, CaseType) of - sequence -> - ic_codegen:emit(Fd, " ~s.marshal(_out, _value.~s());\n", - [ic_util:to_dot(G,[Id|N]) ++ "Helper", - Id]); - _ -> - case ic_java_type:isBasicType(G, N, CaseType) of - true -> - ic_codegen:emit(Fd, " _out~s(_value.~s());\n", - [ic_java_type:marshalFun(G, N, X, Type), - Id]); - false -> - ic_codegen:emit(Fd, " ~s(_out, _value.~s());\n", - [ic_java_type:marshalFun(G, N, X, Type), - Id]) - end - end - end, - - ic_codegen:emit(Fd, " break;\n", []), - emit_union_marshal_function_loop(G, N, X, Fd, DiscrType, MList). - - - -gen_multiple_cases(_G, _N, _X, _Fd, _DiscrType, []) -> - ok; -gen_multiple_cases(G, N, X, Fd, DiscrType, [Label |Ls]) -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, getLabel(DiscrType, Label))]), - gen_multiple_cases(G, N, X, Fd, DiscrType, Ls). - - -%%----------------------------------------------------------------- -%% Func: union_member_list/3 -%%----------------------------------------------------------------- -union_member_list(G, N, X, DiscrType) -> - M = lists:map( - fun(Case) -> - {Label, LabelList} = case check_default(ic_forms:get_idlist(Case)) of - {{default, C}, List} -> - {{default, C}, List}; - {L, []} -> - {L, []}; - {_, [L |Ls]} -> - {L, Ls} - end, - - CName = ic_forms:get_java_id(Case), - CId = Case#case_dcl.id, - CType = Case#case_dcl.type, - - if element(1,CId) == array -> - N2 = [ic_forms:get_id2(X) ++ "Package" |N], - ic_array_java:gen(G, N2, Case, CId); - true -> - if element(1,Case#case_dcl.type) == sequence -> - N2 = [ic_forms:get_id2(X) ++ "Package" |N], - ic_sequence_java:gen(G, N2, CType, CName); - true -> - ok - end - end, - - {getLabel(DiscrType, Label), - Case, - ic_forms:get_type(Case), - CName, - LabelList} - end, - ic_forms:get_body(X)), - lists:flatten(M). - -check_default([]) -> - {false, []}; -check_default([{default, X} |Ls]) -> - {{default, X}, Ls}; -check_default([L]) -> - {false, [L]}; -check_default([L |Ls]) -> - {X, Y} = check_default(Ls), - {X, [L | Y]}. - -getLabel(_, {'<integer_literal>', _, N}) -> - N; -getLabel(_, {'<character_literal>', _, N}) -> - "'" ++ N ++ "'"; -getLabel(_, {'<wcharacter_literal>', _, N}) -> - "'" ++ N ++ "'"; -getLabel(_, {'TRUE',_}) -> - "true"; -getLabel(_, {'FALSE',_}) -> - "true"; -getLabel(_, {default, _}) -> - "default"; -getLabel(_DiscrType, X) -> %%DiscrType ++ "." ++ - ic_util:to_dot(ic_forms:get_id(X)). - -get_default_val(G, N, _, tk_short, MList) -> - integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_long, MList) -> - integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_ushort, MList) -> - integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_ulong, MList) -> - integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_char, MList) -> - char_default_val(G, N, $a, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_boolean, MList) -> - boolean_default_val(G, N, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, DiscrType, {tk_enum, _, _, Values}, MList) -> - enum_default_val(G, N, DiscrType, Values, MList). - -integer_default_val(G, N, Num, MList) -> - Num2 = integer_to_list(Num), - case lists:member(Num2, MList) of - true -> - integer_default_val(G, N, Num + 1, MList); - false -> - Num2 - end. - -char_default_val(G, N, CharNum, MList) -> - Str = "'", - CharNum2 = Str ++ [CharNum | Str], - case lists:member(CharNum2, MList) of - true -> - char_default_val(G, N, CharNum + 1, MList); - false -> - CharNum2 - end. - -boolean_default_val(G, N, MList) -> - if - length(MList) > 2 -> - ic_error:error(G, {plain_error_string, - lists:flatten( - io_lib:format("Default value found while all values have label on ~s", - [ic_util:to_colon(N)]))}), - none; - true -> - case MList of - ["true"] -> - "false"; - ["false"] -> - "true"; - ["default","true"] -> - "false"; - ["true","default"] -> - "false"; - ["default","false"] -> - "true"; - ["false","default"] -> - "true"; - _ -> - none - end - end. - - - - -enum_default_val(G, N, DiscrType, Values, Mlist) -> - - VLen = length(Values), - MLen = length(Mlist), - - case MLen > VLen of - true -> - ic_error:error(G, {plain_error_string, - lists:flatten( - io_lib:format("Default value found while all values have label on ~s", - [ic_util:to_colon(N)]))}), - none; - false -> - enum_default_val_loop(G, N, DiscrType, Values, Mlist) - end. - -enum_default_val_loop(_G, _N, _, [], []) -> - none; -enum_default_val_loop(_G, _N, DiscrType, [Value| _], []) -> - DiscrType ++ "." ++ Value; -enum_default_val_loop(G, N, DiscrType, Values, [Case | MList]) when is_tuple(Case) -> - NewValues = lists:delete(element(1,Case), Values), - enum_default_val_loop(G, N, DiscrType, NewValues, MList). - - - -emit_discriminator_as_int(G, N, T, Fd) -> - case ictype:isBoolean(G,N,T) of - true -> - ic_codegen:emit(Fd, " if(_discriminator)\n", []), - ic_codegen:emit(Fd, " return 1;\n", []), - ic_codegen:emit(Fd, " else\n", []), - ic_codegen:emit(Fd, " return 0;\n", []); - false -> - case ictype:isEnum(G, N, T) of - true -> - ic_codegen:emit(Fd, " return _discriminator.value();\n", - []); - false -> - ic_codegen:emit(Fd, " return _discriminator;\n", []) - end - end. - - -get_case_as_int(G, N, T, DiscrJavaTypeName, Label) -> - case ictype:isBoolean(G,N,T) of - true -> - case Label of - "true" -> - "1"; - "false" -> - "0" - end; - false -> - case ictype:isEnum(G, N, T) of - true -> - DiscrJavaTypeName ++ "._" ++ Label; - false -> - "(" ++ DiscrJavaTypeName ++ ") " ++ Label - end - end. - - - diff --git a/lib/ic/src/ic_util.erl b/lib/ic/src/ic_util.erl deleted file mode 100644 index b1263ae63d..0000000000 --- a/lib/ic/src/ic_util.erl +++ /dev/null @@ -1,314 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(ic_util). - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- - --export([mk_align/1, mk_list/1, join/2, chain/2, mk_name/2, - mk_OE_name/2, mk_oe_name/2, mk_var/1]). - --export([to_atom/1, to_colon/1, to_list/1, to_undersc/1, to_dot/1, - to_dot/2]). --export([to_uppercase/1, adjustScopeToJava/2, eval_java/3, eval_c/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%% mk_list produces a nice comma separated string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - -%% Produce a list of items separated by S. -join([E1, E2| Es], S) -> - [E1, S| join([E2| Es], S)]; -join([E], _) -> - [E]; -join([], _) -> - []. - -%% Produce a list of items, each terminated by T. -chain([E| Es], T) -> - [E, T| chain(Es, T)]; -chain([], _) -> - []. - - -%% Shall convert a string to a Erlang variable name (Capitalise) -mk_var( [N | Str] ) when N >= $a, N =< $z -> - [ N+$A-$a | Str ]; -mk_var( [N | Str] ) when N >= $A, N =< $Z -> [N | Str]. - -%% Shall produce a "public" name for name. When we introduce new -%% identifiers in the mapping that must not collide with those from -%% the IDL spec. -%% -%% NOTE: Change name of IFR ID in system exceptions in corba.hrl when -%% prefix is changed here. -%% -mk_name(_Gen, Name) -> lists:flatten(["OE_" | Name]). -mk_OE_name(_Gen, Name) -> lists:flatten(["OE_" | Name]). -mk_oe_name(_Gen, Name) -> lists:flatten(["oe_" | Name]). - -mk_align(String) -> - io_lib:format("OE_ALIGN(~s)",[String]). - -to_atom(A) when is_atom(A) -> A; -to_atom(L) when is_list(L) -> list_to_atom(L). - -to_list(A) when is_list(A) -> A; -to_list(L) when is_atom(L) -> atom_to_list(L); -to_list(X) when is_integer(X) -> integer_to_list(X). - - - -%% Produce a colon (or under score) separated string repr of the name -%% X -%% -to_colon(X) when element(1, X) == scoped_id -> - to_colon2(ic_symtab:scoped_id_strip(X)); -to_colon(L) -> to_colon2(L). - -to_colon2([X]) -> X; -to_colon2([X | Xs]) -> to_colon2(Xs) ++ "::" ++ X; -to_colon2([]) -> "". - - -to_undersc(X) when element(1, X) == scoped_id -> - to_undersc2(ic_symtab:scoped_id_strip(X)); -to_undersc(L) -> to_undersc2(L). - -to_undersc2([X]) -> X; -to_undersc2([X | Xs]) -> to_undersc2(Xs) ++ "_" ++ X; -to_undersc2([]) -> "". - - -%% Z is a single name -to_uppercase(Z) -> - lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; - (X) -> X end, Z). - - -%% -to_dot(X) when element(1, X) == scoped_id -> - to_dotLoop(ic_symtab:scoped_id_strip(X)); -to_dot(L) -> to_dotLoop(L). - -to_dotLoop([X]) -> ic_forms:get_java_id(X); -to_dotLoop([X | Xs]) -> to_dotLoop(Xs) ++ "." ++ ic_forms:get_java_id(X); -to_dotLoop([]) -> "". - - - -%% -to_dot(G,X) when element(1, X) == scoped_id -> - S = ic_genobj:pragmatab(G), - ScopedId = ic_symtab:scoped_id_strip(X), - case isConstScopedId(S, ScopedId) of %% Costants are left as is - true -> - to_dotLoop(ScopedId) ++ addDotValue(S, ScopedId); - false -> - to_dotLoop(S,ScopedId) - end; -to_dot(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - case isConstScopedId(S, ScopedId) of %% Costants are left as is - true -> - to_dotLoop(ScopedId) ++ addDotValue(S, ScopedId); - false -> - to_dotLoop(S,ScopedId) - end. - -addDotValue(S, [_C | Ss]) -> - case isInterfaceScopedId(S, Ss) of - true -> - ""; - false -> - ".value" - end. - -to_dotLoop(S,[X]) -> - case isInterfaceScopedId(S, [X]) of - true -> - ic_forms:get_java_id(X) ++ "Package"; - false -> - ic_forms:get_java_id(X) - end; -to_dotLoop(S,[X | Xs]) -> - case isInterfaceScopedId(S, [X | Xs]) of - true -> - to_dotLoop(S,Xs) ++ "." ++ ic_forms:get_java_id(X) ++ "Package"; - false -> - to_dotLoop(S,Xs) ++ "." ++ ic_forms:get_java_id(X) - end; -to_dotLoop(_S,[]) -> "". - -isInterfaceScopedId(_S,[]) -> - false; -isInterfaceScopedId(S,[X|Xs]) -> - case ets:match(S,{file_data_local,'_','_',interface,Xs,X,'_','_','_'}) of - [] -> - case ets:match(S,{file_data_included,'_','_',interface,Xs,X,'_','_','_'}) of - [] -> - false; - _ -> - true - end; - _ -> - true - end. - -isConstScopedId(_S,[]) -> - false; -isConstScopedId(S,[X|Xs]) -> - case ets:match(S,{file_data_local,'_','_',const,Xs,X,'_','_','_'}) of - [] -> - case ets:match(S,{file_data_included,'_','_',const,Xs,X,'_','_','_'}) of - [] -> - false; - _ -> - true - end; - _ -> - true - end. - - - -%% -adjustScopeToJava(G,X) when element(1, X) == scoped_id -> - S = ic_genobj:pragmatab(G), - ScopedId = ic_symtab:scoped_id_strip(X), - case isConstScopedId(S, ScopedId) of %% Costants are left as is - true -> - ic_forms:get_java_id(ScopedId); - false -> - adjustScopeToJavaLoop(S,ScopedId) - end; -adjustScopeToJava(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - case isConstScopedId(S, ScopedId) of %% Costants are left as is - true -> - ic_forms:get_java_id(ScopedId); - false -> - adjustScopeToJavaLoop(S,ScopedId) - end. - - - -adjustScopeToJavaLoop(_S,[]) -> - []; -adjustScopeToJavaLoop(S,[X | Xs]) -> - case isInterfaceScopedId(S, [X | Xs]) of - true -> - [ic_forms:get_java_id(X) ++ "Package" | adjustScopeToJavaLoop(S,Xs)]; - false -> - [ic_forms:get_java_id(X) | adjustScopeToJavaLoop(S,Xs)] - end. - - -%% -%% Expression evaluator for java -%% -%% Well, this is not an evaluator, it just -%% prints the hole operation, sorry. -%% -eval_java(G,N,Arg) when is_record(Arg, scoped_id) -> - {FSN, _, _, _} = - ic_symtab:get_full_scoped_name(G, N, Arg), - ic_util:to_dot(G,FSN); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<integer_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<character_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wcharacter_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<boolean_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<floating_pt_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<string_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wstring_literal>' -> - element(3,Arg); -eval_java(G,N,{Op,Arg1,Arg2}) -> - "(" ++ eval_java(G,N,Arg1) ++ - ic_forms:get_java_id(Op) ++ - eval_java(G,N,Arg2) ++ ")". - - - -%% -%% Expression evaluator for c -%% -%% Well, this is not an evaluator, it just -%% prints the hole operation, sorry. -%% -eval_c(G,N,Arg) when is_record(Arg, scoped_id) -> - {FSN, _, _, _} = - ic_symtab:get_full_scoped_name(G, N, Arg), - ic_util:to_undersc(FSN); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<integer_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<character_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wcharacter_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<boolean_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<floating_pt_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<string_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wstring_literal>' -> - element(3,Arg); -eval_c(G,N,{Op,Arg1,Arg2}) -> - "(" ++ eval_c(G,N,Arg1) ++ - atom_to_list(Op) ++ - eval_c(G,N,Arg2) ++ ")". - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - - - - - - diff --git a/lib/ic/src/icenum.erl b/lib/ic/src/icenum.erl deleted file mode 100644 index cab68d17fa..0000000000 --- a/lib/ic/src/icenum.erl +++ /dev/null @@ -1,206 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% -%%----------------------------------------------------------------- -%% File: icenum.erl -%% -%% -%%----------------------------------------------------------------- -%% -%% Code generation for enum's. -%%----------------------------------------------------------------- --module(icenum). - --import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). - --include("icforms.hrl"). --include("ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([enum_gen/4]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -enum_gen(G, N, X, c) when is_record(X, enum) -> - emit_c_enum(G, N, X); -enum_gen(_G, _N, _X, _L) -> - ok. - - -emit_c_enum(G, N, X) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - EnumName = [ic_forms:get_id2(X) | N], - - case ic_pragma:is_local(G,EnumName) of - true -> - - Fd = ic_genobj:hrlfiled(G), - EnumNameStr = ic_util:to_undersc(EnumName), - ic_code:insert_typedef(G, EnumNameStr, {enum, EnumNameStr}), - {tk_enum,_,_,EList} = ic_forms:get_tk(X), - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(EnumNameStr)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(EnumNameStr)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Enum definition: ~s", - [EnumNameStr])], - c), - emit(Fd, "typedef CORBA_enum {", []), - emit_c_enum_values(G, N, Fd, EList), - emit(Fd, "} ~s ;\n\n", [EnumNameStr]), - create_c_enum_file(G, N, EnumNameStr, EList), - emit(Fd, "\n#endif\n\n"); - - false -> %% Do not generate included types att all. - ok - end; - - false -> - ok - end. - - -emit_c_enum_values(_G, N, Fd, [E]) -> - emit(Fd, "~s", [ic_util:to_undersc([E| N])]); -emit_c_enum_values(G, N, Fd, [E |Es]) -> - emit(Fd, "~s, ", [ic_util:to_undersc([E| N])]), - emit_c_enum_values(G, N, Fd, Es). - - -open_c_coding_file(G, Name) -> - SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), - FName = - ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), - case file:open(FName, [write]) of - {ok, Fd} -> - {Fd, SName}; - Other -> - exit(Other) - end. - - -create_c_enum_file(G, N, Name, Elist) -> - - {Fd , SName} = open_c_coding_file(G, Name), - HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - HrlFName = filename:basename(ic_genobj:include_file(G)), - ic_codegen:emit_stub_head(G, Fd, SName, c), - emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile - %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - %% HrlFName = filename:basename(ic_genobj:include_file(G)), - %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - emit(Fd, "char* ~s[~p] = {\n", [ic_util:mk_oe_name(G, Name), - length(Elist)]), - emit_c_enum_array_values(Fd, Elist), - emit(Fd, "};\n\n",[]), - emit_sizecount(G, N, Fd, HFd, Name, Elist), - emit_encode(G, N, Fd, HFd, Name, Elist), - emit_decode(G, N, Fd, HFd, Name, Elist), - file:close(Fd). - -emit_c_enum_array_values(Fd, [E]) -> - emit(Fd, " ~p\n", [E]); -emit_c_enum_array_values(Fd, [E |Es]) -> - emit(Fd, " ~p,\n", [E]), - emit_c_enum_array_values(Fd, Es). - - -emit_sizecount(G, _N, Fd, HFd, Name, _Elist) -> - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", - [ic_util:mk_oe_name(G, "sizecalc_"), Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, int* oe_size)\n" - "{\n", - [ic_util:mk_oe_name(G, "sizecalc_"), Name]), - emit(Fd, " int oe_error_code = 0;\n\n",[]), - - AlignName = lists:concat(["*oe_size + sizeof(",Name,")"]), - emit(Fd, " *oe_size = ~s;\n\n",[ic_util:mk_align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n\n",[]). - - -emit_encode(G, _N, Fd, HFd, Name, _Elist) -> - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n", - [ic_util:mk_oe_name(G, "encode_"), Name, Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n", - [ic_util:mk_oe_name(G, "encode_"), Name, Name]), - emit(Fd, " int oe_error_code = 0;\n\n",[]), - - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, ~s[oe_rec])) < 0) {\n", - [ic_util:mk_oe_name(G, Name)]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n\n",[]). - -emit_decode(G, _N, Fd, HFd, Name, Elist) -> - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n", - [ic_util:mk_oe_name(G, "decode_"), Name, Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, int* oe_outindex, " - "~s *oe_out) {\n\n", - [ic_util:mk_oe_name(G, "decode_"), Name, Name]), - emit(Fd, " int oe_error_code = 0;\n",[]), - emit(Fd, " int oe_i;\n",[]), - emit(Fd, " char oe_atom[256];\n\n",[]), - - AlignName = lists:concat(["*oe_outindex + sizeof(",Name,")"]), - emit(Fd, " *oe_outindex = ~s;\n\n",[ic_util:mk_align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_atom)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - Len = length(Elist), - emit(Fd, " for(oe_i = 0; oe_i < ~p && strcmp(oe_atom, ~s[oe_i]); oe_i++);\n", - [Len, ic_util:mk_oe_name(G, Name)]), - emit(Fd, " *oe_out = oe_i;\n\n", []), - - emit(Fd, " if (oe_i == ~p) {\n",[Len]), - emit_c_enc_rpt(Fd, " ", "decode atom failure", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " return 0;\n",[]), - emit(Fd, "}\n\n",[]). - - - - - diff --git a/lib/ic/src/iceval.erl b/lib/ic/src/iceval.erl deleted file mode 100644 index a93e60124c..0000000000 --- a/lib/ic/src/iceval.erl +++ /dev/null @@ -1,556 +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% -%% -%% --module(iceval). - --include("icforms.hrl"). - --export([eval_const/5, eval_e/5]). - --export([check_tk/3, get_val/1, mk_val/1]). - --define(get_max(__X, __Y), if __X > __Y -> __X; true -> __Y end). --define(get_min(__X, __Y), if __X > __Y -> __Y; true -> __X end). - --define(BASE, 100000000000000000000000000000000). --define(FIXED_MAX, 9999999999999999999999999999999). - -%% Called fr: ictype 99, 522, 533 -%% Fixed constants can be declared as: -%% (1) const fixed pi = 3.14D; or -%% (2) typedef fixed<3,2> f32; -%% const f32 pi = 3.14D; -%% Hence, if fixed is declared as (1) we must handle it especially. -eval_const(G, S, N, tk_fixed, Expr) -> - case catch eval_e(G, S, N, tk_fixed, Expr) of - T when element(1, T) == error -> 0; - V when is_record(V, fixed) -> - {ok, {tk_fixed, V#fixed.digits, V#fixed.scale}, V}; - V -> - ic_error:error(G, {bad_tk_match, Expr, tk_fixed, get_val(V)}) - end; -eval_const(G, S, N, TK, Expr) -> - case catch eval_e(G, S, N, TK, Expr) of - T when element(1, T) == error -> 0; - V -> - case check_tk(G, TK, V) of - true -> ok; - false -> - ic_error:error(G, {bad_tk_match, Expr, TK, get_val(V)}) - end, - get_val(V) - end. - - -check_op(G, S, N, Tk, Types, Op, E1, E2) -> - V1 = eval_e(G, S, N, Tk, E1), - V2 = eval_e(G, S, N, Tk, E2), - check_types(G, Op, E1, Types, V1), - check_types(G, Op, E2, Types, V2), - case check_comb(V1, V2) of - true -> - {V1, V2}; - false -> - Err = {bad_type_combination, E1, get_val(V1), get_val(V2)}, - ic_error:error(G, Err), - throw({error, Err}) - end. - -check_op(G, S, N, Tk, Types, Op, E1) -> - V1 = eval_e(G, S, N, Tk, E1), - check_types(G, Op, E1, Types, V1), - V1. - -%% Match the declared type TK against the factual value of an constant -%% -check_tk(_G, _Any, default) -> true; % Default case in union -check_tk(_G, positive_int, V) when is_integer(V) andalso V >= 0 -> true; -check_tk(_G, tk_long, V) when is_integer(V) -> true; -check_tk(_G, tk_longlong, V) when is_integer(V) -> true; %% LLON_G -check_tk(_G, tk_short, V) when is_integer(V) -> true; -check_tk(_G, tk_ushort, V) when is_integer(V) andalso V >= 0 -> true; -check_tk(_G, tk_ulong, V) when is_integer(V) andalso V >= 0 -> true; -check_tk(_G, tk_ulonglong, V) when is_integer(V) andalso V >= 0 -> true; %% ULLON_G -check_tk(_G, tk_float, V) when is_float(V) -> true; -check_tk(_G, tk_double, V) when is_float(V) -> true; -check_tk(_G, tk_boolean, V) -> is_bool(V); -check_tk(_G, tk_char, {char, _V}) -> true; -check_tk(_G, tk_wchar, {wchar, _V}) -> true; %% WCHAR -check_tk(_G, {tk_string, _Len}, {string, _V}) -> true; -check_tk(_G, {tk_wstring, _Len}, {wstring, _V}) -> true; %% WSTRING -check_tk(_G, {tk_fixed, Digits, Scale}, {fixed, Digits, Scale, _V}) -> true; -check_tk(_G, tk_octet, V) when is_integer(V) -> true; -%%check_tk(_G, tk_null, V) when integer(V) -> true; -%%check_tk(_G, tk_void, V) when integer(V) -> true; -%%check_tk(_G, tk_any, V) when integer(V) -> true; -%%check_tk(_G, {tk_objref, "", "Object"}, V) when integer(V) -> true. -check_tk(_G, {tk_enum, _, _, Body}, {enum_id, Id}) -> - until(fun(X) when X == Id -> true; - (_X) -> - false - end, Body); -check_tk(_G, _TK, _V) -> - false. - -get_val({string, X}) -> X; -get_val({wstring, X}) -> X; %% WCHAR -get_val({char, X}) -> X; -get_val({wchar, X}) -> X; %% WSTRING -get_val({enum_id, X}) -> X; -get_val(X) -> X. - -check_types(G, Op, Expr, TypeList, V) -> - case until(fun(int) when is_integer(V) -> true; - (float) when is_float(V) -> true; - (bool) when V==true -> true; - (bool) when V==false -> true; - (fixed) when is_record(V, fixed) -> true; - (_) -> false end, - TypeList) of - true -> true; - false -> - Err = {bad_type, Expr, Op, TypeList, V}, - ic_error:error(G, Err), - throw({error, Err}) - end. - -%%get_op(T) when tuple(T) -> element(1, T). - -%% Should be in lists -until(F, [H|T]) -> - case F(H) of - true -> true; - false -> until(F, T) - end; -until(_F, []) -> false. - -%% Section of all the boolean operators (because Erlang ops don't like -%% boolean values. -e_or(X, Y) when is_integer(X) andalso is_integer(Y) -> X bor Y; -e_or(true, _) -> true; -e_or(_, true) -> true; -e_or(_, _) -> false. - -e_and(X, Y) when is_integer(X) andalso is_integer(Y) -> X band Y; -e_and(true, true) -> true; -e_and(_, _) -> false. - -e_xor(X, Y) when is_integer(X) andalso is_integer(Y) -> X bxor Y; -e_xor(X, X) -> false; -e_xor(_, _) -> true. - -%% Handling infix operators (+,-,*,/) for fixed type. -%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)> -e_fixed_add(#fixed{digits = D1, scale = S1, value = V1}, - #fixed{digits = D2, scale = S2, value = V2}) -> - Scale = ?get_max(S1, S2), - Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1, - %% We must normalize the values before adding. Why? - %% 4.23 and 5.2 are represented as 423 and 52. To be able to get the - %% correct result we must add 4230 and 5200 == 9430. - {PV1, PV2} = normalize(S1, V1, S2, V2), - check_fixed_overflow(#fixed{digits = Digits, - scale = Scale, - value = (PV1 + PV2)}). - -%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)> -e_fixed_sub(#fixed{digits = D1, scale = S1, value = V1}, - #fixed{digits = D2, scale = S2, value = V2}) -> - Scale = ?get_max(S1, S2), - Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1, - {PV1, PV2} = normalize(S1, V1, S2, V2), - check_fixed_overflow(#fixed{digits = Digits, - scale = Scale, - value = (PV1 - PV2)}). - -%% Boundries determined as fixed<d1+d2, s1+s2> -e_fixed_mul(#fixed{digits = D1, scale = S1, value = V1}, - #fixed{digits = D2, scale = S2, value = V2}) -> - check_fixed_overflow(#fixed{digits = (D1+D2), - scale = (S1+S2), - value = V1*V2}). - -%% Boundries determined as fixed<(d1-s1+s2) + s inf ,s inf> -e_fixed_div(#fixed{digits = D1, scale = S1, value = V1}, - #fixed{digits = _D2, scale = S2, value = V2}) -> - {PV1, PV2} = normalize(S1, V1, S2, V2), - DigitsMin = (D1-S1+S2), - R1 = (PV1 div PV2), - R2 = (R1*?BASE + (PV1 rem PV2) * (?BASE div PV2)), - {Result2, Sinf} = delete_zeros_value(R2, 0, R1), - check_fixed_overflow(#fixed{digits = DigitsMin + Sinf, scale = Sinf, - value = Result2}). - - -%% Checks combination of argument types, basically floats and ints are -%% interchangeable, and all types are allowed with themselves. No -%% other combinations are allowed -%% -check_comb(X, Y) when is_integer(X) andalso is_integer(Y) -> true; -check_comb(X, Y) when is_float(X) andalso is_integer(Y) -> true; -check_comb(X, Y) when is_integer(X) andalso is_float(Y) -> true; -check_comb(X, Y) when is_float(X) andalso is_float(Y) -> true; -check_comb({X, _}, {X, _}) -> true; % Strings and chars are tuples -check_comb({fixed, _, _, _}, {fixed, _, _, _}) -> true; -check_comb(X, Y) -> - case {is_bool(X), is_bool(Y)} of - {true, true} -> - true; - _ -> - false - end. - -is_bool(true) -> true; -is_bool(false) -> true; -is_bool(_) -> false. - - -%%%% (15) -eval_e(G, S, N, Tk, {'or', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'or', T1, T2), - e_or(E1, E2); - -%%%% (16) -eval_e(G, S, N, Tk, {'xor', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'xor', T1, T2), - e_xor(E1, E2); - -%%%% (17) -eval_e(G, S, N, Tk, {'and', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'and', T1, T2), - e_and(E1, E2); - -%%%% (18) -eval_e(G, S, N, Tk, {'rshift', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int], 'rshift', T1, T2), - E1 bsr E2; -eval_e(G, S, N, Tk, {'lshift', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int], 'lshift', T1, T2), - E1 bsl E2; - -%%%% (19) -eval_e(G, S, N, Tk, {'+', T1, T2}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '+', T1, T2) of - {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> - e_fixed_add(F1, F2); - {E1, E2} -> - E1 + E2 - end; -eval_e(G, S, N, Tk, {'-', T1, T2}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '-', T1, T2) of - {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> - e_fixed_sub(F1, F2); - {E1, E2} -> - E1 - E2 - end; - -%%%% (20) -eval_e(G, S, N, Tk, {'*', T1, T2}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '*', T1, T2) of - {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> - e_fixed_mul(F1, F2); - {E1, E2} -> - E1 * E2 - end; -eval_e(G, S, N, Tk, {'/', T1, T2}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '/', T1, T2) of - {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> - e_fixed_div(F1, F2); - {E1, E2} -> - E1 / E2 - end; -eval_e(G, S, N, Tk, {'%', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int], '%', T1, T2), - E1 rem E2; - -%%%% (21) -eval_e(G, S, N, Tk, {{'-', _Line}, T}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '-', T) of - F when is_record(F,fixed) -> - F#fixed{value = -(F#fixed.value)}; - Number -> - -Number - end; -eval_e(G, S, N, Tk, {{'+', _Line}, T}) -> - check_op(G, S, N, Tk, [int, float, fixed], '+', T); -eval_e(G, S, N, Tk, {{'~', Line}, T}) -> - ic_error:error(G, {unsupported_op, {'~', Line}}), - eval_e(G, S, N, Tk, T); - - -%% Ints are repr. by an Erlang integer val, floats and doubles by -%% Erlang floats, chars and strings must be tuplerized for type -%% checking. These tuples are removed just before returning from top -%% function. -%% -eval_e(_G, _S, _N, tk_fixed, {'<fixed_pt_literal>', _Line, X}) -> - create_fixed(X); -eval_e(G, _S, _N, {tk_fixed, Digits, Scale}, {'<fixed_pt_literal>', Line, X}) - when Digits < 32, Digits >= Scale -> - case convert_fixed(X, [], Digits, Digits-Scale) of - {error, Format, Args} -> - ic_error:error(G, {bad_fixed, Format, Args, Line}); - FixedData -> - {fixed, Digits, Scale, FixedData} - end; -eval_e(_G, _S, _N, _Tk, {'<integer_literal>', _Line, X}) -> list_to_integer(X); -eval_e(_G, _S, _N, {tk_string,_}, {'<string_literal>', _Line, X}) -> {string, X}; -eval_e(_G, _S, _N, {tk_wstring,_}, {'<wstring_literal>', _Line, X}) -> {wstring, X}; %% WSTRING -eval_e(_G, _S, _N, tk_char, {'<character_literal>', _Line, X}) -> {char, hd(X)}; -eval_e(_G, _S, _N, tk_wchar, {'<wcharacter_literal>', _Line, X}) -> {wchar, hd(X)}; %% WCHAR -eval_e(_G, _S, _N, _Tk, {'TRUE', _Line}) -> true; -eval_e(_G, _S, _N, _Tk, {'FALSE', _Line}) -> false; -eval_e(_G, _S, _N, _Tk, {'<floating_pt_literal>', _Line, X}) -> to_float(X); -%% Some possible error conditions -eval_e(_G, _S, _N, _Tk, {'<character_literal>', _Line, X}) -> {char, hd(X)}; %% ERROR? -%% -eval_e(G, S, N, _Tk, X) when element(1, X) == scoped_id -> - mk_val(ictype:scoped_lookup(G, S, N, X)); -eval_e(_G, _S, _N, _Tk, {default, _}) -> default; % Default case in union -eval_e(G, _S, _N, Tk, Val) -> - ic_error:error(G, {plain_error_string, Val, - io_lib:format("value and declared type ~p differ", [Tk])}). - -%% A fixed type can be 123.45 or 123 but we represent it as integers (i.e. 12345 or 123). -convert_fixed([], Acc, 0, _) -> - list_to_integer(lists:reverse(Acc)); -convert_fixed([], _Acc, _, _) -> - {error, "Fixed type do not match the digits field", []}; -convert_fixed([$.|Rest], Acc, Digits, 0) -> - convert_fixed(Rest, Acc, Digits, -1); -convert_fixed([$.|_Rest], _Acc, _, _) -> - {error, "Fixed decimal point placed incorrectly", []}; -convert_fixed([X|Rest], Acc, Digits, Position) -> - convert_fixed(Rest, [X|Acc], Digits-1, Position-1). - - -create_fixed([$0|Rest]) -> - %% Leading zeros shall be ignored. - create_fixed(Rest); -create_fixed(Fixed) -> - create_fixed(Fixed, [], 0, 0, false). - -create_fixed([], Acc, Total, Frac, true) -> - {Fixed, N} = remove_trailing_zeros(Acc, 0), - Digits = Total-N, - Scale = Frac-N, - #fixed{digits = Digits, scale = Scale, value = list_to_integer(Fixed)}; -create_fixed([], Acc, Total, _Frac, false) -> - %% A '.' never found. Hence, must be 2000D - #fixed{digits = Total, scale = 0, value = list_to_integer(lists:reverse(Acc))}; -create_fixed([$.|Rest], Acc, Total, _, _) -> - create_fixed(Rest, Acc, Total, 0, true); -create_fixed([X|Rest], Acc, Total, Frac, FoundDot) -> - create_fixed(Rest, [X|Acc], Total+1, Frac+1, FoundDot). - -remove_trailing_zeros([$0|Rest], N) -> - remove_trailing_zeros(Rest, N+1); -remove_trailing_zeros(Fixed, N) -> - {lists:reverse(Fixed), N}. - -%% Make the newly looked up value a value that can be type checked. -mk_val({_, _, {tk_string, _}, V}) -> {string, V}; -mk_val({_, _, {tk_wstring, _}, V}) -> {wstring, V}; %% WSTRING -mk_val({_, _, tk_char, V}) -> {char, V}; -mk_val({_, _, tk_wchar, V}) -> {wchar, V}; %% WCHAR -mk_val({_, _, enum_val, V}) -> - {enum_id, ic_forms:get_id2(V)}; -mk_val(X) when element(1, X) == error -> X; -mk_val({_, _, _TK, V}) -> - V; -mk_val(V) -> V. - - - -%% Floating point numbers -%% -%% Conversion to Erlang floating points is neccessary because -%% list_to_float BIF differs from IDL floats. "1e2" ".4e2" is -%% allowed in IDL and must be translated to "1.0e2" and "0.4e2" - -to_float(X) -> - list_to_float(erlangify(X)). - -erlangify([$. | R]) -> - [$0, $. | R]; -erlangify(R) -> - look_for_dot(R). - -look_for_dot([$. | R]) -> [$. | dot_pending(R)]; -look_for_dot([$e | R]) -> [$., $0, $e | R]; -look_for_dot([$E | R]) -> [$., $0, $E | R]; -look_for_dot([X | R]) -> [X | look_for_dot(R)]. - -dot_pending([$e | R]) -> [$0, $e | R]; -dot_pending([$E | R]) -> [$0, $E | R]; -dot_pending([]) -> [$0]; -dot_pending(R) -> R. - - -%%------------------------------------------------------------------ -%%--------------- Fixed Datatype Helper Functions ------------------ -%%------------------------------------------------------------------ -%% Pretty?! No, but since we now the upper-limit this is the fastest way -%% to calculate 10^x -power(0) -> 1; -power(1) -> 10; -power(2) -> 100; -power(3) -> 1000; -power(4) -> 10000; -power(5) -> 100000; -power(6) -> 1000000; -power(7) -> 10000000; -power(8) -> 100000000; -power(9) -> 1000000000; -power(10) -> 10000000000; -power(11) -> 100000000000; -power(12) -> 1000000000000; -power(13) -> 10000000000000; -power(14) -> 100000000000000; -power(15) -> 1000000000000000; -power(16) -> 10000000000000000; -power(17) -> 100000000000000000; -power(18) -> 1000000000000000000; -power(19) -> 10000000000000000000; -power(20) -> 100000000000000000000; -power(21) -> 1000000000000000000000; -power(22) -> 10000000000000000000000; -power(23) -> 100000000000000000000000; -power(24) -> 1000000000000000000000000; -power(25) -> 10000000000000000000000000; -power(26) -> 100000000000000000000000000; -power(27) -> 1000000000000000000000000000; -power(28) -> 10000000000000000000000000000; -power(29) -> 100000000000000000000000000000; -power(30) -> 1000000000000000000000000000000; -power(31) -> 10000000000000000000000000000000; -power(_) -> 10000000000000000000000000000000. - - - -%% If the result of an operation (+, -, * or /) causes overflow we use this -%% operation. However, since these calculations are performed during compiletime, -%% shouldn't the IDL-specification be changed to not cause overflow?! But, since -%% the OMG standard allows this we must support it. -check_fixed_overflow(#fixed{digits = Digits, scale = Scale, value = Value}) -> - case count_digits(abs(Value)) of - overflow -> - {N, NewVal} = cut_overflow(0, Value), -% NewDigits = Digits - N, - if - N > Scale -> - #fixed{digits = 31, scale = 0, value = NewVal}; - true -> - NewScale = Scale - N, - {NewVal2, Removed} = delete_zeros(NewVal, NewScale), - #fixed{digits = 31, scale = NewScale-Removed, value = NewVal2} - end; - Count when Count > Digits -> - Diff = Count-Digits, - if - Diff > Scale -> - #fixed{digits = Digits, scale = 0, - value = (Value div power(Diff))}; - true -> - NewScale = Scale-Diff, - {NewVal, Removed} = delete_zeros((Value div power(Diff)), NewScale), - #fixed{digits = Digits-Removed, - scale = NewScale-Removed, - value = NewVal} - end; - Count -> - {NewVal, Removed} = delete_zeros(Value, Scale), - #fixed{digits = Count-Removed, scale = Scale-Removed, value = NewVal} - end. - -%% This function see to that the values are of the same baase. -normalize(S, V1, S, V2) -> - {V1, V2}; -normalize(S1, V1, S2, V2) when S1 > S2 -> - {V1, V2*power(S1-S2)}; -normalize(S1, V1, S2, V2) -> - {V1*power(S2-S1), V2}. - -%% If we have access to the integer part of the fixed type we use this -%% operation to remove all trailing zeros. If we know the scale, length of -%% fraction part, we can use delete_zeros as well. But, after a division -%% it's hard to know the scale and we don't need to calcluate the integer part. -delete_zeros_value(0, N, _) -> - {0, 32-N}; -delete_zeros_value(X, N, M) when X > M, (X rem 10) == 0 -> - delete_zeros_value((X div 10), N+1, M); -delete_zeros_value(X, N, _) -> - {X, 32-N}. - -%% If we know the exact scale of a fixed type we can use this operation to -%% remove all trailing zeros. -delete_zeros(0, _) -> - {0,0}; -delete_zeros(X, Max) -> - delete_zeros(X, 0, Max). -delete_zeros(X, Max, Max) -> - {X, Max}; -delete_zeros(X, N, Max) when (X rem 10) == 0 -> - delete_zeros((X div 10), N+1, Max); -delete_zeros(X, N, _) -> - {X, N}. - -cut_overflow(N, X) when X > ?FIXED_MAX -> - cut_overflow(N+1, (X div 10)); -cut_overflow(N, X) -> - {N, X}. - -%% A fast way to check the size of a fixed data type. -count_digits(X) when X > ?FIXED_MAX -> overflow; -count_digits(X) when X >= 1000000000000000000000000000000 -> 31; -count_digits(X) when X >= 100000000000000000000000000000 -> 30; -count_digits(X) when X >= 10000000000000000000000000000 -> 29; -count_digits(X) when X >= 1000000000000000000000000000 -> 28; -count_digits(X) when X >= 100000000000000000000000000 -> 27; -count_digits(X) when X >= 10000000000000000000000000 -> 26; -count_digits(X) when X >= 1000000000000000000000000 -> 25; -count_digits(X) when X >= 100000000000000000000000 -> 24; -count_digits(X) when X >= 10000000000000000000000 -> 23; -count_digits(X) when X >= 1000000000000000000000 -> 22; -count_digits(X) when X >= 100000000000000000000 -> 21; -count_digits(X) when X >= 10000000000000000000 -> 20; -count_digits(X) when X >= 1000000000000000000 -> 19; -count_digits(X) when X >= 100000000000000000 -> 18; -count_digits(X) when X >= 10000000000000000 -> 17; -count_digits(X) when X >= 1000000000000000 -> 16; -count_digits(X) when X >= 100000000000000 -> 15; -count_digits(X) when X >= 10000000000000 -> 14; -count_digits(X) when X >= 1000000000000 -> 13; -count_digits(X) when X >= 100000000000 -> 12; -count_digits(X) when X >= 10000000000 -> 11; -count_digits(X) when X >= 1000000000 -> 10; -count_digits(X) when X >= 100000000 -> 9; -count_digits(X) when X >= 10000000 -> 8; -count_digits(X) when X >= 1000000 -> 7; -count_digits(X) when X >= 100000 -> 6; -count_digits(X) when X >= 10000 -> 5; -count_digits(X) when X >= 1000 -> 4; -count_digits(X) when X >= 100 -> 3; -count_digits(X) when X >= 10 -> 2; -count_digits(_X) -> 1. - -%%------------------------------------------------------------------ -%%--------------- END Fixed Datatype Helper Functions -------------- -%%------------------------------------------------------------------ diff --git a/lib/ic/src/icforms.hrl b/lib/ic/src/icforms.hrl deleted file mode 100644 index f71aee3664..0000000000 --- a/lib/ic/src/icforms.hrl +++ /dev/null @@ -1,70 +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% -%% -%% -%% -%% Module documentation: -%% --------------------- -%% -%% Header file for the Erlang IDL compiler. Contains all records -%% used in the parse tree -%% -%% -%%------------------------------------------------------------ - - - -%%------------------------------------------------------------ - --record(module, {id, body}). --record(interface, {id, inherit, body, inherit_body, tk}). --record(forward, {id, tk}). --record(constr_forward, {id, tk}). --record(const, {type, id, val, tk}). --record(type_dcl, {type, tk}). --record(typedef, {type, id, tk}). --record(struct, {id, body, tk}). --record(member, {type, id}). --record(union, {id, type, body, tk}). --record(case_dcl, {label, id, type}). --record(enum, {id, body, tk}). --record(enumerator, {id}). --record(sequence, {type, length=0}). --record(string, {length=0}). --record(wstring, {length=0}). %% WSTRING --record(array, {id, size}). --record(attr, {readonly, type, id, tk}). --record(except, {id, body, tk}). --record(op, {oneway, type, id, params, raises, ctx, tk}). --record(param, {inout, type, id, tk}). --record(fixed, {digits, scale, value}). - -%% NON-STANDARD --record(preproc, {cat, id, aux}). --record(pragma, {type, to, apply}). - - - - - - - - - - diff --git a/lib/ic/src/icparse.yrl b/lib/ic/src/icparse.yrl deleted file mode 100644 index 27e949729c..0000000000 --- a/lib/ic/src/icparse.yrl +++ /dev/null @@ -1,872 +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% -%% -%%------------------------------------------------------------ -%% Yecc spec for IDL -%% -%% -%% -%% Implementation Detail: -%% OorM_ means OneORMany and is used instead of -%% the "+" BNF notation -%% ZorM_ means ZeroORMany and is used instead of -%% the "*" BNF notation -%% -%% All the reverse/1 calls are because yecc+lists naturally leads -%% to reversed lists, which then have to be reversed. Maybe fix -%% this? -%% -%% Implementation history -%% -%% The IDL language supported is not the complete IDL. We skipped -%% the multiple declarator syntax allowed (i.e. typedef long T1, -%% T2). This also applies to attributes members in structs, -%% unions and exceptions, and to case labels in unions. The cases -%% where IDL has been altered is marked with comments containing -%% NIY. -%% -%% Above is chaging. Whenever we change a clause, we put (FIXED) in -%% its comment. -%% -%%------------------------------------------------------------ - - - - - -Nonterminals - '<op_type_spec>' - '<enumerator>' - '<switch_body>' - 'OorM_<case>' - '<member_list>' - '<struct_type>' - '<unsigned_int>' - '<constr_type_spec>' - '<shift_expr>' - '<or_expr>' - '<inheritance_spec>' - 'ZorM_<param_dcl>' - 'Opt_<context_expr>' - '<attr_dcl>' - '<array_declarator>' - '<element_spec>' - '<signed_int>' - '<primary_expr>' - '<interface_dcl>' - 'ZorM_<string_literal>' - 'Opt_<raises_expr>' - '<integer_type>' - '<signed_long_int>' - '<literal>' - '<export>' - '<forward_dcl>' - 'OorM_<definition>' - '<base_type_spec>' - '<op_dcl>' - '<const_exp>' - '<case>' - '<any_type>' - '<signed_short_int>' - '<unary_expr>' - '<context_expr>' - 'ZorM_<scoped_name>' - '<switch_type_spec>' - '<complex_declarator>' - '<declarators>' - 'OorM_<member>' - '<interface>' - '<parameter_dcls>' - '<op_attribute>' - '<positive_int_const>' - 'OorM_<fixed_array_size>' - '<sequence_type>' - '<case_label>' - '<octet_type>' - '<type_dcl>' - '<module>' - '<specification>' - '<declarator>' - '<boolean_type>' - '<union_type>' - '<add_expr>' - '<interface_body>' - '<except_dcl>' - '<fixed_array_size>' - '<unsigned_short_int>' - '<boolean_literal>' - '<and_expr>' - 'Opt_<inheritance_spec>' - '<scoped_name>' - '<param_type_spec>' - 'ZorM_<member>' - '<char_type>' - '<const_dcl>' - '<param_dcl>' - 'ZorM_<simple_declarator>' - 'ZorM_<declarator>' - '<const_type>' - '<definition>' - '<param_attribute>' - '<simple_declarator>' - 'Opt_readonly' - '<simple_type_spec>' - '<enum_type>' - '<type_spec>' - 'OorM_<case_label>' - '<floating_pt_type>' - '<template_type_spec>' - '<mult_expr>' - '<xor_expr>' - '<string_type>' - '<raises_expr>' - 'Opt_<op_attribute>' - 'ZorM_<enumerator>' - '<member>' - '<unsigned_long_int>' - '<type_declarator>' - '<unary_operator>' - 'ZorM_<export>' - '<interface_header>' - 'OE_preproc' % NON standard - 'OE_pragma' % NON standard - 'Ugly_pragmas' % NON standard - 'ZorM_<integer_literal>' - '<fixed_pt_type>' - '<fixed_pt_const_type>' - '<constr_forward_decl>' - . - - -Terminals - '#' - 'in' - '[' - 'interface' - '(' - 'case' - 'union' - 'struct' - '<character_literal>' - '<wcharacter_literal>' - ')' - ']' - 'any' - 'long' - 'float' - 'out' - '*' - '^' - 'enum' - 'double' - '+' - 'context' - 'oneway' - 'sequence' - ',' - 'FALSE' - '<identifier>' - '{' - 'readonly' - ':' - '-' - 'void' - ';' - 'char' - 'wchar' %% WCHAR - '|' - 'inout' - '}' - 'attribute' - '<' - 'octet' - '/' - 'TRUE' - '~' - '=' - '>' - 'switch' - 'unsigned' - 'typedef' - '>>' - 'const' - '<string_literal>' - '<wstring_literal>' - 'raises' - 'string' - 'wstring' - 'fixed' - 'default' - 'short' - '%' - '<<' - 'module' - 'exception' - 'boolean' - '<integer_literal>' - '<fixed_pt_literal>' - '<floating_pt_literal>' - '&' - '::' - 'Object' - . - - -Rootsymbol '<specification>'. - - -Expect 9. - - -%%------------------------------------------------------------ -%% Clauses -%% - -%% Handling of pragmas. -%% Pragma prefix, id and version are not standard. - -%% pragma prefix, or codeopt -OE_pragma -> '#' '<integer_literal>' '<identifier>' - '<identifier>' '<string_literal>' '#' - : #pragma{type='$4', to=followed, apply='$5'} . - -%% pragma id -OE_pragma -> '#' '<integer_literal>' '<identifier>' - '<identifier>' '<identifier>' '<string_literal>' '#' - : #pragma{type='$4', to='$5', apply='$6'} . - -%% pragma version -OE_pragma -> '#' '<integer_literal>' '<identifier>' - '<identifier>' '<identifier>' '<floating_pt_literal>' '#' - : #pragma{type='$4', to='$5', apply=ic_options:float_to_version('$6')} . - - - - - - - -%% Ugly pragmas -Ugly_pragmas -> '$empty' : []. -Ugly_pragmas -> 'Ugly_pragmas' 'OE_pragma' : ['$2'|'$1']. - - - -%% (0) Handling of preprocessor stuff. - -OE_preproc -> '#' '#' . - -OE_preproc -> '#' '<integer_literal>' '<string_literal>' - 'ZorM_<integer_literal>' '#' - : case '$4' of - [] -> - case '$2' of - {_,_,"1"} -> - #preproc{cat=line_nr, id='$3', aux='$4'}; - _ -> - [] - end; - _ -> - #preproc{cat=line_nr, id='$3', aux='$4'} - end. - -%% (0b) Non-standard -'ZorM_<integer_literal>' -> '$empty' : [] . -'ZorM_<integer_literal>' -> '<integer_literal>' 'ZorM_<integer_literal>' - : ['$1' | '$2'] . - -%% (1) -'<specification>' -> 'OorM_<definition>' : reverse('$1') . - - -%% Added clause -'OorM_<definition>' -> '<definition>' : ['$1'] . -'OorM_<definition>' -> 'OorM_<definition>' '<definition>' -: ['$2' | '$1'] . - - -%% (2) -'<definition>' -> '<type_dcl>' ';' : '$1' . -'<definition>' -> '<const_dcl>' ';' : '$1' . -'<definition>' -> '<except_dcl>' ';' : '$1' . -'<definition>' -> '<interface>' ';' : '$1' . -'<definition>' -> '<module>' ';' : '$1' . -'<definition>' -> 'OE_preproc' : '$1' . -'<definition>' -> 'OE_pragma' : '$1' . - - -%% (3) -'<module>' -> 'module' '<identifier>' '{' 'OorM_<definition>' '}' -: #module{ id='$2', body=reverse('$4')}. - - -%% (4) -'<interface>' -> '<interface_dcl>' : '$1' . -'<interface>' -> '<forward_dcl>' : '$1' . - - -%% (5) -'<interface_dcl>' -> '<interface_header>' '{' '<interface_body>' '}' - : #interface{id=element(1, '$1'), inherit=element(2, '$1'), - body=lists:reverse('$3')} . - - -%% (6) -'<forward_dcl>' -> 'interface' '<identifier>' -: #forward{id='$2'} . - - -%% (7) -'<interface_header>' -> 'interface' '<identifier>' 'Opt_<inheritance_spec>' -: {'$2', '$3'} . - - -%% (8) -'<interface_body>' -> 'ZorM_<export>' : '$1' . - - -%% Added clause -'ZorM_<export>' -> '$empty' : [] . -'ZorM_<export>' -> 'ZorM_<export>' '<export>' - %% Complicated because <export> might be a list (of type defs for instance) - : if is_list('$2') -> '$2' ++ '$1'; - true -> ['$2' | '$1'] - end . - - -%% (9) -'<export>' -> '<type_dcl>' ';' : '$1' . -'<export>' -> '<const_dcl>' ';' : '$1' . -'<export>' -> '<except_dcl>' ';' : '$1' . -'<export>' -> '<attr_dcl>' ';' : '$1' . -'<export>' -> '<op_dcl>' ';' : '$1' . -'<export>' -> 'OE_preproc' : '$1' . -'<export>' -> 'OE_pragma' : '$1' . - -%% Added clause -'Opt_<inheritance_spec>' -> '$empty' : []. -'Opt_<inheritance_spec>' -> '<inheritance_spec>' : '$1'. - -%% (10) -'<inheritance_spec>' -> ':' '<scoped_name>' 'ZorM_<scoped_name>' - : ['$2' | reverse('$3')] . - - -%% Added clause -'ZorM_<scoped_name>' -> '$empty' : [] . -'ZorM_<scoped_name>' -> 'ZorM_<scoped_name>' ',' '<scoped_name>' - : ['$3' | '$1'] . - - -%% (11) -'<scoped_name>' -> '<identifier>' : ic_symtab:scoped_id_new('$1') . -'<scoped_name>' -> '::' '<identifier>' : ic_symtab:scoped_id_new_global('$2') . -'<scoped_name>' -> '<scoped_name>' '::' '<identifier>' - : ic_symtab:scoped_id_add('$1', '$3') . - - -%% (12) -'<const_dcl>' -> 'const' '<const_type>' '<identifier>' '=' '<const_exp>' - : #const{type='$2', id='$3', val='$5'} . - - -%% (13) -'<const_type>' -> '<integer_type>' : '$1' . -'<const_type>' -> '<char_type>' : '$1' . -'<const_type>' -> '<boolean_type>' : '$1' . -'<const_type>' -> '<floating_pt_type>' : '$1' . -'<const_type>' -> '<string_type>' : '$1' . -'<const_type>' -> '<fixed_pt_const_type>' : '$1' . -'<const_type>' -> '<scoped_name>' : '$1' . -'<const_type>' -> '<octet_type>' : '$1' . - - -%% (14) -'<const_exp>' -> '<or_expr>' : '$1' . - - -%% (15) -'<or_expr>' -> '<xor_expr>' : '$1' . -'<or_expr>' -> '<or_expr>' '|' '<xor_expr>' : {'or', '$1', '$3'} . - - -%% (16) -'<xor_expr>' -> '<and_expr>' : '$1' . -'<xor_expr>' -> '<xor_expr>' '^' '<and_expr>' : {'xor', '$1', '$3'} . - - -%% (17) -'<and_expr>' -> '<shift_expr>' : '$1' . -'<and_expr>' -> '<and_expr>' '&' '<shift_expr>' : {'and', '$1', '$3'} . - - -%% (18) -'<shift_expr>' -> '<add_expr>' : '$1' . -'<shift_expr>' -> '<shift_expr>' '>>' '<add_expr>' : {'rshift', '$1', '$3'} . -'<shift_expr>' -> '<shift_expr>' '<<' '<add_expr>' : {'lshift', '$1', '$3'} . - - -%% (19) -'<add_expr>' -> '<mult_expr>' : '$1' . -'<add_expr>' -> '<add_expr>' '+' '<mult_expr>' : {'+', '$1', '$3'} . -'<add_expr>' -> '<add_expr>' '-' '<mult_expr>' : {'-', '$1', '$3'} . - - -%% (20) -'<mult_expr>' -> '<unary_expr>' : '$1' . -'<mult_expr>' -> '<mult_expr>' '*' '<unary_expr>' : {'*', '$1', '$3'} . -'<mult_expr>' -> '<mult_expr>' '/' '<unary_expr>' : {'/', '$1', '$3'} . -'<mult_expr>' -> '<mult_expr>' '%' '<unary_expr>' : {'%', '$1', '$3'} . - - -%% (21) -'<unary_expr>' -> '<unary_operator>' '<primary_expr>' : {'$1', '$2'} . -'<unary_expr>' -> '<primary_expr>' : '$1' . - - -%% (22) -'<unary_operator>' -> '-' : '$1' . -'<unary_operator>' -> '+' : '$1' . -'<unary_operator>' -> '~' : '$1' . - - -%% (23) -'<primary_expr>' -> '<scoped_name>' : '$1' . -'<primary_expr>' -> '<literal>' : '$1' . -'<primary_expr>' -> '(' '<const_exp>' ')' : '$2' . - - -%% (24) -'<literal>' -> '<integer_literal>' : '$1' . -'<literal>' -> '<wstring_literal>' : '$1' . -'<literal>' -> '<string_literal>' : '$1' . -'<literal>' -> '<character_literal>' : '$1' . -'<literal>' -> '<wcharacter_literal>' : '$1' . -'<literal>' -> '<fixed_pt_literal>' : '$1' . -'<literal>' -> '<floating_pt_literal>' : '$1' . -'<literal>' -> '<boolean_literal>' : '$1' . - - -%% (25) -'<boolean_literal>' -> 'TRUE' : '$1' . -'<boolean_literal>' -> 'FALSE' : '$1' . - - -%% (26) -'<positive_int_const>' -> '<const_exp>' : '$1' . - - -%% (27) -'<type_dcl>' -> 'typedef' '<type_declarator>' : '$2' . -'<type_dcl>' -> '<struct_type>' : '$1' . -'<type_dcl>' -> '<union_type>' : '$1' . -'<type_dcl>' -> '<enum_type>' : '$1' . -'<type_dcl>' -> '<constr_forward_decl>' : '$1' . - -%% (28) NIY multiple declarators (FIXED) -'<type_declarator>' -> '<type_spec>' '<declarators>' - : #typedef{type='$1', id='$2'} . %%%ic:unfold(#typedef{type='$1', id='$2'}) . -%%'<type_declarator>' -> '<type_spec>' '<declarator>' -%% : #typedef{type='$1', id='$2'} . - -%% (29) -'<type_spec>' -> '<simple_type_spec>' : '$1' . -'<type_spec>' -> '<constr_type_spec>' : '$1' . - - -%% (30) -'<simple_type_spec>' -> '<base_type_spec>' : '$1' . -'<simple_type_spec>' -> '<template_type_spec>' : '$1' . -'<simple_type_spec>' -> '<scoped_name>' : '$1' . - - -%% (31) -'<base_type_spec>' -> '<floating_pt_type>' : '$1' . -'<base_type_spec>' -> '<integer_type>' : '$1' . -'<base_type_spec>' -> '<char_type>' : '$1' . -'<base_type_spec>' -> '<boolean_type>' : '$1' . -'<base_type_spec>' -> '<octet_type>' : '$1' . -'<base_type_spec>' -> '<any_type>' : '$1' . -'<base_type_spec>' -> 'Object' : '$1' . %% NON Standard, isn't a base type - - -%% (32) -'<template_type_spec>' -> '<sequence_type>' : '$1' . -'<template_type_spec>' -> '<string_type>' : '$1' . -'<template_type_spec>' -> '<fixed_pt_type>' : '$1' . - - -%% (33) -'<constr_type_spec>' -> '<struct_type>' : '$1' . -'<constr_type_spec>' -> '<union_type>' : '$1' . -'<constr_type_spec>' -> '<enum_type>' : '$1' . - - -%% (34) -'<declarators>' -> '<declarator>' 'ZorM_<declarator>' -: ['$1' | reverse('$2')] . - -%% Added clause -'ZorM_<declarator>' -> '$empty' : [] . -'ZorM_<declarator>' -> 'ZorM_<declarator>' ',' '<declarator>' -: ['$3' | '$1'] . - - -%% (35) -'<declarator>' -> '<simple_declarator>' : '$1' . -'<declarator>' -> '<complex_declarator>' : '$1' . - - -%% (36) -'<simple_declarator>' -> '<identifier>' : '$1' . - - -%% (37) -'<complex_declarator>' -> '<array_declarator>' : '$1' . - - -%% (38) -'<floating_pt_type>' -> 'float' : '$1' . -'<floating_pt_type>' -> 'double' : '$1' . - - -%% (39) -'<integer_type>' -> '<signed_int>' : '$1' . -'<integer_type>' -> '<unsigned_int>' : {'unsigned', '$1'} . - - -%% (40) -'<signed_int>' -> '<signed_long_int>' : '$1' . -'<signed_int>' -> '<signed_short_int>' : '$1' . - - -%% (41) -'<signed_long_int>' -> 'long' : '$1' . -'<signed_long_int>' -> 'long' 'long': {'long long', element(2,'$2')} . - - -%% (42) -'<signed_short_int>' -> 'short' : '$1' . - - -%% (43) -'<unsigned_int>' -> '<unsigned_long_int>' : '$1' . -'<unsigned_int>' -> '<unsigned_short_int>' : '$1' . - - -%% (44) -'<unsigned_long_int>' -> 'unsigned' 'long' : '$2' . -'<unsigned_long_int>' -> 'unsigned' 'long' 'long' : {'long long', element(2,'$2')} . %% ULLONG - - -%% (45) -'<unsigned_short_int>' -> 'unsigned' 'short' : '$2' . - - -%% (46) -'<char_type>' -> 'char' : '$1' . -'<char_type>' -> 'wchar' : '$1' . %% WCHAR - - -%% (47) -'<boolean_type>' -> 'boolean' : '$1' . - - -%% (48) -'<octet_type>' -> 'octet' : '$1' . - - -%% (49) -'<any_type>' -> 'any' : '$1' . - -%% -'<fixed_pt_const_type>' -> 'fixed' : '$1'. - -%% (50) NIY: unfolding of struct decls (FIXED) -%%'<struct_type>' -> 'struct' '<identifier>' '{' '<member_list>' '}' -%% : #struct{id='$2', body=ic:unfold('$4')} . -'<struct_type>' -> 'struct' '<identifier>' '{' '<member_list>' '}' - : #struct{id='$2', body='$4'} . - - -%% (51) -'<member_list>' -> 'OorM_<member>' : reverse('$1') . - - -%% Added clause -%%'OorM_<member>' -> '<member>' : ['$1'] . -%%'OorM_<member>' -> 'OorM_<member>' '<member>' -%% : ['$2' | '$1'] . - -'OorM_<member>' -> '<member>' : '$1' . -'OorM_<member>' -> 'OorM_<member>' '<member>' - : '$2' ++ '$1' . - - - -%% (52) NIY: member multiple declarators (FIXED) -%%'<member>' -> '<type_spec>' '<declarators>' ';' -%% : #member{type='$1', id='$2'} . - -'<member>' -> 'Ugly_pragmas' '<type_spec>' '<declarators>' 'Ugly_pragmas' ';' 'Ugly_pragmas' - : '$1' ++ '$4' ++ '$6' ++ [#member{type='$2', id='$3'}] . - - -%% (53) NIY: unfolding of union cases (FIXED) -%%'<union_type>' -> 'union' '<identifier>' 'switch' -%% '(' '<switch_type_spec>' ')' '{' '<switch_body>' '}' -%% : #union{id='$2', type='$5', body=ic:unfold('$8')} . -'<union_type>' -> 'union' '<identifier>' 'switch' - '(' '<switch_type_spec>' ')' '{' '<switch_body>' '}' - : #union{id='$2', type='$5', body='$8'} . - - -%% (54) -'<switch_type_spec>' -> '<integer_type>' : '$1' . -'<switch_type_spec>' -> '<char_type>' : '$1' . -'<switch_type_spec>' -> '<boolean_type>' : '$1' . -'<switch_type_spec>' -> '<enum_type>' : '$1' . -'<switch_type_spec>' -> '<scoped_name>' : '$1' . - - -%% (55) -'<switch_body>' -> 'OorM_<case>' : reverse(lists:flatten('$1')) . - -%%'<switch_body>' -> 'OorM_<case>' : '$1' . - - -%% Added clause -'OorM_<case>' -> '<case>' : ['$1'] . -'OorM_<case>' -> 'OorM_<case>' '<case>' : ['$2' | '$1'] . - - -%% (56) NIY thing: multiple case labels (FIXED) -%%'<case>' -> 'OorM_<case_label>' '<element_spec>' ';' -%% : '$2'#case_dcl{label=reverse('$1')} . - -'<case>' -> - 'Ugly_pragmas' 'OorM_<case_label>' - 'Ugly_pragmas' '<element_spec>' - 'Ugly_pragmas' ';' 'Ugly_pragmas' - : '$1' ++ '$3' ++ '$5' ++ '$7' ++ [ '$4'#case_dcl{label=reverse('$2')} ] . - - -%% Added clause -%%'OorM_<case_label>' -> '<case_label>' : ['$1'] . -%%'OorM_<case_label>' -> 'OorM_<case_label>' '<case_label>' : ['$2' | '$1'] . - -'OorM_<case_label>' -> 'Ugly_pragmas' '<case_label>' 'Ugly_pragmas' - : '$1' ++ ['$2'] ++ '$3' . -'OorM_<case_label>' -> 'OorM_<case_label>' 'Ugly_pragmas' '<case_label>' 'Ugly_pragmas' - : '$2' ++ ['$3'|'$1'] ++ '$4'. - - -%% (57) -'<case_label>' -> 'case' '<const_exp>' ':' : '$2' . -'<case_label>' -> 'default' ':' : '$1' . - - -%% (58) -'<element_spec>' -> '<type_spec>' '<declarator>' -: #case_dcl{type='$1', id='$2'} . - - -%% (59) -%%'<enum_type>' -> 'enum' '<identifier>' -%%'{' '<enumerator>' 'ZorM_<enumerator>' '}' -%%: #enum{id='$2', body=['$4' | reverse('$5')]} . - -'<enum_type>' -> 'enum' '<identifier>' -'{' 'Ugly_pragmas' '<enumerator>' 'Ugly_pragmas' 'ZorM_<enumerator>' 'Ugly_pragmas' '}' -: #enum{id='$2', body='$4'++'$6'++'$8'++['$5' | reverse('$7')]} . - - - -%% Added clause -%%'ZorM_<enumerator>' -> '$empty' : [] . -%%'ZorM_<enumerator>' -> 'ZorM_<enumerator>' ',' '<enumerator>' : ['$3' | '$1'] . - -'ZorM_<enumerator>' -> '$empty' : [] . -'ZorM_<enumerator>' -> 'ZorM_<enumerator>' 'Ugly_pragmas' ',' 'Ugly_pragmas' '<enumerator>' - : '$2'++'$4'++['$5' | '$1'] . - -%% (60) -'<enumerator>' -> '<identifier>' : #enumerator{id='$1'} . - - -%% (61) -'<sequence_type>' -> 'sequence' '<' '<simple_type_spec>' ',' - '<positive_int_const>' '>' - : #sequence{type='$3', length='$5'} . -'<sequence_type>' -> 'sequence' '<' '<simple_type_spec>' '>' - : #sequence{type='$3'} . - - -%% (62) -'<string_type>' -> 'string' '<' '<positive_int_const>' '>' - : #string{length='$3'} . -'<string_type>' -> 'string' : #string{} . - -'<string_type>' -> 'wstring' '<' '<positive_int_const>' '>' %% WSTRING - : #wstring{length='$3'} . -'<string_type>' -> 'wstring' : #wstring{} . %% WSTRING - - -%% (63) -'<array_declarator>' -> '<identifier>' 'OorM_<fixed_array_size>' - : #array{id='$1', size=reverse('$2')} . - - -%% Added clause -'OorM_<fixed_array_size>' -> '<fixed_array_size>' : ['$1'] . -'OorM_<fixed_array_size>' -> 'OorM_<fixed_array_size>' '<fixed_array_size>' - : ['$2' | '$1'] . - - -%% (64) -'<fixed_array_size>' -> '[' '<positive_int_const>' ']' : '$2' . - - -%% (65) NIY: multiple attribute declarators (FIXED) -'<attr_dcl>' -> 'Opt_readonly' 'attribute' '<param_type_spec>' - '<simple_declarator>' 'ZorM_<simple_declarator>' - : #attr{readonly='$1', type='$3', id=['$4' | reverse('$5')]} . -%% : ic:unfold(#attr{readonly='$1', type='$3', id=['$4' | reverse('$5')]}) . -%%'<attr_dcl>' -> 'Opt_readonly' 'attribute' '<param_type_spec>' -%% '<simple_declarator>' - - -%% (66) NIY: unfolding of exception bodies (FIXED) -%%'<except_dcl>' -> 'exception' '<identifier>' '{' 'ZorM_<member>' '}' -%% : #except{id='$2', body=ic:unfold('$4')} . -'<except_dcl>' -> 'exception' '<identifier>' '{' 'ZorM_<member>' '}' - : #except{id='$2', body=reverse('$4')} . - -%% (67) -'<op_dcl>' -> 'Opt_<op_attribute>' '<op_type_spec>' '<identifier>' '<parameter_dcls>' 'Opt_<raises_expr>' 'Opt_<context_expr>' - : #op{oneway='$1', type='$2', id='$3', params='$4', raises='$5', ctx='$6'} . - -%% Added clause -'Opt_<op_attribute>' -> '$empty' : nil. -'Opt_<op_attribute>' -> '<op_attribute>' : '$1'. - -%% (68) -'<op_attribute>' -> 'oneway' : '$1' . - - -%% (69) -'<op_type_spec>' -> '<param_type_spec>' : '$1' . -'<op_type_spec>' -> 'void' : '$1' . - - -%% (70) Rewritten -%'<parameter_dcls>' -> '(' '<param_dcl>' 'ZorM_<param_dcl>' ')' -% : ['$2' | reverse('$3')] . -%'<parameter_dcls>' -> '(' ')' : [] . - -'<parameter_dcls>' -> '(' 'Ugly_pragmas' '<param_dcl>' 'ZorM_<param_dcl>' ')' - : '$2' ++ ['$3' | reverse('$4')] . -'<parameter_dcls>' -> '(' 'Ugly_pragmas' ')' : '$2' . - - -%% Added clause -%'ZorM_<param_dcl>' -> '$empty' : [] . -%'ZorM_<param_dcl>' -> 'ZorM_<param_dcl>' ',' '<param_dcl>' : ['$3' | '$1'] . - - -'ZorM_<param_dcl>' -> 'Ugly_pragmas' : '$1' . -'ZorM_<param_dcl>' -> 'ZorM_<param_dcl>' 'Ugly_pragmas' ',' 'Ugly_pragmas' '<param_dcl>' 'Ugly_pragmas' - : '$2' ++ '$4' ++ '$6' ++ ['$5' | '$1'] . - - - - -%% (71) -'<param_dcl>' -> '<param_attribute>' '<param_type_spec>' '<simple_declarator>' - : #param{inout='$1', type='$2', id='$3'} . - - -%% (72) -'<param_attribute>' -> 'in' : '$1' . -'<param_attribute>' -> 'out' : '$1' . -'<param_attribute>' -> 'inout' : '$1' . - - -%% Added clause -'Opt_<raises_expr>' -> '$empty' : [] . -'Opt_<raises_expr>' -> '<raises_expr>' : '$1' . - -%% (73) -'<raises_expr>' -> 'raises' '(' '<scoped_name>' 'ZorM_<scoped_name>' ')' - : ['$3'| reverse('$4')] . - - -%% Added clause -'Opt_<context_expr>' -> '$empty' : [] . -'Opt_<context_expr>' -> '<context_expr>' : '$1'. - -%% (74) -'<context_expr>' -> 'context' '(' '<string_literal>' 'ZorM_<string_literal>'')' - : ['$3' | reverse('$4')] . - - - -%% (75) -'<param_type_spec>' -> '<base_type_spec>' : '$1' . -'<param_type_spec>' -> '<string_type>' : '$1' . -'<param_type_spec>' -> '<scoped_name>' : '$1' . - - -%% (96) -'<fixed_pt_type>' -> 'fixed' '<' '<positive_int_const>' ',' '<positive_int_const>' '>' - : #fixed{digits='$3',scale='$5'} . - -%% (99) -'<constr_forward_decl>' -> 'struct' '<identifier>' : #constr_forward{id='$2', tk=tk_struct} . -'<constr_forward_decl>' -> 'union' '<identifier>' : #constr_forward{id='$2', tk=tk_union} . - -%% Added clause -'ZorM_<string_literal>' -> '$empty' : [] . -'ZorM_<string_literal>' -> 'ZorM_<string_literal>' ',' '<string_literal>' - : ['$3' | '$1'] . - -%% Added clause -'ZorM_<simple_declarator>' -> '$empty' : [] . -'ZorM_<simple_declarator>' -> 'ZorM_<simple_declarator>' ',' -'<simple_declarator>' : ['$3' | '$1'] . - -%% Added clause -%%'ZorM_<member>' -> '$empty' : [] . -%%'ZorM_<member>' -> 'ZorM_<member>' '<member>' : ['$2' | '$1'] . - -'ZorM_<member>' -> 'Ugly_pragmas' : '$1' . -'ZorM_<member>' -> 'ZorM_<member>' '<member>' : '$2' ++ '$1' . - - -%% Added clause -'Opt_readonly' -> '$empty' : nil. -'Opt_readonly' -> 'readonly' : '$1'. - - - -Erlang code. -%%----------------------------------------------------------- - - - diff --git a/lib/ic/src/icpreproc.erl b/lib/ic/src/icpreproc.erl deleted file mode 100644 index fc936c4bf3..0000000000 --- a/lib/ic/src/icpreproc.erl +++ /dev/null @@ -1,112 +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% -%% -%% --module(icpreproc). - - - --export([preproc/2]). - - --import(lists, [filter/2]). - - -%%---------------------------------------------------------------------- -%%---------------------------------------------------------------------- - - -preproc(G, File) -> - Cmd = ic_options:get_opt(G, preproc_cmd), - Flags = ic_options:get_opt(G, preproc_flags), - - - case Cmd of - "erl" -> - case ic_pp:run(File,Flags) of - {ok, [$#, $ , $1 | Rest], []} -> - [$#, $ , $1 | Rest]; - {ok, [$#, $ , $1 | Rest], Warning} -> - print_warning(G,Warning), - [$#, $ , $1 | Rest]; - {error,Error} -> - print_error(G,Error) - end; - - _ -> - Line = Cmd++" "++Flags++" "++File, - % FIXME: Check status code of command instead of this test - case os:cmd(Line) of - [$#, $ , C | Rest] when is_integer(C), C > $0, C =< $9 -> - [$#, $ , C | Rest]; - X -> - ic_error:fatal_error(G, {preproc, filter(X)}) - end - end. - - -filter(X) -> - X2 = divide_nl(X, []), - filter_x_switch(X2). - - -divide_nl([10 | Xs], Out) -> - [lists:reverse(Out) | divide_nl(Xs, [])]; -divide_nl([X | Xs], Out) -> divide_nl(Xs, [X|Out]); -divide_nl([], Out) -> lists:reverse(Out). - - -filter_x_switch(L) -> - filter(fun([$g,$c,$c,$:,$ ,$W,$a,$r,$n,$i,$n,$g,$:,$ ,$`,$-,$x,$ | _]) -> - false; - (_) -> true end, L). - - -print_error(_G,[]) -> - ok; -print_error(G,[{File,Line,Text}]) -> - ErrorText = File++":"++integer_to_list(Line)++": "++Text, - ic_error:fatal_error(G, {ic_pp_error, ErrorText}), - ok; -print_error(G,[{File,Line,Text}|T]) -> - ErrorText = File++":"++integer_to_list(Line)++": "++Text, - ic_error:error(G, {ic_pp_error, ErrorText}), - print_error(G,T); -print_error(G,[H]) -> - ErrorText = H++"\n", - ic_error:fatal_error(G, {ic_pp_error, ErrorText}), - ok; -print_error(G,[H|T]) -> - ErrorText = H++"\n", - ic_error:error(G, {ic_pp_error, ErrorText}), - print_error(G,T). - - -print_warning(_G,[]) -> - ok; -print_warning(G,[{File,Line,Text}|T]) -> - WarText = File++":"++integer_to_list(Line)++": "++Text, - ic_error:warn(G, {ic_pp_warning, WarText}), - print_warning(G,T); -print_warning(G,[H|T]) -> - WarText = H++"\n", - ic_error:warn(G, {ic_pp_warning, WarText}), - print_warning(G,T). - - diff --git a/lib/ic/src/icscan.erl b/lib/ic/src/icscan.erl deleted file mode 100644 index 123041495e..0000000000 --- a/lib/ic/src/icscan.erl +++ /dev/null @@ -1,453 +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% -%% -%% --module(icscan). - - --export([scan/2]). - --include("ic.hrl"). - - -%%---------------------------------------------------------------------- -%%---------------------------------------------------------------------- - --import(lists, [reverse/1]). - - -scan(G, File) -> - PL = call_preproc(G, File), - call_scan(G, PL). - -call_preproc(G, File) -> - case ic_options:get_opt(G, use_preproc) of - true -> - icpreproc:preproc(G, File); - false -> - case catch file:read_file(File) of - {ok, Bin} -> - binary_to_list(Bin); - Other -> - exit(Other) - end - end. - -call_scan(G, PL) -> - BE = ic_options:get_opt(G, be), - RSL = scan(G, BE, PL, 1, []), - lists:reverse(RSL). - - -%% Guard macros used at top scan functions only --define(is_number(X), X >= $0 , X =< $9). --define(is_upper(X), X >= $A , X =< $Z). --define(is_lower(X), X >= $a, X =< $z). --define(is_hex_uc(X), X >= $A , X =< $F). --define(is_hex_lc(X), X >= $a , X =< $f). --define(is_octal(X), X >=$0, X =< $7). - -%% Handle: -%% const wchar aWChar = L'X'; -scan(G, BE, [$L, $'|Str], Line, Out) -> - scan_const(G, BE, wchar, Str, [], Line, Out); -scan(G, BE, [$L, $"|Str], Line, Out) -> - scan_const(G, BE, wstring, Str, [], Line, Out); -scan(G, BE, [$_, X|Str], Line, Out) when ?is_upper(X) -> - scan_name(G, BE, Str, [X], false, Line, Out); -scan(G, BE, [$_, X|Str], Line, Out) when ?is_lower(X) -> - scan_name(G, BE, Str, [X], false, Line, Out); -scan(G, BE, [X|Str], Line, Out) when ?is_upper(X) -> - scan_name(G, BE, Str, [X], true, Line, Out); -scan(G, BE, [X|Str], Line, Out) when ?is_lower(X) -> - scan_name(G, BE, Str, [X], true, Line, Out); -scan(G, BE, [X|Str], Line, Out) when ?is_number(X) -> - scan_number(G, BE, Str, [X], Line, Out); -scan(G, BE, [9| T], Line, Out) -> scan(G, BE, T, Line, Out); -scan(G, BE, [32| T], Line, Out) -> scan(G, BE, T, Line, Out); -scan(G, BE, [$\r|Str], Line, Out) -> - scan(G, BE, Str, Line, Out); -scan(G, BE, [$\n|Str], Line, Out) -> - scan(G, BE, Str, Line+1, Out); -scan(G, BE, [$:, $: | Str], Line, Out) -> - scan(G, BE, Str, Line, [{'::', Line} | Out]); -scan(G, BE, [$/, $/ | Str], Line, Out) -> - Rest = skip_to_nl(Str), - scan(G, BE, Rest, Line, Out); -scan(G, BE, [$/, $* | Str], Line, Out) -> - Rest = skip_comment(Str), - scan(G, BE, Rest, Line, Out); -scan(G, BE, [$", $\\|Str], Line, Out) -> - scan_const(G, BE, string, [$\\|Str], [], Line, Out); -scan(G, BE, [$"|Str], Line, Out) -> - scan_const(G, BE, string, Str, [], Line, Out); -scan(G, BE, [$', $\\|Str], Line, Out) -> - scan_const(G, BE, char, [$\\|Str], [], Line, Out); -scan(G, BE, [$'|Str], Line, Out) -> - scan_const(G, BE, char, Str, [], Line, Out); -scan(G, BE, [$\\|Str], Line, Out) -> - scan_const(G, BE, escaped, [$\\|Str], [], Line, Out); -scan(G, BE, [$. | Str], Line, Out) -> - scan_frac(G, BE, Str, [$.], Line, Out); -scan(G, BE, [$# | Str], Line, Out) -> - scan_preproc(G, BE, Str, Line, Out); -scan(G, BE, [$<, $< | Str], Line, Out) -> - scan(G, BE, Str, Line, [{'<<', Line} | Out]); -scan(G, BE, [$>, $> | Str], Line, Out) -> - scan(G, BE, Str, Line, [{'>>', Line} | Out]); -scan(G, BE, [C|Str], Line, Out) -> - scan(G, BE, Str, Line, [{list_to_atom([C]), Line} | Out]); - -scan(_G, _BE, [], _Line, Out) -> - Out. - - -scan_number(G, BE, [X|Str], [$0], Line, Out) when X == $X ; X ==$x -> - case Str of - [D|_TmpStr] when ?is_number(D); ?is_hex_uc(D); ?is_hex_lc(D) -> - {Num,Rest} = scan_hex_number(Str,0), - scan(G, BE, Rest, Line, [{'<integer_literal>', Line, - integer_to_list(Num)} | Out]); - [D|TmpStr] -> - scan(G, BE, TmpStr, Line, [{list_to_atom([D]), Line} | Out]) - end; -scan_number(G, BE, Str, [$0], Line, Out) -> - %% If an integer literal starts with a 0 it may indicate that - %% it is represented as an octal number. But, it can also be a fixed - %% type which must use padding to match a fixed typedef. For example: - %% typedef fixed<5,2> fixed52; - %% 123.45d, 123.00d and 023.00d is all valid fixed values. - %% Naturally, a float can be defined as 0.14 or 00.14. - case pre_scan_number(Str, [], octal) of - octal -> - {Num, Rest} = scan_octal_number(Str,0), - scan(G, BE, Rest, Line, [{'<integer_literal>', Line, - integer_to_list(Num)} | Out]); - {fixed, Fixed, Rest} -> - scan(G, BE, Rest, Line, [{'<fixed_pt_literal>', Line, Fixed} | Out]); - float -> - %% Not very likely that someone defines a constant as 00.14 but ... - NewStr = remove_leading_zeroes(Str), - scan(G, BE, NewStr, Line, Out) - end; -scan_number(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> - scan_number(G, BE, Str, [X|Accum], Line, Out); -scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$. -> - scan_frac(G, BE, Str, [X|Accum], Line, Out); -scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$e ; X==$e -> - scan_exp(G, BE, Str, [X|Accum], Line, Out); -scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$D ; X==$d -> - scan(G, BE, Str, Line, [{'<fixed_pt_literal>', Line, - (lists:reverse(Accum))} | Out]); -scan_number(G, BE, Str, Accum, Line, Out) -> - scan(G, BE, Str, Line, [{'<integer_literal>', Line, - (lists:reverse(Accum))} | Out]). - - -remove_leading_zeroes([$0|Rest]) -> - remove_leading_zeroes(Rest); -remove_leading_zeroes(L) -> - L. - -scan_hex_number([X|Rest],Acc) when X >=$a, X =< $f -> - scan_hex_number(Rest,(Acc bsl 4) + (X - $a + 10)); -scan_hex_number([X|Rest],Acc) when X >=$A, X =< $F -> - scan_hex_number(Rest,(Acc bsl 4) + (X - $A + 10)); -scan_hex_number([X|Rest],Acc) when X >=$0, X =< $9 -> - scan_hex_number(Rest,(Acc bsl 4) + (X-$0)); -scan_hex_number(Rest,Acc) -> - {Acc,Rest}. - -pre_scan_number([$d|Rest], Acc, _) -> - {fixed, [$0|lists:reverse(Acc)], Rest}; -pre_scan_number([$D|Rest], Acc, _) -> - {fixed, [$0|lists:reverse(Acc)], Rest}; -pre_scan_number([$.|Rest], Acc, _) -> - %% Actually, we don't know if it's a float since it can be a fixed. - pre_scan_number(Rest, [$.|Acc], float); -pre_scan_number([X|_], _Acc, _) when X == $E ; X ==$e -> - %% Now we now it's a float. - float; -pre_scan_number([X|Rest], Acc, Type) when ?is_number(X) -> - pre_scan_number(Rest, [X|Acc], Type); -pre_scan_number(_Rest, _Acc, Type) -> - %% At this point we know it's a octal or float. - Type. - -scan_octal_number([X|Rest],Acc) when ?is_octal(X) -> - scan_octal_number(Rest,(Acc bsl 3) + (X-$0)); -scan_octal_number(Rest,Acc) -> - {Acc, Rest}. - -%% Floating point number scan. -%% -%% Non trivial scan. A float consists of an integral part, a -%% decimal point, a fraction part, an e or E and a signed integer -%% exponent. Either the integer part or the fraction part but not -%% both may be missing, and either the decimal point or the -%% exponent part but not both may be missing. The exponent part -%% must consist of an e or E and a possibly signed exponent. -%% -%% Analysis shows that "1." ".7" "1e2" ".5e-3" "1.7e2" "1.7e-2" -%% is allowed and "1" ".e9" is not. The sign is only allowed just -%% after an e or E. The scanner reads a number as an integer -%% until it encounters a "." so the integer part only error case -%% will not be caught in the scanner (but rather in expression -%% evaluation) - -scan_frac(G, _BE, [$e | _Str], [$.], Line, _Out) -> - ic_error:fatal_error(G, {illegal_float, Line}); -scan_frac(G, _BE, [$E | _Str], [$.], Line, _Out) -> - ic_error:fatal_error(G, {illegal_float, Line}); -scan_frac(G, BE, Str, Accum, Line, Out) -> - scan_frac2(G, BE, Str, Accum, Line, Out). - -scan_frac2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> - scan_frac2(G, BE, Str, [X|Accum], Line, Out); -scan_frac2(G, BE, [X|Str], Accum, Line, Out) when X==$e ; X==$E -> - scan_exp(G, BE, Str, [X|Accum], Line, Out); -%% The following case is for fixed (e.g. 123.45d). -scan_frac2(G, BE, [X|Str], Accum, Line, Out) when X==$d ; X==$D -> - scan(G, BE, Str, Line, [{'<fixed_pt_literal>', Line, - (lists:reverse(Accum))} | Out]); -scan_frac2(G, BE, Str, Accum, Line, Out) -> - scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line, - (lists:reverse(Accum))} | Out]). - -scan_exp(G, BE, [X|Str], Accum, Line, Out) when X==$- -> - scan_exp2(G, BE, Str, [X|Accum], Line, Out); -scan_exp(G, BE, Str, Accum, Line, Out) -> - scan_exp2(G, BE, Str, Accum, Line, Out). - -scan_exp2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> - scan_exp2(G, BE, Str, [X|Accum], Line, Out); -scan_exp2(G, BE, Str, Accum, Line, Out) -> - scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line, - (lists:reverse(Accum))} | Out]). - - -scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_upper(X) -> - scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); -scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_lower(X) -> - scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); -scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_number(X) -> - scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); -scan_name(G, BE, [$_|Str], Accum, TypeCheck, Line, Out) -> - scan_name(G, BE, Str, [$_|Accum], TypeCheck, Line, Out); -scan_name(G, BE, S, Accum, false, Line, Out) -> - %% The CORBA 2.3 specification allows the user to override typechecking: - %% typedef string _native; - %% interface i { - %% void foo(in _native VT); - %% }; - %% BUT, the IFR-id remains the same ("IDL:native:1.0") etc. The reason for - %% this is that one don't have to re-write a large chunk of IDL- and - %% application-code. - scan(G, BE, S, Line, [{'<identifier>', Line, lists:reverse(Accum)} | Out]); -scan_name(G, BE, S, Accum, _, Line, Out) -> - L = lists:reverse(Accum), - X = case is_reserved(L, BE) of - undefined -> - {'<identifier>', Line, L}; - Yes -> - {Yes, Line} - end, - scan(G, BE, S, Line, [X | Out]). - -%% Shall scan a constant -scan_const(G, BE, string, [$" | Rest], Accum, Line, [{'<string_literal>', _, Str}|Out]) -> - scan(G, BE, Rest, Line, - [{'<string_literal>', Line, Str ++ lists:reverse(Accum)} | Out]); -scan_const(G, BE, string, [$" | Rest], Accum, Line, Out) -> - scan(G, BE, Rest, Line, - [{'<string_literal>', Line, lists:reverse(Accum)} | Out]); -scan_const(G, BE, wstring, [$" | Rest], Accum, Line, [{'<wstring_literal>', _,Wstr}|Out]) -> %% WSTRING - scan(G, BE, Rest, Line, - [{'<wstring_literal>', Line, Wstr ++ lists:reverse(Accum)} | Out]); -scan_const(G, BE, wstring, [$" | Rest], Accum, Line, Out) -> %% WSTRING - scan(G, BE, Rest, Line, - [{'<wstring_literal>', Line, lists:reverse(Accum)} | Out]); -scan_const(G, _BE, string, [], _Accum, Line, Out) -> %% Bad string - ic_error:error(G, {bad_string, Line}), - Out; -scan_const(G, _BE, wstring, [], _Accum, Line, Out) -> %% Bad WSTRING - ic_error:error(G, {bad_string, Line}), - Out; -scan_const(G, BE, char, [$' | Rest], Accum, Line, Out) -> - scan(G, BE, Rest, Line, - [{'<character_literal>', Line, lists:reverse(Accum)} | Out]); -scan_const(G, BE, wchar, [$' | Rest], Accum, Line, Out) -> %% WCHAR - scan(G, BE, Rest, Line, - [{'<wcharacter_literal>', Line, lists:reverse(Accum)} | Out]); -scan_const(G, BE, Mode, [$\\, C | Rest], Accum, Line, Out) -> - case escaped_char(C) of - error -> - ic_error:error(G, {bad_escape_character, Line, C}), %% Bad escape character - scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); - octal -> - {Num,Rest2} = scan_octal_number([C|Rest], 0), - scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out); - hexadecimal -> - {Num,Rest2} = scan_hex_number(Rest, 0), - if - Num > 255 -> %% 16#FF - ic_error:error(G, {bad_escape_character, Line, C}), - scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); - true -> - scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out) - end; - unicode -> - {Num,Rest2} = scan_hex_number(Rest, 0), - if - Num > 65535 -> %% 16#FFFF - ic_error:error(G, {bad_escape_character, Line, C}), - scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); - true -> - scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out) - end; - EC -> - scan_const(G, BE, Mode, Rest, [EC | Accum], Line, Out) - end; -scan_const(G, BE, Mode, [C | Rest], Accum, Line, Out) -> - scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out). - - -%% -%% Preprocessor output handling -%% -%% gcc outputs a line with line number, file name (within \") and -%% one or more integer flags. The scanner scans the line number, -%% the id and all integers up to nl. -%% -%% NOTE: This will have to be enhanced in order to eat #pragma -%% -scan_preproc(G, BE, Str, Line, Out) -> - {List, Rest} = scan_to_nl(strip(Str), []), - NewLine = get_new_line_nr(strip(List), Line+1, []), - case scan_number(G, BE, List, [], Line, [{'#', Line} | Out]) of - L when is_list(L) -> - scan(G, BE, Rest, NewLine, [{'#', Line} | L]) - end. - -get_new_line_nr([C|R], Line, Acc) when C>=$0, C=<$9 -> - get_new_line_nr(R, Line, [C|Acc]); -get_new_line_nr(_, Line, []) -> Line; % No line nr found -get_new_line_nr(_, _, Acc) -> list_to_integer(reverse(Acc)). - -scan_to_nl([], Acc) -> {reverse(Acc), []}; -scan_to_nl([$\n|Str], Acc) -> {reverse(Acc), Str}; -scan_to_nl([$\r|R], Acc) -> scan_to_nl(R, Acc); -scan_to_nl([C|R], Acc) -> scan_to_nl(R, [C|Acc]). - -strip([$ |R]) -> strip(R); -strip(L) -> L. - -%% Escaped character. Escaped chars are repr as two characters in the -%% input list of letters and this is translated into one char. -escaped_char($n) -> $\n; -escaped_char($t) -> $\t; -escaped_char($v) -> $\v; -escaped_char($b) -> $\b; -escaped_char($r) -> $ ; -escaped_char($f) -> $\f; -escaped_char($a) -> $\a; -escaped_char($\\) -> $\\; -escaped_char($?) -> $?; -escaped_char($') -> $'; -escaped_char($") -> $"; -escaped_char($x) -> hexadecimal; -escaped_char($u) -> unicode; -escaped_char(X) when ?is_octal(X) -> octal; -%% Error -escaped_char(_Other) -> error. - -skip_to_nl([]) -> []; -skip_to_nl([$\n | Str]) ->[$\n | Str]; -skip_to_nl([_|Str]) -> - skip_to_nl(Str). - -skip_comment([$\\, _ | Str]) -> - skip_comment(Str); -skip_comment([$*, $/ | Str]) -> Str; -skip_comment([_|Str]) -> - skip_comment(Str). - - -%%---------------------------------------------------------------------- -%% Shall separate keywords from identifiers and numbers - -%% Fill in the ets of reserved words -is_reserved("Object", _) -> 'Object'; -is_reserved("in", _) -> in; -is_reserved("interface", _) -> interface; -is_reserved("case", _) -> 'case'; -is_reserved("union", _) -> union; -is_reserved("struct", _) -> struct; -is_reserved("any", _) -> any; -is_reserved("long", _) -> long; -is_reserved("float", _) -> float; -is_reserved("out", _) -> out; -is_reserved("enum", _) -> enum; -is_reserved("double", _) -> double; -is_reserved("context", _) -> context; -is_reserved("oneway", _) -> oneway; -is_reserved("sequence", _) -> sequence; -is_reserved("FALSE", _) -> 'FALSE'; -is_reserved("readonly", _) -> readonly; -is_reserved("char", _) -> char; -is_reserved("wchar", _) -> wchar; -is_reserved("void", _) -> void; -is_reserved("inout", _) -> inout; -is_reserved("attribute", _) -> attribute; -is_reserved("octet", _) -> octet; -is_reserved("TRUE", _) -> 'TRUE'; -is_reserved("switch", _) -> switch; -is_reserved("unsigned", _) -> unsigned; -is_reserved("typedef", _) -> typedef; -is_reserved("const", _) -> const; -is_reserved("raises", _) -> raises; -is_reserved("string", _) -> string; -is_reserved("wstring", _) -> wstring; -is_reserved("default", _) -> default; -is_reserved("short", _) -> short; -is_reserved("module", _) -> module; -is_reserved("exception", _) -> exception; -is_reserved("boolean", _) -> boolean; -%% --- New keywords Introduced in CORBA-2.3.1 --- -%% For now we cannot add these for all backends right now since it would cause -%% some problems for at least one customer. -is_reserved("fixed", BE) -> check_be(BE, fixed); -%is_reserved("abstract", BE) -> check_be(BE, abstract); -%is_reserved("custom", BE) -> check_be(BE, custom); -%is_reserved("factory", BE) -> check_be(BE, factory); -%is_reserved("local", BE) -> check_be(BE, local); -%is_reserved("native", BE) -> check_be(BE, native); -%is_reserved("private", BE) -> check_be(BE, private); -%is_reserved("public", BE) -> check_be(BE, public); -%is_reserved("supports", BE) -> check_be(BE, supports); -%is_reserved("truncatable", BE) -> check_be(BE, truncatable); -%is_reserved("ValueBase", BE) -> check_be(BE, 'ValueBase'); -%is_reserved("valuetype", BE) -> check_be(BE, valuetype); -is_reserved(_, _) -> undefined. - -check_be(erl_corba, KeyWord) -> - KeyWord; -check_be(_, _) -> - undefined. - diff --git a/lib/ic/src/icstruct.erl b/lib/ic/src/icstruct.erl deleted file mode 100644 index 713ac87287..0000000000 --- a/lib/ic/src/icstruct.erl +++ /dev/null @@ -1,1917 +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% -%% -%% --module(icstruct). - - --export([struct_gen/4, except_gen/4, create_c_array_coding_file/5]). - -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ --import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). - --include("icforms.hrl"). --include("ic.hrl"). - - - -%%------------------------------------------------------------ - -%%------------------------------------------------------------ -%% -%% File handling stuff -%% -%%------------------------------------------------------------ - - - -%%------------------------------------------------------------ -%% -%% Generation loop -%% -%% The idea is to traverse everything and find every struct that -%% may be hiding down in nested types. All structs that are found -%% are generated to a hrl file. -%% -%% struct_gen is entry point for structs and types, except_gen is -%% for exceptions -%% -%%------------------------------------------------------------ - - -except_gen(G, N, X, L) when is_record(X, except) -> - N2 = [ic_forms:get_id2(X) | N], - if - L == c -> - io:format("Warning : Exception not defined for c mapping\n", []); - true -> - emit_struct(G, N, X, L) - end, - struct_gen_list(G, N2, ic_forms:get_body(X), L). - -struct_gen(G, N, X, L) when is_record(X, struct) -> - N2 = [ic_forms:get_id2(X) | N], - struct_gen_list(G, N2, ic_forms:get_body(X), L), - emit_struct(G, N, X, L); -struct_gen(G, N, X, L) when is_record(X, union) -> - N2 = [ic_forms:get_id2(X) | N], - if - L == c -> - %% Produce the "body" first - struct_gen_list(G, N2, ic_forms:get_body(X), L), - icunion:union_gen(G, N, X, c); - true -> - struct_gen(G, N, ic_forms:get_type(X), L), - struct_gen_list(G, N2, ic_forms:get_body(X), L) - end, - emit_union(G, N, X, L); -struct_gen(G, N, X, L) when is_record(X, member) -> - struct_gen(G, N, ic_forms:get_type(X), L); -struct_gen(G, N, X, L) when is_record(X, typedef) -> - struct_gen(G, N, ic_forms:get_body(X), L), - emit_typedef(G, N, X, L); -struct_gen(G, N, X, L) when is_record(X, type_dcl) -> - struct_gen_list(G, N, ic_forms:get_type(X), L); -struct_gen(G, N, X, L) when is_record(X, case_dcl) -> - struct_gen(G, N, ic_forms:get_type(X), L); -struct_gen(G, N, X, L) when is_record(X, sequence) -> - struct_gen(G, N, ic_forms:get_type(X), L), - X; -struct_gen(G, N, X, L) when is_record(X, enum) -> - icenum:enum_gen(G, N, X, L); -struct_gen(_G, _N, _X, _L) -> - ok. - -%% List clause for struct_gen -struct_gen_list(G, N, Xs, L) -> - lists:foreach( - fun(X) -> - R = struct_gen(G, N, X, L), - if - L == c -> - if - is_record(R,sequence) -> - emit_sequence_head_def(G,N,X,R,L); - true -> - ok - end; - true -> - ok - end - end, Xs). - - -%% emit primitive for structs. -emit_struct(G, N, X, erlang) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - %% Make a straight list of all member ids (this is a - %% variant of flatten) - EList = lists:map( - fun(XX) -> - lists:map( - fun(XXX) -> - ic_util:to_atom(ic_forms:get_id2(XXX)) - end, - ic_forms:get_idlist(XX)) - end, - ic_forms:get_body(X)), - ic_codegen:record(G, X, - ic_util:to_undersc([ic_forms:get_id2(X) | N]), - ictk:get_IR_ID(G, N, X), lists:flatten(EList)), - mkFileRecObj(G,N,X,erlang); - false -> - ok - end; -emit_struct(G, N, X, c) -> - - N1 = [ic_forms:get_id2(X) | N], - case ic_pragma:is_local(G,N1) of - true -> - emit_c_struct(G, N, X,local); - false -> - emit_c_struct(G, N, X,included) - end. - - -emit_c_struct(_G, _N, _X, included) -> - %% Do not generate included types att all. - ok; -emit_c_struct(G, N, X, local) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - - N1 = [ic_forms:get_id2(X) | N], - StructName = ic_util:to_undersc(N1), - - %% Make a straight list of all member ids (this is a - %% variant of flatten) - M = lists:map( - fun(XX) -> - lists:map( - fun(XXX) -> - if - is_record(XXX, array) -> - Type = ic_forms:get_type(XX), - Name = element(3,element(2,XXX)), - {_, _, StructTK, _} = - ic_symtab:get_full_scoped_name( - G, - N, - ic_symtab:scoped_id_new( - ic_forms:get_id2(X))), - ArrayTK = - get_structelement_tk(StructTK, - Name), - Dim = extract_dim(ArrayTK), - %% emit array file - emit(Fd, "\n#ifndef __~s__\n", - [ic_util:to_uppercase( - StructName ++ "_" - ++ Name)]), - emit(Fd, "#define __~s__\n\n", - [ic_util:to_uppercase( - StructName ++ "_" - ++ Name)]), - create_c_array_coding_file( - G, - N, - {StructName ++ "_" ++ Name, Dim}, - Type, - no_typedef), - emit(Fd, "\n#endif\n\n"), - {{Type, XXX}, - ic_forms:get_id2(XXX)}; - true -> - %% Ugly work around to fix the ETO - %% return patch problem - Name = - case ic_forms:get_id2(XXX) of - "return" -> - "return1"; - Other -> - Other - end, - {ic_forms:get_type(XX), Name} - end - end, - ic_forms:get_idlist(XX)) - end, - ic_forms:get_body(X)), - EList = lists:flatten(M), - %%io:format("Elist = ~p~n",[EList]), - - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(StructName)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(StructName)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Struct definition: ~s", - [StructName])], - c), - emit(Fd, "typedef struct {\n"), - lists:foreach( - fun({Type, Name}) -> - emit_struct_member(Fd, G, N1, X, Name, Type) - end, - EList), - emit(Fd, "} ~s;\n\n", [StructName]), - create_c_struct_coding_file(G, N, X, nil, StructName, - EList, struct), - emit(Fd, "\n#endif\n\n"); - false -> - ok - end. - -%% Extracts array dimention(s) - -get_structelement_tk({tk_struct, _, _, EList}, EN) -> - {value, {EN, ArrayTK}} = lists:keysearch(EN, 1, EList), - ArrayTK. - -extract_dim({tk_array, {tk_array, T, D1}, D}) -> - [integer_to_list(D) | extract_dim({tk_array, T, D1})]; -extract_dim({tk_array, _, D}) -> - [integer_to_list(D)]. - -%% Makes the array name -mk_array_name(Name,Dim) -> - Name ++ mk_array_name(Dim). - -mk_array_name([]) -> - ""; -mk_array_name([Dim|Dims]) -> - "[" ++ Dim ++ "]" ++ mk_array_name(Dims). - - -emit_struct_member(Fd, G, N, X, Name,{Type,Array}) when is_record(Array, array)-> - {_, _, StructTK, _} = - ic_symtab:get_full_scoped_name( - G, - N, - ic_symtab:scoped_id_new(ic_forms:get_id2(X))), - ArrayTK = get_structelement_tk(StructTK, Name), - Dim = extract_dim(ArrayTK), - emit(Fd, " ~s ~s;\n", - [ic_cbe:mk_c_type(G, N, Type),mk_array_name(Name,Dim)]); -emit_struct_member(Fd, _G, N, _X, Name, Union) when is_record(Union, union)-> - emit(Fd, " ~s ~s;\n", - [ic_util:to_undersc([ic_forms:get_id2(Union) | N]),Name]); -emit_struct_member(Fd, _G, _N, _X, Name, {string, _}) -> - emit(Fd, " CORBA_char *~s;\n", - [Name]); -emit_struct_member(Fd, _G, N, _X, Name, {sequence, _Type, _Length}) -> - %% Sequence used as struct - emit(Fd, " ~s ~s;\n", - [ic_util:to_undersc([Name | N]), Name]); -emit_struct_member(Fd, G, N, X, Name, Type) - when element(1, Type) == scoped_id -> - CType = ic_cbe:mk_c_type(G, N, Type, evaluate_not), - emit_struct_member(Fd, G, N, X, Name, CType); -emit_struct_member(Fd, G, N, _X, Name, {enum, Type}) -> - emit(Fd, " ~s ~s;\n", - [ic_cbe:mk_c_type(G, N, Type), - Name]); -emit_struct_member(Fd, _G, _N, _X, Name, "ETERM*") -> - emit(Fd, " ETERM* ~s;\n", - [Name]); -emit_struct_member(Fd, _G, _N, _X, Name, Type) when is_list(Type) -> - emit(Fd, " ~s ~s;\n", - [Type, Name]); -emit_struct_member(Fd, G, N, _X, Name, Type) -> - emit(Fd, " ~s ~s;\n", - [ic_cbe:mk_c_type(G, N, Type), - Name]). - - -emit_typedef(G, N, X, erlang) -> - case X of - {typedef,_,[{array,_,_}],_} -> %% Array but not a typedef of - %% an array definition - case ic_options:get_opt(G, be) of - noc -> - mkFileArrObj(G,N,X,erlang); - _ -> - %% Search the table to see if the type is local or - %% inherited. - PTab = ic_genobj:pragmatab(G), - Id = ic_forms:get_id2(X), - case ets:match(PTab,{file_data_local,'_','_', - typedef,N,Id, - ic_util:to_undersc([Id | N]), - '_','_'}) of - [[]] -> - %% Local, create erlang file for the array - mkFileArrObj(G,N,X,erlang); - _ -> - %% Inherited, do nothing - ok - end - end; - - {typedef,{sequence,_,_},_,{tk_sequence,_,_}} -> - %% Sequence but not a typedef of - %% a typedef of a sequence definition - case ic_options:get_opt(G, be) of - noc -> - mkFileRecObj(G,N,X,erlang); - _ -> - %% Search the table to see if the type is local or - %% inherited. - PTab = ic_genobj:pragmatab(G), - Id = ic_forms:get_id2(X), - case ets:match(PTab,{file_data_local,'_','_',typedef, - N,Id, - ic_util:to_undersc([Id | N]), - '_','_'}) of - [[]] -> - %% Local, create erlang file for the sequence - mkFileRecObj(G,N,X,erlang); - _ -> - %% Inherited, do nothing - ok - end - end; - _ -> - ok - end; -emit_typedef(G, N, X, c) -> - B = ic_forms:get_body(X), - if - is_record(B, sequence) -> - emit_sequence_head_def(G, N, X, B, c); - true -> - lists:foreach(fun(D) -> - emit_typedef(G, N, D, B, c) - end, - ic_forms:get_idlist(X)) - end. - -emit_typedef(G, N, D, Type, c) when is_record(D, array) -> - emit_array(G, N, D, Type); -emit_typedef(G, N, D, Type, c) -> - Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), - CType = ic_cbe:mk_c_type(G, N, Type), - TDType = mk_base_type(G, N, Type), - ic_code:insert_typedef(G, Name, TDType), - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Type definition ~s " - "for type ~s", - [Name, CType])], - c), - emit(Fd, "typedef ~s ~s;\n", - [CType, Name]), - emit(Fd, "\n#endif\n\n"), - ic_codegen:nl(Fd); - false -> - ok - end. - - -mk_base_type(G, N, S) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - Type -> - Type - end; -mk_base_type(_G, _N, S) -> - S. - -emit_array(G, N, D, Type) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), - {_, _, ArrayTK, _} = - ic_symtab:get_full_scoped_name(G, N, - ic_symtab:scoped_id_new( - ic_forms:get_id(D))), - Dim = extract_dim(ArrayTK), - CType = ic_cbe:mk_c_type(G, N, Type), - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Array definition ~s " - "for type ~s", - [Name, CType])], - c), - emit(Fd, "typedef ~s ~s~s;\n", - [CType, Name, ic_cbe:mk_dim(Dim)]), - emit(Fd, "typedef ~s ~s_slice~s;\n", - [CType, Name, ic_cbe:mk_slice_dim(Dim)]), - ic_codegen:nl(Fd), - create_c_array_coding_file(G, N, {Name, Dim}, Type, typedef), - emit(Fd, "\n#endif\n\n"); - false -> - ok - end. - -open_c_coding_file(G, Name) -> - SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), - FName = - ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), - case file:open(FName, [write]) of - {ok, Fd} -> - {Fd, SName}; - Other -> - exit(Other) - end. - - - -create_c_array_coding_file(G, N, {Name, Dim}, Type, TypeDefFlag) -> - - {Fd , SName} = open_c_coding_file(G, Name), - HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - HrlFName = filename:basename(ic_genobj:include_file(G)), - ic_codegen:emit_stub_head(G, Fd, SName, c), - emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile - %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - %% HrlFName = filename:basename(ic_genobj:include_file(G)), - %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - put(op_variable_count, 0), - put(tmp_declarations, []), - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", - [ic_util:mk_oe_name(G, "sizecalc_"), Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, " - "int* oe_size) {\n", [ic_util:mk_oe_name(G, "sizecalc_"), Name]), - - emit(Fd, " int oe_malloc_size = 0;\n",[]), - emit(Fd, " int oe_error_code = 0;\n",[]), - emit(Fd, " int oe_type = 0;\n",[]), - emit(Fd, " int oe_array_size = 0;\n",[]), - - {ok, RamFd} = ram_file:open([], [binary, write]), - - emit_sizecount(array, G, N, nil, RamFd, {Name, Dim}, Type), - - ic_cbe:emit_tmp_variables(Fd), - ic_codegen:nl(Fd), - %% Move data from ram file to output file. - {ok, Data} = ram_file:get_file(RamFd), - emit(Fd, Data), - ram_file:close(RamFd), - - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n",[]), - - put(op_variable_count, 0), - put(tmp_declarations, []), - - RefStr = get_refStr(Dim), - - case TypeDefFlag of - typedef -> - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n", - [ic_util:mk_oe_name(G, "encode_"), Name, Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n", - [ic_util:mk_oe_name(G, "encode_"), Name, Name]); - no_typedef -> - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s);\n", - [ic_util:mk_oe_name(G, "encode_"), - Name, - ic_cbe:mk_c_type(G, N, Type), - RefStr]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s) {\n", - [ic_util:mk_oe_name(G, "encode_"), - Name, - ic_cbe:mk_c_type(G, N, Type), - RefStr]) - end, - - emit(Fd, " int oe_error_code = 0;\n",[]), - - {ok, RamFd1} = ram_file:open([], [binary, write]), - - case TypeDefFlag of - typedef -> - emit_encode(array, G, N, nil, RamFd1, {Name, Dim}, Type); - no_typedef -> - emit_encode(array_no_typedef, G, N, nil, RamFd1, {Name, Dim}, Type) - end, - - ic_cbe:emit_tmp_variables(Fd), - ic_codegen:nl(Fd), - %% Move data from ram file to output file. - {ok, Data1} = ram_file:get_file(RamFd1), - emit(Fd, Data1), - ram_file:close(RamFd1), - - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n",[]), - - put(op_variable_count, 0), - put(tmp_declarations, []), - - case TypeDefFlag of - typedef -> - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, " - "int*, ~s);\n", - [ic_util:mk_oe_name(G, "decode_"), Name, Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " - "int* oe_outindex, ~s oe_out) {\n", - [ic_util:mk_oe_name(G, "decode_"), Name, Name]); - no_typedef -> - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, " - "~s oe_rec~s);\n", - [ic_util:mk_oe_name(G, "decode_"), - Name, - ic_cbe:mk_c_type(G, N, Type), - RefStr]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " - "int* oe_outindex, ~s oe_out~s) {\n", - [ic_util:mk_oe_name(G, "decode_"), - Name, - ic_cbe:mk_c_type(G, N, Type), - RefStr]) - end, - - emit(Fd, " int oe_error_code = 0;\n",[]), - emit(Fd, " int oe_array_size = 0;\n",[]), - - {ok, RamFd2} = ram_file:open([], [binary, write]), - - case TypeDefFlag of - typedef -> - emit_decode(array, G, N, nil, RamFd2, {Name, Dim}, Type); - no_typedef -> - emit_decode(array_no_typedef, G, N, nil, RamFd2, {Name, Dim}, Type) - end, - - - ic_cbe:emit_tmp_variables(Fd), - ic_codegen:nl(Fd), - %% Move data from ram file to output file. - {ok, Data2} = ram_file:get_file(RamFd2), - emit(Fd, Data2), - ram_file:close(RamFd2), - - emit(Fd, " *oe_outindex = ~s;\n\n",[align("*oe_outindex")]), - - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n",[]), - file:close(Fd). - - -get_refStr([]) -> - ""; -get_refStr([X|Xs]) -> - "[" ++ X ++ "]" ++ get_refStr(Xs). - - -emit_sequence_head_def(G, N, X, T, c) -> - %% T is the sequence - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - SeqName = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(SeqName)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(SeqName)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Struct definition: ~s", - [SeqName])], - c), - emit(Fd, "typedef struct {\n"), - emit(Fd, " CORBA_unsigned_long _maximum;\n"), - emit(Fd, " CORBA_unsigned_long _length;\n"), - emit_seq_buffer(Fd, G, N, T#sequence.type), - emit(Fd, "} ~s;\n\n", [SeqName]), - create_c_struct_coding_file(G, N, X, T, SeqName, - T#sequence.type, sequence_head), - emit(Fd, "\n#endif\n\n"); - - false -> - ok - end. - -emit_seq_buffer(Fd, G, N, Type) -> - emit(Fd, " ~s* _buffer;\n", - [ic_cbe:mk_c_type(G, N, Type)]). - -%%------------------------------------------------------------ -%% -%% Emit decode bodies for functions in C for array, sequences and -%% structs. -%% -%%------------------------------------------------------------ -emit_decode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> - emit(Fd, " if((char*) oe_out == oe_first)\n",[]), - AlignName = - lists:concat(["*oe_outindex + ", dim_multiplication(Dim), - " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), - emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), - array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array); -emit_decode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> - emit(Fd, " if((char*) oe_out == oe_first)\n",[]), - AlignName = - lists:concat(["*oe_outindex + ", dim_multiplication(Dim), - " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), - emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), - array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array_no_typedef); -emit_decode(sequence_head, G, N, T, Fd, SeqName, ElType) -> - ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), - ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), - ic_cbe:store_tmp_decl(" int oe_seq_dummy = 0;\n", []), - - TmpBuf = - case ictype:isBasicTypeOrEterm(G, N, ElType) of - true -> - Tmp = "oe_seq_tmpbuf", - ic_cbe:store_tmp_decl(" char* ~s = 0;\n", [Tmp]), - Tmp; - false -> - "NOT USED" - end, - - MaxSize = get_seq_max(T), - emit(Fd, " if((char*) oe_out == oe_first)\n",[]), - emit(Fd, " *oe_outindex = ~s;\n\n", - [align(["*oe_outindex + sizeof(", SeqName, ")"])]), - - Ctype = ic_cbe:mk_c_type(G, N, ElType), - emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " - "&oe_env->_iin, &oe_seq_len)) < 0) {\n"), - case ictype:isBasicTypeOrEterm(G, N, ElType) of - true -> - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, " - "&oe_type, &oe_seq_len);\n\n"), - - if - MaxSize == infinity -> - ok; - true -> - emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " - "\"Length of sequence `~s' out of bound\");\n" - " return -1;\n }\n", [SeqName]) - end, - emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), - emit(Fd, " oe_out->_length = oe_seq_len;\n"), - emit(Fd, " oe_out->_buffer = (void *) (oe_first + " - "*oe_outindex);\n"), - emit(Fd, " *oe_outindex = ~s;\n", - [align(["*oe_outindex + (sizeof(", Ctype, ") * " - "oe_out->_length)"])]), - emit(Fd, - " if ((~s = malloc(oe_seq_len + 1)) == NULL) {\n" - " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "NO_MEMORY, \"Cannot malloc\");\n" - " return -1;\n" - " }\n", [TmpBuf]), - emit(Fd, " if ((oe_error_code = ei_decode_string(" - "oe_env->_inbuf, &oe_env->_iin, ~s)) < 0) {\n", [TmpBuf]), - emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]), - emit_c_dec_rpt(Fd, " ", "string1", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " for (oe_seq_count = 0; " - "oe_seq_count < oe_out->_length; oe_seq_count++)\n"), - case ictype:isBasicType(G, N, ElType) of - true -> - emit(Fd, " oe_out->_buffer[oe_seq_count] = (unsigned char) " - "~s[oe_seq_count];\n\n", [TmpBuf]); - false -> %% Term - emit(Fd, " oe_out->_buffer[oe_seq_count] = " - "erl_mk_int(~s[oe_seq_count]);\n\n",[TmpBuf]) % XXXX What? - end, - emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]); - false -> - emit(Fd, " return oe_error_code;\n") - end, - - emit(Fd, " } else {\n"), - - if - MaxSize == infinity -> - ok; - true -> - emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " - "\"Length of sequence `~s' out of bound\");\n" - " return -1;\n }\n", [SeqName]) - end, - - emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), - emit(Fd, " oe_out->_length = oe_seq_len;\n"), - emit(Fd, " oe_out->_buffer = (void *) (oe_first + *oe_outindex);\n"), - emit(Fd, " *oe_outindex = ~s;\n\n", - [align(["*oe_outindex + (sizeof(", Ctype, ") * oe_out->_length)"])]), - - if - Ctype == "CORBA_char *" -> - emit(Fd, " for (oe_seq_count = 0; " - "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), - emit(Fd, " oe_out->_buffer[oe_seq_count] = " - "(void*) (oe_first + *oe_outindex);\n\n"), - ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, - "oe_out->_buffer[oe_seq_count]", - "", - "oe_env->_inbuf", 0, "", caller_dyn), - emit(Fd, " *oe_outindex = ~s;", - [align(["*oe_outindex + strlen(oe_out->_buffer[" - "oe_seq_count]) + 1"])]); - true -> - emit(Fd, " for (oe_seq_count = 0; " - "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), - case ictype:isArray(G, N, ElType) of - %% XXX Silly. There is no real difference between the - %% C statements produced by the following calls. - true -> - ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, - "oe_out->_buffer[oe_seq_count]", - "", - "oe_env->_inbuf", - 0, "oe_outindex", generator); - false -> - ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, - "oe_out->_buffer + oe_seq_count", - "", - "oe_env->_inbuf", - 0, "oe_outindex", generator) - end - end, - emit(Fd, " }\n"), - emit(Fd, " if (oe_out->_length != 0) {\n"), - emit(Fd, " if ((oe_error_code = ei_decode_list_header(" - "oe_env->_inbuf, &oe_env->_iin, &oe_seq_dummy)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " } else\n"), - emit(Fd, " oe_out->_buffer = NULL;\n"), - emit(Fd, " }\n"); - -emit_decode(struct, G, N, _T, Fd, StructName, ElTypes) -> - Length = length(ElTypes) + 1, - Tname = ic_cbe:mk_variable_name(op_variable_count), - Tname1 = ic_cbe:mk_variable_name(op_variable_count), - - ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), - ic_cbe:store_tmp_decl(" char ~s[256];\n\n",[Tname1]), - - emit(Fd, " if((char*) oe_out == oe_first)\n",[]), - AlignName = lists:concat(["*oe_outindex + sizeof(",StructName,")"]), - emit(Fd, " *oe_outindex = ~s;\n\n", [align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " - "&oe_env->_iin, &~s)) < 0) {\n", [Tname]), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), - emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Length]), - emit(Fd, " return -1;\n }\n"), - - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, " - "&oe_env->_iin, ~s)) < 0) {\n", [Tname1]), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(~s, ~p) != 0)\n",[Tname1, StructName]), - emit(Fd, " return -1;\n\n"), - lists:foreach( - fun({ET, EN}) -> - case ic_cbe:is_variable_size(G, N, ET) of - true -> - case ET of - - {struct, _, _, _} -> - %% Sequence member = a struct - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_out->" ++ EN, - "", "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {sequence, _, _} -> - %% Sequence member = a struct XXX ?? - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - EN, - "&oe_out->" ++ EN, - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - {_,{array, _, _}} -> - emit(Fd, " oe_out->~s = (void *) " - "(oe_first+*oe_outindex);\n\n",[EN]), - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - EN, "oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {union, _, _, _, _} -> - %% Sequence member = a union - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_out->" ++ EN, - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {string,_} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator_malloc); - - {scoped_id,_,_,_} -> - case ictype:member2type(G,StructName,EN) of - array -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - struct -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN , - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - sequence -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - union -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - _ -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator) - end; - - _ -> - emit(Fd, " oe_out->~s = (void *) " - "(oe_first+*oe_outindex);\n\n",[EN]), - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, "oe_outindex", - generator) - end; - false -> - case ET of - - {struct, _, _, _} -> - %% A struct member - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {_,{array, _, _}} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - EN, - "oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {union, _, _, _, _} -> - %% Sequence member = a union - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {_,_} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - {scoped_id,_,_,_} -> - case ic_symtab:get_full_scoped_name(G, N, ET) of - {_FullScopedName, _, {tk_array,_,_}, _} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - {_FullScopedName, _, {tk_string,_}, _} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - {_FullScopedName, _, {tk_struct,_,_,_}, _} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - - {_FullScopedName, _, - {tk_union,_,_,_,_,_}, _} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - - _ -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator) - end - end - end - end, - ElTypes). - - -ref_array_static_dec(array, true) -> - %% Typedef, Static, Basic Type - "&(oe_out)"; -ref_array_static_dec(array, false) -> - %% Typedef, Static, Constr Type - "&(oe_out)"; -ref_array_static_dec(array_no_typedef, true) -> - %% No Typedef, Static, Basic Type - "&oe_out"; -ref_array_static_dec(array_no_typedef, false) -> - %% No Typedef, Static, Constr Type - "&oe_out". - - -ref_array_dynamic_dec(G, N, T, array) -> - case ictype:isString(G, N, T) of - true -> % Typedef, Dynamic, String - "oe_out"; - false -> % Typedef, Dynamic, No String - "&(oe_out)" - end; -ref_array_dynamic_dec(G, N, T, array_no_typedef) -> - case ictype:isString(G, N, T) of - true -> % No Typedef, Dynamic, String - "oe_out"; - false -> % No Typedef, Dynamic, No String - "&oe_out" - end. - - - -array_decode_dimension_loop(G, N, Fd, [Dim], Dimstr, Type, TDFlag) -> - Tname = ic_cbe:mk_variable_name(op_variable_count), - ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " - "&oe_env->_iin, &oe_array_size)) < 0) {\n", - []), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - %% This is disabled due to a bug in erl_interface : - %% tuples inside tuples hae no correct data about the size - %% of the tuple........( allways = 0 ) - %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), - %%emit(Fd, " return -1;\n\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - - - ArrAccess = - case ic_cbe:is_variable_size(G, N, Type) of - true -> - ref_array_dynamic_dec(G, N, Type, TDFlag) ++ - Dimstr ++ "[" ++ Tname ++ "]"; - false -> - ref_array_static_dec(TDFlag, ictype:isBasicType(G,N,Type)) ++ - Dimstr ++ "[" ++ Tname ++ "]" - end, - - ic_cbe:emit_decoding_stmt(G, N, Fd, Type, - ArrAccess, - "", "oe_env->_inbuf", 0, - "oe_outindex", generator), - - %% emit(Fd, "\n *oe_outindex += - %% sizeof(~s);\n",[ic_cbe:mk_c_type(G, N, Type)]), - emit(Fd, " }\n"); -array_decode_dimension_loop(G, N, Fd, [Dim | Ds], _Dimstr, Type, TDFlag) -> - Tname = ic_cbe:mk_variable_name(op_variable_count), - ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " - "&oe_env->_iin, &oe_array_size)) < 0) {\n", - []), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - %% This is disabled due to a bug in erl_interface : - %% tuples inside tuples hae no correct data about the size - %% of the tuple........( allways = 0 ) - %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), - %%emit(Fd, " return -1;\n\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - array_decode_dimension_loop(G, N, Fd, Ds, "[" ++ Tname ++ "]" , Type, - TDFlag), - - emit(Fd, " }\n"). - -dim_multiplication([D]) -> - D; -dim_multiplication([D |Ds]) -> - D ++ "*" ++ dim_multiplication(Ds). - -emit_encode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> - array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, array); -emit_encode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> - array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, - array_no_typedef); -emit_encode(sequence_head, G, N, T, Fd, SeqName, ElType) -> - Tname = ic_cbe:mk_variable_name(op_variable_count), - ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), - - MaxSize = get_seq_max(T), - if - MaxSize == infinity -> - ok; - true -> - emit(Fd, " if (oe_rec->_length > ~w) {\n", [MaxSize]), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "DATA_CONVERSION, \"Length of sequence `~s' " - "out of bound\");\n" - " return -1;\n }\n", [SeqName]) - end, - - emit(Fd, " if (oe_rec->_length != 0) {\n"), - - emit(Fd, " if ((oe_error_code = oe_ei_encode_list_header(oe_env, " - "oe_rec->_length)) < 0) {\n", - []), - emit_c_enc_rpt(Fd, " ", "oi_ei_encode_list_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " for (~s = 0; ~s < oe_rec->_length; ~s++) {\n", - [Tname, Tname, Tname]), - case ElType of - {_,_} -> %% ElType = elementary type or pointer type - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ - Tname ++ "]", "oe_env->_outbuf"); - - {scoped_id,local,_,["term","erlang"]} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ - Tname ++ "]", "oe_env->_outbuf"); - - {scoped_id,_,_,_} -> - case ic_symtab:get_full_scoped_name(G, N, ElType) of - {_, typedef, TDef, _} -> - case TDef of - {tk_struct,_,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf"); - {tk_sequence,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf"); - {tk_union,_,_,_,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf"); - _ -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf") - end; - {_,enum,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf"); - _ -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf") - end; - - _ -> %% ElType = structure - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ Tname ++ "]", - "oe_env->_outbuf") - end, - emit(Fd, " }\n"), - emit(Fd, " }\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_empty_list(oe_env)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_empty_list", []), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encode(struct, G, N, _T, Fd, StructName, ElTypes) -> - Length = length(ElTypes) + 1, - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_tuple_header(oe_env, ~p)) < 0) {\n", [Length]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, ~p)) < 0) {\n", [StructName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - lists:foreach( - fun({ET, EN}) -> - case ET of - {sequence, _, _} -> - %% Sequence = struct - ic_cbe:emit_encoding_stmt(G, N, Fd, - StructName ++ "_" ++ EN, - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - {_,{array, _, _Dims}} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - StructName ++ "_" ++ EN, - "oe_rec->" ++ EN, - "oe_env->_outbuf"); - - {union,_,_,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - - {struct,_,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - - {scoped_id,_,_,_} -> - case ictype:member2type(G,StructName,EN) of - struct -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - sequence -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - union -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - array -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "oe_rec->" ++ EN, - "oe_env->_outbuf"); - _ -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "oe_rec->" ++ EN, - "oe_env->_outbuf") - end; - _ -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "oe_rec->" ++ EN, - "oe_env->_outbuf") - end - end, - ElTypes). - -ref_array_static_enc(array, true) -> - %% Typedef, Static, Basic Type - "oe_rec"; -ref_array_static_enc(array, false) -> - %% Typedef, Static, Constr Type - "&(oe_rec)"; -ref_array_static_enc(array_no_typedef, true) -> - %% No Typedef, Static, Basic Type - "oe_rec"; -ref_array_static_enc(array_no_typedef, false) -> - %% No Typedef, Static, Constr Type - "&oe_rec". - - -ref_array_dynamic_enc(G, N, T, array) -> - case ictype:isString(G, N, T) of - true -> % Typedef, Dynamic, String - "oe_rec"; - false -> % Typedef, Dynamic, No String - "&(oe_rec)" - end; -ref_array_dynamic_enc(G, N, T, array_no_typedef) -> - case ictype:isString(G, N, T) of - true -> % No Typedef, Dynamic, String - "oe_rec"; - false -> % No Typedef, Dynamic, No String - "&oe_rec" - end. - - - -array_encode_dimension_loop(G, N, Fd, [Dim], {Str1,_Str2}, Type, TDFlag) -> - Tname = ic_cbe:mk_variable_name(op_variable_count), - ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), - - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - - ArrAccess = - case ic_cbe:is_variable_size(G, N, Type) of - true -> - ref_array_dynamic_enc(G, N, Type, TDFlag) ++ - Str1 ++ "[" ++ Tname ++ "]"; - false -> - ref_array_static_enc(TDFlag, ictype:isBasicType(G,N,Type)) ++ - Str1 ++ "[" ++ Tname ++ "]" - end, - - ic_cbe:emit_encoding_stmt(G, N, Fd, Type, ArrAccess, "oe_env->_outbuf"), - emit(Fd, " }\n"); -array_encode_dimension_loop(G, N, Fd, [Dim | Ds],{Str1,Str2}, Type, TDFlag) -> - Tname = ic_cbe:mk_variable_name(op_variable_count), - ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), - - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - array_encode_dimension_loop(G, N, Fd, Ds, - {Str1 ++ "[" ++ Tname ++ "]", Str2}, - Type, TDFlag), - emit(Fd, " }\n"). - - -emit_sizecount(array, G, N, _T, Fd, {_Name, Dim}, Type) -> - emit(Fd, " if(*oe_size == 0)\n",[]), - AlignName = lists:concat(["*oe_size + ", dim_multiplication(Dim), - " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), - emit(Fd, " *oe_size = ~s;\n\n",[align(AlignName)]), - array_size_dimension_loop(G, N, Fd, Dim, Type), - emit(Fd, " *oe_size = ~s;\n\n", - [align("*oe_size + oe_malloc_size")]), - ic_codegen:nl(Fd); - -emit_sizecount(sequence_head, G, N, T, Fd, SeqName, ElType) -> - ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), - ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), - - emit(Fd, " if(*oe_size == 0)\n",[]), - emit(Fd, " *oe_size = ~s;\n\n", - [align(["*oe_size + sizeof(", SeqName, ")"])]), - - MaxSize = get_seq_max(T), - - emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, " - "oe_size_count_index, &oe_type, &oe_seq_len)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - - if - MaxSize == infinity -> - ok; - true -> - emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "DATA_CONVERSION, \"Length of sequence `~s' " - "out of bound\");\n" - " return -1;\n }\n", [SeqName]) - end, - - CType = ic_cbe:mk_c_type(G, N, ElType), - - emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " - "oe_size_count_index, NULL)) < 0) {\n"), - - case ictype:isBasicTypeOrEterm(G, N, ElType) of - true -> - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->" - "_inbuf, oe_size_count_index, NULL)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " oe_malloc_size = ~s;\n\n", - [align(["sizeof(", CType, ") * oe_seq_len"])]); - false -> - emit_c_dec_rpt(Fd, " ", "non mea culpa", []), - emit(Fd, " return oe_error_code;\n\n") - end, - - emit(Fd, " } else {\n"), - - emit(Fd, " oe_malloc_size = ~s;\n\n", - [align(["sizeof(", CType, ") * oe_seq_len"])]), - - emit(Fd, " for (oe_seq_count = 0; oe_seq_count < oe_seq_len; " - "oe_seq_count++) {\n"), - ic_cbe:emit_malloc_size_stmt(G, N, Fd, ElType, - "oe_env->_inbuf", 0, generator), - emit(Fd, " }\n"), - - emit(Fd, " if (oe_seq_len != 0) \n"), - emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf," - "oe_size_count_index, NULL)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " }\n"), - emit(Fd, " *oe_size = ~s;\n\n", [align("*oe_size + oe_malloc_size")]); - -emit_sizecount(struct, G, N, _T, Fd, StructName, ElTypes) -> - Length = length(ElTypes) + 1, - Tname = ic_cbe:mk_variable_name(op_variable_count), - ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), - - emit(Fd, " if(*oe_size == 0)\n",[]), - AlignName = lists:concat(["*oe_size + sizeof(",StructName,")"]), - emit(Fd, " *oe_size = ~s;\n\n", [align(AlignName)]), - ic_codegen:nl(Fd), - - emit(Fd, " if ((oe_error_code = " - "ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, " - "&~s)) < 0) {\n", [Tname]), - emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), - emit_c_dec_rpt(Fd, " ", "~s != ~p", [Tname, Length]), - emit(Fd, " return -1;\n }\n"), - - - emit(Fd, " if ((oe_error_code = " - "ei_decode_tuple_header(oe_env->_inbuf, " - "oe_size_count_index, 0)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if ((oe_error_code = " - "ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - lists:foreach( - fun({ET, EN}) -> - case ic_cbe:is_variable_size(G, N, ET) of - true -> - case ET of - {sequence, _, _} -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - StructName ++ "_" ++ EN, - "oe_env->_inbuf", - 0, - generator); - {_,{array, _, _}} -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - StructName ++ "_" ++ EN, - "oe_env->_inbuf", - 0, - generator); - {union,_,_,_,_} -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - StructName ++ "_" ++ ic_forms:get_id2(ET), - "oe_env->_inbuf", - 0, - generator); - - {struct,_,_,_} -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - StructName ++ "_" ++ ic_forms:get_id2(ET), - "oe_env->_inbuf", - 0, - generator); - - _ -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - ET, - "oe_env->_inbuf", - 0, - generator) - end; - false -> - case ET of - {_,{array, _, _}} -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - StructName ++ "_" ++ EN, - "oe_env->_inbuf", - 0, - generator); - - {union,_,_,_,_} -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - StructName ++ "_" ++ ic_forms:get_id2(ET), - "oe_env->_inbuf", - 0, - generator); - - {struct,_,_,_} -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - StructName ++ "_" ++ ic_forms:get_id2(ET), - "oe_env->_inbuf", - 0, - generator); - _ -> - ic_cbe:emit_malloc_size_stmt( - G, N, Fd, - ET, - "oe_env->_inbuf", - 1, - generator) - end - end - end, - ElTypes), - - emit(Fd, " *oe_size = ~s;\n\n", - [align("*oe_size + oe_malloc_size")]). - - -array_size_dimension_loop(G, N, Fd, [Dim], Type) -> - Tname = ic_cbe:mk_variable_name(op_variable_count), - - ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), - emit(Fd, " if ((oe_error_code = " - "ei_get_type(oe_env->_inbuf, oe_size_count_index, " - "&oe_type, &oe_array_size)) < 0) {\n", - []), - emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]), - emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]), - emit(Fd, " return -1;\n }\n"), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " - "oe_size_count_index, 0)) < 0) {\n", []), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - ic_cbe:emit_malloc_size_stmt(G, N, Fd, - Type, "oe_env->_inbuf", 0, generator), - emit(Fd, " }\n"); -array_size_dimension_loop(G, N, Fd, [Dim | Ds], Type) -> - Tname = ic_cbe:mk_variable_name(op_variable_count), - - ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), - emit(Fd, " if ((oe_error_code = " - "ei_get_type(oe_env->_inbuf, oe_size_count_index, " - "&oe_type, &oe_array_size)) < 0) {\n", []), - emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]), - emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]), - emit(Fd, " return -1;\n }\n"), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " - "oe_size_count_index, 0)) < 0) {\n", - []), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - array_size_dimension_loop(G, N, Fd, Ds, Type), - emit(Fd, " }\n"). - - -create_c_struct_coding_file(G, N, _X, T, StructName, ElTypes, StructType) -> - - {Fd , SName} = open_c_coding_file(G, StructName), % stub file - HFd = ic_genobj:hrlfiled(G), % stub header file - HrlFName = filename:basename(ic_genobj:include_file(G)), - - ic_codegen:emit_stub_head(G, Fd, SName, c), - HrlFName = filename:basename(ic_genobj:include_file(G)), - emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - - %% Size count - - put(op_variable_count, 0), - put(tmp_declarations, []), - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", - [ic_util:mk_oe_name(G, "sizecalc_"), StructName]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, " - "int* oe_size_count_index, int* oe_size)\n{\n", - [ic_util:mk_oe_name(G, "sizecalc_"), StructName]), - - emit(Fd, " int oe_malloc_size = 0;\n",[]), - emit(Fd, " int oe_error_code = 0;\n",[]), - emit(Fd, " int oe_type = 0;\n",[]), - - {ok, RamFd} = ram_file:open([], [binary, write]), - - emit_sizecount(StructType, G, N, T, RamFd, StructName, ElTypes), - - ic_cbe:emit_tmp_variables(Fd), - ic_codegen:nl(Fd), - %% Move data from ram file to output file. - {ok, Data} = ram_file:get_file(RamFd), - emit(Fd, Data), - ram_file:close(RamFd), - - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n\n",[]), - - %% Encode - - put(op_variable_count, 0), - put(tmp_declarations, []), - - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n", - [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec)\n{\n", - [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]), - - emit(Fd, " int oe_error_code = 0;\n",[]), - - {ok, RamFd1} = ram_file:open([], [binary, write]), - - emit_encode(StructType, G, N, T, RamFd1, StructName, ElTypes), - - ic_cbe:emit_tmp_variables(Fd), - ic_codegen:nl(Fd), - %% Move data from ram file to output file. - {ok, Data1} = ram_file:get_file(RamFd1), - emit(Fd, Data1), - ram_file:close(RamFd1), - - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n\n",[]), - - %% Decode - - put(op_variable_count, 0), - put(tmp_declarations, []), - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n", - [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " - "int* oe_outindex, " - "~s *oe_out)\n{\n", - [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]), - - emit(Fd, " int oe_error_code = 0;\n",[]), - - {ok, RamFd2} = ram_file:open([], [binary, write]), - - emit_decode(StructType, G, N, T, RamFd2, StructName, ElTypes), - - ic_cbe:emit_tmp_variables(Fd), - ic_codegen:nl(Fd), - %% Move data from ram file to output file. - {ok, Data2} = ram_file:get_file(RamFd2), - emit(Fd, Data2), - ram_file:close(RamFd2), - - emit(Fd, " *oe_outindex = ~s;\n",[align("*oe_outindex")]), - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n\n",[]), - file:close(Fd). - - -%%------------------------------------------------------------ -%% -%% emit primitive for unions. -%% -%%------------------------------------------------------------ -emit_union(G, N, X, erlang) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - ic_codegen:record(G, X, - ic_util:to_undersc([ic_forms:get_id2(X) | N]), - nil,nil), - mkFileRecObj(G,N,X,erlang); - false -> ok - end; -emit_union(_G, _N, _X, c) -> %% Not supported in c backend - true. - - -%%------------------------------------------------------------ -%% -%% emit erlang modules for objects with record definitions -%% (such as unions or structs), or sequences -%% -%% The record files, other than headers are only generated -%% for CORBA...... If wished an option could allows even -%% for other backends ( not necessary anyway ) -%% -%%------------------------------------------------------------ -mkFileRecObj(G,N,X,erlang) -> - case ic_options:get_opt(G, be) of - erl_corba -> - SName = - ic_util:to_undersc([ic_forms:get_id2(X) | N]), - FName = - ic_file:join(ic_options:get_opt(G, stubdir), - ic_file:add_dot_erl(SName)), - - case file:open(FName, [write]) of - {ok, Fd} -> - HrlFName = filename:basename(ic_genobj:include_file(G)), - - ic_codegen:emit_stub_head(G, Fd, SName, erlang), - emit(Fd, "-include(~p).\n\n",[HrlFName]), - emit_exports(G,Fd), - emit_rec_methods(G,N,X,SName,Fd), - ic_codegen:nl(Fd), - ic_codegen:nl(Fd), - file:close(Fd); - Other -> - exit(Other) - end; - _ -> - true - end. - - -%%------------------------------------------------------------ -%% -%% emit erlang modules for objects with array definitions.. -%% -%%------------------------------------------------------------ -mkFileArrObj(G,N,X,erlang) -> - SName = - ic_util:to_undersc([ic_forms:get_id2(X) | N]), - FName = - ic_file:join(ic_options:get_opt(G, stubdir), - ic_file:add_dot_erl(SName)), - - case file:open(FName, [write]) of - {ok, Fd} -> - HrlFName = filename:basename(ic_genobj:include_file(G)), - - ic_codegen:emit_stub_head(G, Fd, SName, erlang), - emit(Fd, "-include(~p).\n\n",[HrlFName]), - emit_exports(G,Fd), - emit_arr_methods(G,N,X,SName,Fd), - ic_codegen:nl(Fd), - ic_codegen:nl(Fd), - file:close(Fd); - Other -> - exit(Other) - end. - - - - -%%------------------------------------------------------------ -%% -%% emit exports for erlang modules which represent records. -%% -%%------------------------------------------------------------ -emit_exports(G,Fd) -> - case ic_options:get_opt(G, be) of - erl_corba -> - emit(Fd, "-export([tc/0,id/0,name/0]).\n\n\n\n",[]); - _ -> - emit(Fd, "-export([id/0,name/0]).\n\n\n\n",[]) - end. - - -%%------------------------------------------------------------ -%% -%% emit erlang module functions which represent records, yields -%% record information such as type code, identity and name. -%% -%%------------------------------------------------------------ -emit_rec_methods(G,N,X,Name,Fd) -> - - IR_ID = ictk:get_IR_ID(G, N, X), - - case ic_options:get_opt(G, be) of - - erl_corba -> - TK = ic_forms:get_tk(X), - - case TK of - undefined -> - STK = ic_forms:search_tk(G,ictk:get_IR_ID(G, N, X)), - emit(Fd, "%% returns type code\n",[]), - emit(Fd, "tc() -> ~p.\n\n",[STK]), - emit(Fd, "%% returns id\n",[]), - emit(Fd, "id() -> ~p.\n\n",[IR_ID]), - emit(Fd, "%% returns name\n",[]), - emit(Fd, "name() -> ~p.\n\n",[Name]); - _ -> - emit(Fd, "%% returns type code\n",[]), - emit(Fd, "tc() -> ~p.\n\n",[TK]), - emit(Fd, "%% returns id\n",[]), - emit(Fd, "id() -> ~p.\n\n",[IR_ID]), - emit(Fd, "%% returns name\n",[]), - emit(Fd, "name() -> ~p.\n\n",[Name]) - end; - - _ -> - emit(Fd, "%% returns id\n",[]), - emit(Fd, "id() -> ~p.\n\n",[IR_ID]), - emit(Fd, "%% returns name\n",[]), - emit(Fd, "name() -> ~p.\n\n",[Name]) - end. - - - -%%------------------------------------------------------------ -%% -%% emit erlang module functions which represent arrays, yields -%% record information such as type code, identity and name. -%% -%%------------------------------------------------------------ -emit_arr_methods(G,N,X,Name,Fd) -> - - IR_ID = ictk:get_IR_ID(G, N, X), - - case ic_options:get_opt(G, be) of - - erl_corba -> - - TK = ic_forms:get_type_code(G, N, X), - - emit(Fd, "%% returns type code\n",[]), - emit(Fd, "tc() -> ~p.\n\n",[TK]), - emit(Fd, "%% returns id\n",[]), - emit(Fd, "id() -> ~p.\n\n",[IR_ID]), - emit(Fd, "%% returns name\n",[]), - emit(Fd, "name() -> ~p.\n\n",[Name]); - - _ -> - - emit(Fd, "%% returns id\n",[]), - emit(Fd, "id() -> ~p.\n\n",[IR_ID]), - emit(Fd, "%% returns name\n",[]), - emit(Fd, "name() -> ~p.\n\n",[Name]) - end. - -get_seq_max(T) when is_record(T, sequence) andalso T#sequence.length == 0 -> - infinity; -get_seq_max(T) when is_record(T, sequence) andalso is_tuple(T#sequence.length) -> - list_to_integer(element(3, T#sequence.length)). - - -align(Cs) -> - ic_util:mk_align(Cs). - diff --git a/lib/ic/src/ictk.erl b/lib/ic/src/ictk.erl deleted file mode 100644 index 701d662776..0000000000 --- a/lib/ic/src/ictk.erl +++ /dev/null @@ -1,874 +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% -%% -%% --module(ictk). - - -%% Toplevel generation functions --export([reg_gen/3, unreg_gen/3]). - - -%% Utilities --export([get_IR_ID/3, get_IR_VSN/3, register_name/1, unregister_name/1]). - --import(ic_forms, [get_id2/1, get_body/1, get_idlist/1]). --import(ic_util, [mk_name/2, mk_oe_name/2, to_atom/1, to_list/1]). --import(ic_codegen, [emit/2, emit/3, nl/1]). - --include("icforms.hrl"). --include("ic.hrl"). - -%%-------------------------------------------------------------------- -%% -%% IFR Registration Generation -%% -%% -%%-------------------------------------------------------------------- - --define(IFRID(G), mk_name(G, "IFR")). --define(VARID(G), mk_name(G, "VAR")). --define(IFRMOD, orber_ifr). - -reg_gen(G, N, X) -> - S = ic_genobj:tktab(G), - Light = ic_options:get_opt(G, light_ifr), - init_var(), - case ic_genobj:is_stubfile_open(G) of - true when Light == false -> - Var = ?IFRID(G), - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), nl(Fd), - emit(Fd, "~p() ->\n", [to_atom(register_name(G))]), - emit(Fd, " ~s = ~p:find_repository(),\n", - [Var, ?IFRMOD]), - nl(Fd), - - %% Write call function that checks if included - %% modules and interfaces are created. - emit(Fd, " register_tests(~s),\n",[?IFRID(G)]), - - reg2(G, S, N, Var, X), - nl(Fd), - emit(Fd, " ok.\n"), - - %% Write general register test function. - register_tests(Fd,G), - - %% Write functopn that registers modules only if - %% they are not registered. - register_if_unregistered(Fd); - true when Light == true -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), nl(Fd), - Regname = to_atom(register_name(G)), - emit(Fd, "~p() ->\n\t~p([]).\n\n", [Regname, Regname]), - emit(Fd, "~p(OE_Options) ->\n\t~p:add_items(?MODULE, OE_Options,\n\t[", - [Regname, ?IFRMOD]), - reg_light(G, N, X), - emit(Fd, "ok]),\n\tok.\n"); - false -> - ok - end. - -reg_light(G, N, X) when is_list(X) -> - reg_light_list(G, N, X); -reg_light(G, N, X) when is_record(X, module) -> - reg_light_list(G, [get_id2(X) | N], get_body(X)); -reg_light(G, N, X) when is_record(X, struct) -> - emit(ic_genobj:stubfiled(G), "{~p, ~p, struct},\n\t", - [get_IR_ID(G, N, X), get_module(X, N)]); -reg_light(G, N, X) when is_record(X, except) -> - emit(ic_genobj:stubfiled(G), "{~p, ~p, except},\n\t", - [get_IR_ID(G, N, X), get_module(X, N)]); -reg_light(G, N, X) when is_record(X, union) -> - emit(ic_genobj:stubfiled(G), "{~p, ~p, union},\n\t", - [get_IR_ID(G, N, X), get_module(X, N)]); -reg_light(G, N, X) when is_record(X, interface) -> - emit(ic_genobj:stubfiled(G), "{~p, ~p, interface},\n\t", - [get_IR_ID(G, N, X), get_module(X, N)]), - reg_light_list(G, [get_id2(X)|N], get_body(X)); -reg_light(_G, _N, _X) -> - ok. - -get_module(X, N) -> - List = [get_id2(X) | N], - list_to_atom(lists:foldl(fun(E, Acc) -> E++"_"++Acc end, - hd(List), tl(List))). - -%% This function filters off all "#include <FileName>.idl" code that -%% come along from preprocessor and scanner. Produces code ONLY for -%% the actuall file. See ticket OTP-2133 -reg_light_list(_G, _N, []) -> []; -reg_light_list(G, N, List ) -> - CurrentFileName = ic_genobj:idlfile(G), - reg_light_list(G, N, {CurrentFileName,true}, List). - -%% The filter function + loop -reg_light_list(_G, _N, {_CFN, _Status}, []) -> []; -reg_light_list(G, N, {CFN,Status}, [X | Xs]) -> - case Status of - true -> - case X of - {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> - reg_light_list(G, N, {CFN,false}, Xs); - _ -> - reg_light(G, N, X), - reg_light_list(G, N, {CFN,Status}, Xs) - end; - false -> - case X of - {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> - reg_light(G, N, X), - reg_light_list(G, N, {CFN,true}, Xs); - _ -> - reg_light_list(G, N, {CFN,Status}, Xs) - end - end. - - -%% reg2 is top level registration - -reg2(G, S, N, Var, X) -> - reg2(G, S, N, "Repository_create_", Var, X). - -reg2(G, S, N, C, V, X) when is_list(X) -> reg2_list(G, S, N, C, V, X); - -reg2(G, S, N, C, V, X) when is_record(X, module) -> - NewV = r_emit2(G, S, N, C, V, X, "", []), - reg2_list(G, S, [get_id2(X) | N], "ModuleDef_create_", NewV, get_body(X)); - -reg2(G, S, N, C, V, X) when is_record(X, const) -> - r_emit2(G, S, N, C, V, X, ", ~s, ~p", - [get_idltype(G, S, N, X), {X#const.tk, X#const.val}]); - -reg2(G, S, N, C, V, X) when is_record(X, struct) -> - do_struct(G, S, N, C, V, X, ic_forms:get_tk(X)); - -reg2(G, S, N, C, V, X) when is_record(X, except) -> - do_except(G, S, N, C, V, X, ic_forms:get_tk(X)); - -reg2(G, S, N, C, V, X) when is_record(X, union) -> - do_union(G, S, N, C, V, X, ic_forms:get_tk(X)); - -reg2(G, S, N, C, V, X) when is_record(X, enum) -> - r_emit2(G, S, N, C, V, X, ", ~p", - [get_enum_member_list(G, S, N, get_body(X))]); - -reg2(G, S, N, C, V, X) when is_record(X, typedef) -> - do_typedef(G, S, N, C, V, X), - look_for_types(G, S, N, C, V, get_body(X)); - -reg2(G, S, N, C, V, X) when is_record(X, attr) -> - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> r_emit2(G, S, N, C, V, XX#id_of{id=Id}, ", ~s, ~p", - [get_idltype(G, S, N, X), get_mode(G, N, X)]) - end, - get_idlist(X)); - -reg2(G, S, N, C, V, X) when is_record(X, interface) -> - N2 = [get_id2(X) | N], - Body = get_body(X), - BIs = get_base_interfaces(G,X), %% produce code for the interface inheritance - NewV = r_emit2(G, S, N, C, V, X, ", " ++ BIs,[]), - reg2_list(G, S, N2, "InterfaceDef_create_", NewV, Body); - - -reg2(G, S, N, C, V, X) when is_record(X, op) -> - r_emit2(G, S, N, C, V, X, ", ~s, ~p, [~s], [~s], ~p", - [get_idltype(G, S, N, X), get_mode(G, N, X), - get_params(G, S, N, X#op.params), get_exceptions(G, S, N, X), - get_context(G, S, N, X)]); - -reg2(_G, _S, _N, _C, _V, X) when is_record(X, preproc) -> ok; - -reg2(_G, _S, _N, _C, _V, X) when is_record(X, pragma) -> ok; - -reg2(_G, _S, _N, _C, _V, _X) -> ok. - - -%% This function filters off all "#include <FileName>.idl" code that -%% come along from preprocessor and scanner. Produces code ONLY for -%% the actuall file. See ticket OTP-2133 -reg2_list(_G, _S, _N, _C, _V, []) -> []; -reg2_list(G, S, N, C, V, List ) -> - CurrentFileName = ic_genobj:idlfile(G), - reg2_list(G, S, N, C, V, {CurrentFileName,true}, List). - -%% The filter function + loop -reg2_list(_G, _S, _N, _C, _V, {_CFN, _Status}, []) -> []; -reg2_list(G, S, N, C, V, {CFN,Status}, [X | Xs]) -> - case Status of - true -> - case X of - {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> - reg2_list(G, S, N, C, V, {CFN,false}, Xs); - _ -> - F = reg2(G, S, N, C, V, X), - [F | reg2_list(G, S, N, C, V, {CFN,Status}, Xs)] - end; - false -> - case X of - {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> - F = reg2(G, S, N, C, V, X), - [F | reg2_list(G, S, N, C, V, {CFN,true}, Xs)]; - _ -> - reg2_list(G, S, N, C, V, {CFN,Status}, Xs) - end - end. - - - - - -%% General registration tests -register_tests(Fd,G) -> - IfrId = ?IFRID(G), - emit(Fd,"\n\n%% General IFR registration checks.\n", []), - emit(Fd,"register_tests(~s)->\n",[IfrId]), - emit(Fd," re_register_test(~s),\n",[IfrId]), - emit(Fd," include_reg_test(~s).\n\n",[IfrId]), - - emit(Fd,"\n%% IFR type Re-registration checks.\n", []), - case ic_pragma:fetchRandomLocalType(G) of - {ok,TypeId} -> - emit(Fd,"re_register_test(~s)->\n",[IfrId]), - emit(Fd," case orber_ifr:'Repository_lookup_id'(~s,~p) of\n", [IfrId,TypeId]), - emit(Fd," [] ->\n true;\n",[]), - emit(Fd," _ ->\n exit({allready_registered,~p})\n end.\n\n", [TypeId]); - false -> - emit(Fd,"re_register_test(_)-> true.\n",[]) - end, - - emit(Fd,"~s",[check_include_regs(G)]). - - - - -%% This function produces code for existance check over -%% top level included modules and interfaces -check_include_regs(G) -> - IfrId = ?IFRID(G), - case ic_pragma:get_incl_refs(G) of - none -> - io_lib:format("\n%% No included idl-files detected.\n", []) ++ - io_lib:format("include_reg_test(_~s) -> true.\n",[IfrId]); - IMs -> - io_lib:format("\n%% IFR registration checks for included idl files.\n", []) ++ - io_lib:format("include_reg_test(~s) ->\n",[IfrId]) ++ - check_incl_refs(G,IfrId,IMs) - end. - - - -check_incl_refs(_,_,[]) -> - io_lib:format(" true.\n",[]); -check_incl_refs(G,IfrId,[[First]|Rest]) -> - ModId = ic_pragma:scope2id(G,First), - io_lib:format(" case orber_ifr:'Repository_lookup_id'(~s,~p) of~n", [IfrId,ModId]) ++ - io_lib:format(" [] ->~n exit({unregistered,~p});~n", [ModId]) ++ - io_lib:format(" _ ->~n true~n end,~n",[]) ++ - check_incl_refs(G,IfrId,Rest). - - - -%% This function will return module ref, it will -%% also register module if not registered. -register_if_unregistered(Fd) -> - emit(Fd, "\n\n%% Fetch top module reference, register if unregistered.\n"), - emit(Fd, "oe_get_top_module(OE_IFR, ID, Name, Version) ->\n"), - emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), - emit(Fd, " [] ->\n"), - emit(Fd, " orber_ifr:'Repository_create_module'(OE_IFR, ID, Name, Version);\n"), - emit(Fd, " Mod ->\n"), - emit(Fd, " Mod\n",[]), - emit(Fd, " end.\n\n"), - emit(Fd, "%% Fetch module reference, register if unregistered.\n"), - emit(Fd, "oe_get_module(OE_IFR, OE_Parent, ID, Name, Version) ->\n"), - emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), - emit(Fd, " [] ->\n"), - emit(Fd, " orber_ifr:'ModuleDef_create_module'(OE_Parent, ID, Name, Version);\n"), - emit(Fd, " Mod ->\n"), - emit(Fd, " Mod\n",[]), - emit(Fd, " end.\n"). - - - -do_typedef(G, S, N, C, V, X) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - Thing = get_thing_name(X), - IR_VSN = get_IR_VSN(G, N, X), - TK = ic_forms:get_tk(X), - - lists:foreach( - fun(Id) -> - r_emit_raw(G, X, Fd, "", C, Thing, V, - get_IR_ID(G, N, Id), get_id2(Id), - IR_VSN, ", ~s", - [get_idltype_tk(G, S, N, - ictype:maybe_array(G, S, N, - Id, TK))]) - end, get_idlist(X)) - end. - - -do_union(G, S, N, C, V, X, {tk_union, _IFRID, _Name, DiscrTK, _DefNr, L}) -> - N2 = [get_id2(X) | N], - r_emit2(G, S, N, C, V, X, ", ~s, [~s]", - [get_idltype_tk(G, S, N, DiscrTK), - get_union_member_def(G, S, N2, L)]), - look_for_types(G, S, N2, C, V, get_body(X)). - -do_struct(G, S, N, C, V, X, {tk_struct, _IFRID, _Name, ElemList}) -> - N2 = [get_id2(X) | N], - r_emit2(G, S, N, C, V, X, ", [~s]", - [get_member_def(G, S, N, ElemList)]), - look_for_types(G, S, N2, C, V, get_body(X)). - -do_except(G, S, N, C, V, X, {tk_except, _IFRID, _Name, ElemList}) -> - N2 = [get_id2(X) | N], - r_emit2(G, S, N, C, V, X, ", [~s]", - [get_member_def(G, S, N, ElemList)]), - look_for_types(G, S, N2, C, V, get_body(X)). - - -%% new_var finds an unused Erlang variable name by increasing a -%% counter. -new_var(_G) -> - lists:flatten(["_OE_", integer_to_list(put(var_count, get(var_count) + 1))]). -init_var() -> - put(var_count, 1). - -%% Public interface. The name of the register function. -register_name(G) -> - mk_oe_name(G, "register"). -unregister_name(G) -> - mk_oe_name(G, "unregister"). - - - -look_for_types(G, S, N, C, V, L) when is_list(L) -> - lists:foreach(fun(X) -> look_for_types(G, S, N, C, V, X) end, L); -look_for_types(G, S, N, C, V, {_Name, TK}) -> % member - look_for_types(G, S, N, C, V, TK); -look_for_types(_G, _S, _N, _C, _V, {tk_union, _IFRID, _Name, _DT, _Def, _L}) -> - ok; -look_for_types(G, S, N, C, V, {_Label, _Name, TK}) -> % case_dcl - look_for_types(G, S, N, C, V, TK); -look_for_types(_G, _S, _N, _C, _V, {tk_struct, _IFRID, _Name, _L}) -> - ok; -look_for_types(_G, _S, _N, _C, _V, _X) -> - ok. - - - - -%% This function produces code for the interface inheritance registration. -%% It produces a string that represents a list of function calls. -%% This list becomes a list of object references when the main function -%% "orber_ifr:ModuleDef_create_interface" is called. - -get_base_interfaces(G,X) -> - case element(3,X) of - [] -> - "[]"; - L -> - "[" ++ - lists:flatten( - lists:foldl( - fun(E, Acc) -> [call_fun_str(G,E), ", " | Acc] end, - call_fun_str(G,hd(L)), - tl(L) - ) - ) ++ "]" - end. - -call_fun_str(G,S) -> - lists:flatten( - io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", - [ ?IFRID(G), - ic_pragma:scope2id(G,S)] )). - - - - - -%%-------------------------------------------------------------------- -%% -%% r_emit emits an IFR register function call. It returns a new -%% variable (if further defs should be added to that one) -%% -%% G is genobj -%% -%% S is symbol table (ets) -%% -%% N is list of ids describing scope -%% -%% C is create stub (eg. "Repository_create_") -%% -%% V is variable name where current def should be added, -%% -%% X is the current def item, -%% -%% F and A is auxillary format and args that will be io_lib -%% formatted and inserted as a string (don't forget to start with -%% ", ") -%% -r_emit2(G, _S, N, C, V, X, F, A) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - {NewV, Str} = get_assign(G, V, X), - r_emit_raw(G, X, ic_genobj:stubfiled(G), Str, - C, get_thing_name(X), V, - get_IR_ID(G, N, X), get_id2(X), get_IR_VSN(G, N, X), - F, A), - NewV - end. - - -%%-------------------------------------------------------------------- -%% -%% An IFR register line registers an entity (Thing) into the IFR. The -%% thing is registered INTO something, an type is registered into a -%% module for instance, and this is reflected in the Var parameter -%% below. The var parameter is the name of the parent IFR object. The -%% Thing parameter is the name of the thing we're trying to register, -%% a typdef is called an alias and an interface is called an -%% interface. Sometimes we need to store the thing we're registering -%% into a variable because we're going to add other things to it -%% later, modules and interfaces are such containers, so we must -%% remember that variable for later use. -%% -%% All parameters shall be strings unless otherwise noted -%% -%% Fd - File descriptor -%% AssignStr - Assign or not, empty except for interfaces and modules -%% Create - Create has diff. names dep. on into what we register -%% Thing - WHAT is registered, interface -%% Var - The name of the variable we register into -%% IR_ID - The IFR identifier (may be "") -%% Id - The identifier (name) of the object -%% IR_VSN - The IFR version as a string -%% AuxStr - An auxillary string -%% -%%r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN) -> -%% r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, "", []). -r_emit_raw(_G, X, Fd, AssignStr, "Repository_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) - when is_record(X, module) -> - emit(Fd, "~n ~s~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", - [AssignStr, to_atom("oe_get_top_"++Thing), Var, IR_ID, Id, - IR_VSN, io_lib:format(F, A)]); -r_emit_raw(G, X, Fd, AssignStr, "ModuleDef_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) - when is_record(X, module) -> - emit(Fd, "~n ~s~p(~s, ~s, \"~s\", \"~s\", \"~s\"~s),~n", - [AssignStr, to_atom("oe_get_"++Thing), ?IFRID(G), Var, IR_ID, Id, - IR_VSN, io_lib:format(F, A)]); -r_emit_raw(_G, _X, Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, F, A) -> - emit(Fd, "~n ~s~p:~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", - [AssignStr, ?IFRMOD, to_atom(Create++Thing), Var, IR_ID, Id, - IR_VSN, io_lib:format(F, A)]). - - - - -%% Used by r_emit. Returns tuple {Var, Str} where Var is the resulting -%% output var (if any, otherwise same as input arg) and Str is a -%% string of the assignment if any ("" or "Var = ") -get_assign(G, _V, X) when is_record(X, module) -> - mk_assign(G); -get_assign(G, _V, X) when is_record(X, interface) -> - mk_assign(G); -get_assign(_G, V, _X) -> {V, ""}. -mk_assign(G) -> - V = new_var(G), - {V, io_lib:format("~s = ", [V])}. - -%% Returns a list of strings of all enum members (suitable for ~p) -get_enum_member_list(_G, _S, _N, L) -> - lists:map(fun(M) -> get_id2(M) end, L). - -%% Will output a string of the union members. -get_union_member_def(_G, _S, _N, []) -> []; -get_union_member_def(G, S, N, L) -> - [union_member2str(G, S, N, hd(L)) | - lists:map(fun(M) -> [", ", union_member2str(G, S, N, M)] end, tl(L))]. -%% lists:foldl(fun(M, Acc) -> -%% [union_member2str(G, S, N, M),", " | Acc] end, -%% union_member2str(G, S, N, hd(L)), tl(L)). - -union_member2str(G, S, N, {Label, Name, TK}) -> - io_lib:format("~s{name=~p, label=~p, type=~p, type_def=~s}", - ["#unionmember", Name, Label, TK, - get_idltype_tk(G, S, N, TK)]). - - -%% Will output a string of the struct members. Works for exceptions -%% and structs -%% -get_member_def(_G, _S, _N, []) -> []; -get_member_def(G, S, N, L) -> - [member2str(G, S, N, hd(L)) | - lists:map(fun(M) -> [", ", member2str(G, S, N, M)] end, tl(L))]. - -member2str(G, S, N, {Id, TK}) -> - io_lib:format("~s{name=~p, type=~p, type_def=~s}", - ["#structmember", Id, TK, get_idltype_tk(G, S, N, TK)]). - -%% Translates between record names and create operation names. -get_thing_name(X) when is_record(X, op) -> "operation"; -get_thing_name(X) when is_record(X, const) -> "constant"; -get_thing_name(X) when is_record(X, typedef) -> "alias"; -get_thing_name(X) when is_record(X, attr) -> "attribute"; -get_thing_name(X) when is_record(X, except) -> "exception"; -get_thing_name(X) when is_record(X, id_of) -> get_thing_name(X#id_of.type); -get_thing_name(X) -> to_list(element(1,X)). - - -%% Returns the mode (in, out, oneway etc) of ops and params. Return -%% value is an atom. -get_mode(_G, _N, X) when is_record(X, op) -> - case X#op.oneway of - {oneway, _} -> 'OP_ONEWAY'; - _ -> 'OP_NORMAL' - end; -get_mode(_G, _N, X) when is_record(X, attr) -> - case X#attr.readonly of - {readonly, _} -> 'ATTR_READONLY'; - _ -> 'ATTR_NORMAL' - end; -get_mode(_G, _N, X) when is_record(X, param) -> - case X#param.inout of - {in, _} -> 'PARAM_IN'; - {inout, _} -> 'PARAM_INOUT'; - {out, _} -> 'PARAM_OUT' - end. - - -%% Returns a string form of idltype creation. -%%get_idltype_id(G, S, N, X, Id) -> -%% TK = ictype:tk_lookup(G, S, N, Id), -%% get_idltype_tk(G, S, N, TK). -get_idltype(G, S, N, X) -> - get_idltype_tk(G, S, N, ic_forms:get_tk(X)). -get_idltype_tk(G, _S, _N, TK) -> - io_lib:format("~p:~p(~s, ~p)", [orber_ifr, 'Repository_create_idltype', - ?IFRID(G), TK]). - -%% Returns a string form of typecode creation. This shall be found in -%% the type code symbol table. -%%get_typecode(G, S, N, X) -> typecode. -%%get_typecode(G, S, N, X) -> tk(G, S, N, get_type(X)). - - -%% Returns the string form of a list of parameters. -get_params(_G, _S, _N, []) -> ""; -get_params(G, S, N, L) -> - lists:foldl(fun(X, Acc) -> param2str(G, S, N, X)++", "++Acc end, - param2str(G, S, N, hd(L)), tl(L)). - - -%% Converts a parameter to a string. -param2str(G, S, N, X) -> - io_lib:format("~s{name=~p, type=~p, type_def=~s, mode=~p}~n", - ["#parameterdescription", get_id2(X), - ic_forms:get_tk(X), - %%tk_lookup(G, S, N, get_type(X)), - get_idltype(G, S, N, X), - get_mode(G, N, X)]). - - - - -%% Public interface. Returns the IFR ID of an object. This -%% is updated to comply with CORBA 2.0 pragma directives. -get_IR_ID(G, N, X) -> - ScopedId = [get_id2(X) | N], - case ic_pragma:get_alias(G,ScopedId) of - none -> - case ic_pragma:pragma_id(G, N, X) of - none -> - case ic_pragma:pragma_prefix(G, N, X) of - none -> - IR_ID = lists:flatten( - io_lib:format("IDL:~s:~s", - [slashify(ScopedId), - get_IR_VSN(G, N, X)])), - ic_pragma:mk_alias(G,IR_ID,ScopedId), - IR_ID; - PF -> - IR_ID = lists:flatten( - io_lib:format("IDL:~s:~s", - [ PF ++ "/" ++ - get_id2(X), - get_IR_VSN(G, N, X)])), - ic_pragma:mk_alias(G,IR_ID,ScopedId), - IR_ID - end; - PI -> - ic_pragma:mk_alias(G,PI,ScopedId), - PI - end; - Alias -> - Alias - end. - - -%% Public interface. Returns the IFR Version of an object. This -%% is updated to comply with CORBA 2.0 pragma directives. -get_IR_VSN(G, N, X) -> - ic_pragma:pragma_version(G,N,X). - - - - - -%% Returns a slashified name, [I1, M1] becomes "M1/I1" -%slashify(List) -> lists:foldl(fun(X, Acc) -> get_id2(X)++"/"++Acc end, -% hd(List), tl(List)). - -%% Returns a slashified name, [I1, M1] becomes "M1/I1" -slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, - hd(List), tl(List)). - - -%% Returns the context literals of an op -get_context(_G, _S, _N, X) -> - lists:map(fun(C) -> element(3, C) end, X#op.ctx). - - - -%% Returns the list of the exceptions of an operation -get_exceptions(G, S, N, X) -> - case X#op.raises of - [] -> - ""; - L -> - lists:flatten( - lists:foldl( - fun(E, Acc) -> [excdef(G, S, N, X, E), ", " | Acc] end, - excdef(G, S, N, X, hd(L)), - tl(L) - ) - ) - end. - - -%% Returns the definition of an exception of an operation -excdef(G, S, N, X, L) -> - io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", - [ ?IFRID(G), - get_EXC_ID(G, S, N, X, L) ] ). - - - - - - -%% This function produces code for the exception registration. -%% It produces a string that represents a list of function calls. -%% This list becomes a list of object references when the main function -%% "orber_ifr:InterfaceDef_create_operation" is called. - -get_EXC_ID(G, _S, N, X, ScopedId) -> - case ic_pragma:get_alias(G,ScopedId) of - none -> - case ic_pragma:pragma_id(G, N, X) of - none -> - case ic_pragma:pragma_prefix(G, N, X) of - none -> - EXC_ID = lists:flatten( - io_lib:format("IDL:~s:~s", [slashify(ScopedId), - get_IR_VSN(G, N, X)])), - ic_pragma:mk_alias(G,EXC_ID,ScopedId), - EXC_ID; - PF -> - EXC_ID = lists:flatten( - io_lib:format("IDL:~s:~s", [ PF ++ "/" ++ - hd(ScopedId), - get_IR_VSN(G, N, X)])), - ic_pragma:mk_alias(G,EXC_ID,ScopedId), - EXC_ID - end; - PI -> - ic_pragma:mk_alias(G,PI,ScopedId), - PI - end; - Alias -> - Alias - end. - - - - - -%% unreg_gen/1 uses the information stored in pragma table -%% to decide which modules are to be unregistered -unreg_gen(G, N, X) -> - Light = ic_options:get_opt(G, light_ifr), - case ic_genobj:is_stubfile_open(G) of - true when Light == false -> - Var = ?IFRID(G), - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), nl(Fd), - emit(Fd, "~p() ->\n", [to_atom(unregister_name(G))]), - emit(Fd, " ~s = ~p:find_repository(),\n", - [Var, ?IFRMOD]), - nl(Fd), - - unreg2(G, N, X), - emit(Fd, " ok.\n\n"), - destroy(Fd); - true -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - Unregname = to_atom(unregister_name(G)), - emit(Fd, "~p() ->\n\t~p([]).\n\n~p(OE_Options) ->\n", - [Unregname, Unregname, Unregname]), - emit(Fd, "\t~p:remove(?MODULE, OE_Options),\n\tok.\n\n", [?IFRMOD]); - false -> ok - end. - - -destroy(Fd) -> -emit(Fd," -oe_destroy_if_empty(OE_IFR,IFR_ID) -> - case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of - [] -> - ok; - Ref -> - case orber_ifr:contents(Ref, \'dk_All\', \'true\') of - [] -> - orber_ifr:destroy(Ref), - ok; - _ -> - ok - end - end. - -oe_destroy(OE_IFR,IFR_ID) -> - case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of - [] -> - ok; - Ref -> - orber_ifr:destroy(Ref), - ok - end. - -",[]). - - - - - - - - - - -%% unreg2 is top level registration - -unreg2(G, N, X) -> - emit(ic_genobj:stubfiled(G),"~s",[lists:flatten(unreg3(G, N, X))]). - -unreg3(G, N, X) when is_list(X) -> - unreg3_list(G, N, X, []); - -unreg3(G, N, X) when is_record(X, module) -> - unreg3_list(G, [get_id2(X) | N], get_body(X), [unreg_collect(G, N, X)]); - -unreg3(G, N, X) when is_record(X, const) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, struct) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, except) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, union) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, enum) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, typedef) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, interface) -> - unreg_collect(G, N, X); - -unreg3(_G, _N, X) when is_record(X, op) -> []; - -unreg3(_G, _N, X) when is_record(X, attr) -> []; - -unreg3(_G, _N, X) when is_record(X, preproc) -> []; - -unreg3(_G, _N, X) when is_record(X, pragma) -> []; - -unreg3(_G, _N, _X) -> []. - - -unreg3_list(_G, _N, [], Found) -> - Found; -unreg3_list(G, N, List, Found) -> - CurrentFileName = ic_genobj:idlfile(G), - unreg3_list(G, N, {CurrentFileName,true}, List, Found). - -%% The filter function + loop -unreg3_list(_G, _N, {_CFN, _Status}, [], Found) -> - Found; -unreg3_list(G, N, {CFN,Status}, [X | Xs], Found) -> - case Status of - true -> - case X of - {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> - unreg3_list(G, N, {CFN,false}, Xs, Found); - _ -> - unreg3_list(G, N, {CFN,Status}, Xs, [unreg3(G, N, X) | Found]) - end; - false -> - case X of - {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> - unreg3_list(G, N, {CFN,true}, Xs,[unreg3(G, N, X) | Found]); - _ -> - unreg3_list(G, N, {CFN,Status}, Xs, Found) - end - end. - - - -unreg_collect(G, N, X) when is_record(X, module) -> - io_lib:format(" oe_destroy_if_empty(OE_IFR, ~p),\n", - [get_IR_ID(G, N, X)]); -unreg_collect(G, N, X) when is_record(X, typedef) -> - lists:map(fun(Id) -> - io_lib:format(" oe_destroy(OE_IFR, ~p),\n", - [get_IR_ID(G, N, Id)]) - end, - ic_forms:get_idlist(X)); -unreg_collect(G, N, X) -> - io_lib:format(" oe_destroy(OE_IFR, ~p),\n", - [get_IR_ID(G, N, X)]). - - - diff --git a/lib/ic/src/ictype.erl b/lib/ic/src/ictype.erl deleted file mode 100644 index eb6f2088d7..0000000000 --- a/lib/ic/src/ictype.erl +++ /dev/null @@ -1,1417 +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% -%% -%% --module(ictype). - - --include("ic.hrl"). --include("icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([type_check/2, scoped_lookup/4, maybe_array/5, to_uppercase/1]). - --export([name2type/2, member2type/3, isBasicTypeOrEterm/3, isEterm/3]). --export([isBasicType/1, isBasicType/2, isBasicType/3, isString/3, isWString/3, - isArray/3, isStruct/3, isUnion/3, isEnum/3, isSequence/3, isBoolean/3 ]). --export([fetchTk/3, fetchType/1, tk/4]). -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% Macros -%%----------------------------------------------------------------- -%%-define(DBG(F,A), io:format(F,A)). --define(DBG(F,A), true). --define(STDDBG, ?DBG(" dbg: ~p: ~p~n", [element(1,X), ic_forms:get_id2(X)])). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -type_check(G, Forms) -> - S = ic_genobj:tktab(G), - check_list(G, S, [], Forms). - -scoped_lookup(G, S, N, X) -> - Id = ic_symtab:scoped_id_strip(X), - case ic_symtab:scoped_id_is_global(X) of - true -> - lookup(G, S, [], X, Id); - false -> - lookup(G, S, N, X, Id) - end. - - -%%-------------------------------------------------------------------- -%% maybe_array -%% -%% Array declarators are indicated on the declarator and not on -%% the type, therefore the declarator decides if the array type -%% kind is added or not. -%% -maybe_array(G, S, N, X, TK) when is_record(X, array) -> - mk_array(G, S, N, X#array.size, TK); -maybe_array(_G, _S, _N, _, TK) -> TK. - - - -name2type(G, Name) -> - S = ic_genobj:tktab(G), - ScopedName = lists:reverse(string:tokens(Name, "_")), - InfoList = ets:lookup(S, ScopedName ), - filter( InfoList ). - - -%% This is en overloaded function, -%% differs in input on unions -member2type(_G, X, I) when is_record(X, union)-> - Name = ic_forms:get_id2(I), - case lists:keysearch(Name,2,element(6,X#union.tk)) of - false -> - error; - {value,Rec} -> - fetchType(element(3,Rec)) - end; -member2type( G, SName, MName ) -> - - S = ic_genobj:tktab( G ), - SNList = lists:reverse(string:tokens(SName,"_")), - ScopedName = [MName | SNList], - InfoList = ets:lookup( S, ScopedName ), - - case filter( InfoList ) of - error -> - %% Try a little harder, seeking inside tktab - case lookup_member_type_in_tktab(S, ScopedName, MName) of - error -> - %% Check if this is the "return to return1" case - case MName of - "return1" -> - %% Do it all over again ! - ScopedName2 = ["return" | SNList], - InfoList2 = ets:lookup( S, ScopedName2 ), - case filter( InfoList2 ) of - error -> - %% Last resort: seek in pragma table - lookup_type_in_pragmatab(G, SName); - - Other -> - Other - end; - _ -> - %% Last resort: seek in pragma table - lookup_type_in_pragmatab(G, SName) - end; - Other -> - Other - end; - Other -> - Other - end. - - -lookup_member_type_in_tktab(S, ScopedName, MName) -> - case ets:match_object(S, {'_',member,{MName,'_'},nil}) of - [] -> - error; - [{_FullScopedName,member,{MName,TKInfo},nil}]-> - fetchType( TKInfo ); - List -> - lookup_member_type_in_tktab(List,ScopedName) - end. - -lookup_member_type_in_tktab([], _ScopedName) -> - error; -lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) -> - case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of - ScopedName -> - fetchType(TKInfo); - _ -> - lookup_member_type_in_tktab(Rest,ScopedName) - end. - - -lookup_type_in_pragmatab(G, SName) -> - S = ic_genobj:pragmatab(G), - - %% Look locally first - case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of - [] -> - %% No match, seek included - case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of - - [] -> - error; - [[Type]] -> - io:format("1 Found(~p) : ~p~n",[SName,Type]), - Type - end; - - [[Type]] -> - io:format("2 Found(~p) : ~p~n",[SName,Type]), - Type - end. - - - - -isString(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_string',_}, _} -> - true; - _ -> - false - end; -isString(_G, _N, T) when is_record(T, string) -> - true; -isString(_G, _N, _Other) -> - false. - - -isWString(G, N, T) when element(1, T) == scoped_id -> %% WSTRING - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_wstring',_}, _} -> - true; - _ -> - false - end; -isWString(_G, _N, T) when is_record(T, wstring) -> - true; -isWString(_G, _N, _Other) -> - false. - - -isArray(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_array', _, _}, _} -> - true; - _ -> - false - end; -isArray(_G, _N, T) when is_record(T, array) -> - true; -isArray(_G, _N, _Other) -> - false. - - -isSequence(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_sequence', _, _}, _} -> - true; - _ -> - false - end; -isSequence(_G, _N, T) when is_record(T, sequence) -> - true; -isSequence(_G, _N, _Other) -> - false. - - -isStruct(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_struct', _, _, _}, _} -> - true; - _ -> - false - end; -isStruct(_G, _N, T) when is_record(T, struct) -> - true; -isStruct(_G, _N, _Other) -> - false. - - -isUnion(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} -> - true; - _Other -> - false - end; -isUnion(_G, _N, T) when is_record(T, union) -> - true; -isUnion(_G, _N, _Other) -> - false. - - - -isEnum(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_enum',_,_,_}, _} -> - true; - _Other -> - false - end; -isEnum(_G, _N, T) when is_record(T, enum) -> - true; -isEnum(_G, _N, _Other) -> - false. - - - -isBoolean(G, N, T) when element(1, T) == scoped_id -> - {_, _, TK, _} = - ic_symtab:get_full_scoped_name(G, N, T), - case fetchType(TK) of - 'boolean' -> - true; - _ -> - false - end; -isBoolean(_, _, {'tk_boolean',_}) -> - true; -isBoolean(_, _, {'boolean',_}) -> - true; -isBoolean(_, _, _) -> - false. - - -%%% Just used for C - -isBasicTypeOrEterm(G, N, S) -> - case isBasicType(G, N, S) of - true -> - true; - false -> - isEterm(G, N, S) - end. - -isEterm(G, N, S) when element(1, S) == scoped_id -> - {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of - "erlang_term" -> - true; - "ETERM*" -> - true; - _X -> - false - end; -isEterm(_G, _Ni, _X) -> - false. - -isBasicType(_G, _N, {scoped_id,_,_,["term","erlang"]}) -> - false; -isBasicType(G, N, S) when element(1, S) == scoped_id -> - {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - isBasicType(fetchType(TK)); -isBasicType(_G, _N, {string, _} ) -> - false; -isBasicType(_G, _N, {wstring, _} ) -> %% WSTRING - false; -isBasicType(_G, _N, {unsigned, {long, _}} ) -> - true; -isBasicType(_G, _N, {unsigned, {short, _}} ) -> - true; -isBasicType(_G, _N, {Type, _} ) -> - isBasicType(Type); -isBasicType(_G, _N, _X) -> - false. - - -isBasicType( G, Name ) -> - isBasicType( name2type( G, Name ) ). - - -isBasicType( Type ) -> - lists:member(Type, - [tk_short,short, - tk_long,long, - tk_longlong,longlong, %% LLONG - tk_ushort,ushort, - tk_ulong,ulong, - tk_ulonglong,ulonglong, %% ULLONG - tk_float,float, - tk_double,double, - tk_boolean,boolean, - tk_char,char, - tk_wchar,wchar, %% WCHAR - tk_octet,octet, - tk_any,any]). %% Fix for any - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- -check(G, _S, N, X) when is_record(X, preproc) -> - handle_preproc(G, N, X#preproc.cat, X), - X; - -check(G, S, N, X) when is_record(X, op) -> - ?STDDBG, - TK = tk_base(G, S, N, ic_forms:get_type(X)), - tktab_add(G, S, N, X), - N2 = [ic_forms:get_id2(X) | N], - Ps = lists:map(fun(P) -> - tktab_add(G, S, N2, P), - P#param{tk=tk_base(G, S, N, ic_forms:get_type(P))} end, - X#op.params), - %% Check for exception defs. - Raises = lists:map(fun(E) -> name_lookup(G, S, N, E) end, - X#op.raises), - case ic_forms:is_oneway(X) of - true -> - if TK /= tk_void -> - ic_error:error(G, {bad_oneway_type, X, TK}); - true -> ok - end, - case ic:filter_params([inout, out], X#op.params) of - [] -> ok; % No out parameters! - _ -> - ic_error:error(G, {oneway_outparams, X}) - end, - case X#op.raises of - [] -> ok; - _ -> - ic_error:error(G, {oneway_raises, X}) - end; - false -> - ok - end, - X#op{params=Ps, tk=TK, raises=Raises}; - -check(G, S, N, X) when is_record(X, interface) -> - ?STDDBG, - N2 = [ic_forms:get_id2(X) | N], - TK = {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}, - Inherit = inherit_resolve(G, S, N, X#interface.inherit, []), - tktab_add(G, S, N, X, TK, Inherit), - CheckedBody = check_list(G, S, N2, ic_forms:get_body(X)), - InhBody = calc_inherit_body(G, N2, CheckedBody, Inherit, []), - X2 = X#interface{inherit=Inherit, tk=TK, body=CheckedBody, - inherit_body=InhBody}, - ic_symtab:store(G, N, X2), - X2; - -check(G, S, N, X) when is_record(X, forward) -> - ?STDDBG, - tktab_add(G, S, N, X, {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}), - X; - -check(G, S, N, #constr_forward{tk = tk_struct} = X) -> - ?STDDBG, - ID = ic_forms:get_id2(X), - Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")), - tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ID, Module}), - X; -check(G, S, N, #constr_forward{tk = tk_union} = X) -> - ?STDDBG, - ID = ic_forms:get_id2(X), - Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")), - tktab_add(G, S, N, X, {tk_union, ictk:get_IR_ID(G, N, X), ID, [], [], Module}), - X; - -check(G, S, N, X) when is_record(X, const) -> - ?STDDBG, - case tk_base(G, S, N, ic_forms:get_type(X)) of - Err when element(1, Err) == error -> X; - TK -> - check_const_tk(G, S, N, X, TK), - case iceval:eval_const(G, S, N, TK, X#const.val) of - Err when element(1, Err) == error -> X; - {ok, NewTK, Val} -> - V = iceval:get_val(Val), - tktab_add(G, S, N, X, NewTK, V), - X#const{val=V, tk=NewTK}; - Val -> - V = iceval:get_val(Val), - tktab_add(G, S, N, X, TK, V), - X#const{val=V, tk=TK} - end - end; - -check(G, S, N, X) when is_record(X, except) -> - ?STDDBG, - TK = tk(G, S, N, X), - X#except{tk=TK}; - -check(G, S, N, X) when is_record(X, struct) -> - ?STDDBG, - TK = tk(G, S, N, X), - X#struct{tk=TK}; - -check(G, S, N, X) when is_record(X, enum) -> - ?STDDBG, - TK = tk(G, S, N, X), - X#enum{tk=TK}; - -check(G, S, N, X) when is_record(X, union) -> - ?STDDBG, - TK = tk(G, S, N, X), - X#union{tk=TK}; - -check(G, S, N, X) when is_record(X, attr) -> - ?STDDBG, - TK = tk_base(G, S, N, ic_forms:get_type(X)), - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> tktab_add(G, S, N, XX#id_of{id=Id}) end, - ic_forms:get_idlist(X)), - X#attr{tk=TK}; - -check(G, S, N, X) when is_record(X, module) -> - ?STDDBG, - tktab_add(G, S, N, X), - X#module{body=check_list(G, S, [ic_forms:get_id2(X) | N], ic_forms:get_body(X))}; - -check(G, S, N, X) when is_record(X, typedef) -> - ?STDDBG, - TKbase = tk(G, S, N, X), - X#typedef{tk=TKbase}; - -check(_G, _S, _N, X) -> - ?DBG(" dbg: ~p~n", [element(1,X)]), - X. - -handle_preproc(G, _N, line_nr, X) -> ic_genobj:set_idlfile(G, ic_forms:get_id2(X)); -handle_preproc(_G, _N, _C, _X) -> ok. - - -%%-------------------------------------------------------------------- -%% -%% TK calculation -%% -%%-------------------------------------------------------------------- - -tk(G, S, N, X) when is_record(X, union) -> - N2 = [ic_forms:get_id2(X) | N], - DisrcTK = tk(G, S, N, ic_forms:get_type(X)), - case check_switch_tk(G, S, N, X, DisrcTK) of - true -> - do_special_enum(G, S, N2, ic_forms:get_type(X)), - BodyTK = lists:reverse( - tk_caselist(G, S, N2, DisrcTK, ic_forms:get_body(X))), - tktab_add(G, S, N, X, - {tk_union, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), - DisrcTK, default_count(ic_forms:get_body(X)), BodyTK}); - false -> - tk_void - end; - -tk(G, S, N, X) when is_record(X, enum) -> - N2 = [ic_forms:get_id2(X) | N], - tktab_add(G, S, N, X, - {tk_enum, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), - enum_body(G, S, N2, ic_forms:get_body(X))}); - - -%% Note that the TK returned from this function is the base TK. It -%% must be modified for each of the identifiers in the idlist (for -%% array reasons). -tk(G, S, N, X) when is_record(X, typedef) -> - case X of - %% Special case only for term and java backend ! - {typedef,{any,_},[{'<identifier>',_,"term"}],undefined} -> - case ic_options:get_opt(G, be) of - java -> - tktab_add(G, S, N, X, tk_term), - tk_term; - _ -> - TK = tk(G, S, N, ic_forms:get_body(X)), - lists:foreach(fun(Id) -> - tktab_add(G, S, N, #id_of{id=Id, type=X}, - maybe_array(G, S, N, Id, TK)) - end, - X#typedef.id), - TK - end; - _ -> - TK = tk(G, S, N, ic_forms:get_body(X)), - lists:foreach(fun(Id) -> - tktab_add(G, S, N, #id_of{id=Id, type=X}, - maybe_array(G, S, N, Id, TK)) - end, - X#typedef.id), - TK - end; - -tk(G, S, N, X) when is_record(X, struct) -> - N2 = [ic_forms:get_id2(X) | N], - tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), - tk_memberlist(G, S, N2, ic_forms:get_body(X))}); - -tk(G, S, N, X) when is_record(X, except) -> - N2 = [ic_forms:get_id2(X) | N], - tktab_add(G, S, N, X, {tk_except, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), - tk_memberlist(G, S, N2, ic_forms:get_body(X))}); - -tk(G, S, N, X) -> tk_base(G, S, N, X). - - -tk_base(G, S, N, X) when is_record(X, sequence) -> - {tk_sequence, tk(G, S, N, X#sequence.type), - len_eval(G, S, N, X#sequence.length)}; - -tk_base(G, S, N, X) when is_record(X, string) -> - {tk_string, len_eval(G, S, N, X#string.length)}; - -tk_base(G, S, N, X) when is_record(X, wstring) -> %% WSTRING - {tk_wstring, len_eval(G, S, N, X#wstring.length)}; - -%% Fixed constants can be declared as: -%% (1) const fixed pi = 3.14D; or -%% (2) typedef fixed<3,2> f32; -%% const f32 pi = 3.14D; -tk_base(G, S, N, X) when is_record(X, fixed) -> - %% Case 2 - {tk_fixed, len_eval(G, S, N, X#fixed.digits), len_eval(G, S, N, X#fixed.scale)}; -tk_base(_G, _S, _N, {fixed, _}) -> - %% Case 1 - tk_fixed; - - -%% Special case, here CORBA::TypeCode is built in -%% ONLY when erl_corba is the backend of choice -tk_base(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) -> - case ic_options:get_opt(G, be) of - false -> - tk_TypeCode; - erl_corba -> - tk_TypeCode; - erl_template -> - tk_TypeCode; - _ -> - case scoped_lookup(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) of - T when element(1, T) == error -> T; - T when is_tuple(T) -> element(3, T) - end - end; - -tk_base(G, S, N, X) when element(1, X) == scoped_id -> - case scoped_lookup(G, S, N, X) of - T when element(1, T) == error -> T; - T when is_tuple(T) -> element(3, T) - end; -tk_base(_G, _S, _N, {long, _}) -> tk_long; -tk_base(_G, _S, _N, {'long long', _}) -> tk_longlong; %% LLONG -tk_base(_G, _S, _N, {short, _}) -> tk_short; -tk_base(_G, _S, _N, {'unsigned', {short, _}}) -> tk_ushort; -tk_base(_G, _S, _N, {'unsigned', {long, _}}) -> tk_ulong; -tk_base(_G, _S, _N, {'unsigned', {'long long', _}})-> tk_ulonglong; %% ULLONG -tk_base(_G, _S, _N, {float, _}) -> tk_float; -tk_base(_G, _S, _N, {double, _}) -> tk_double; -tk_base(_G, _S, _N, {boolean, _}) -> tk_boolean; -tk_base(_G, _S, _N, {char, _}) -> tk_char; -tk_base(_G, _S, _N, {wchar, _}) -> tk_wchar; %% WCHAR -tk_base(_G, _S, _N, {octet, _}) -> tk_octet; -tk_base(_G, _S, _N, {null, _}) -> tk_null; -tk_base(_G, _S, _N, {void, _}) -> tk_void; -tk_base(_G, _S, _N, {any, _}) -> tk_any; -tk_base(_G, _S, _N, {'Object', _}) -> {tk_objref, "", "Object"}. - - -%%-------------------------------------------------------------------- -%% -%% Special handling of idlists. Note that the recursion case is given -%% as accumulator to foldr. Idlists are those lists of identifiers -%% that share the same definition, i.e. multiple cases, multiple type -%% declarations, multiple member names. -%% -tk_memberlist(G, S, N, [X | Xs]) -> - BaseTK = tk(G, S, N, ic_forms:get_type(X)), - - XX = #id_of{type=X}, - lists:foldr(fun(Id, Acc) -> - [tk_member(G, S, N, XX#id_of{id=Id}, BaseTK) | Acc] end, - tk_memberlist(G, S, N, Xs), - ic_forms:get_idlist(X)); -tk_memberlist(_G, _S, _N, []) -> []. - -%% same as above but for case dcls -tk_caselist(G, S, N, DiscrTK, Xs) -> - lists:foldl(fun(Case, Acc) -> - BaseTK = tk(G, S, N, ic_forms:get_type(Case)), - %% tktab_add for the uniqueness check of the declarator - tktab_add(G, S, N, Case), - lists:foldl(fun(Id, Acc2) -> - case tk_case(G, S, N, Case, BaseTK, - DiscrTK, Id) of - Err when element(1, Err)==error -> - Acc2; - TK -> - unique_add_case_label(G, S, N, Id, - TK, Acc2) - end - end, - Acc, - ic_forms:get_idlist(Case)) - end, - [], - Xs). - - -%% Handling of the things that can be in an idlist or caselist -tk_member(G, S, N, X, BaseTK) -> - tktab_add(G, S, N, X, - {ic_forms:get_id2(X), maybe_array(G, S, N, X#id_of.id, BaseTK)}). - - -get_case_id_and_check(G, _S, _N, _X, ScopedId) -> - case ic_symtab:scoped_id_is_global(ScopedId) of - true -> ic_error:error(G, {bad_scope_enum_case, ScopedId}); - false -> ok - end, - case ic_symtab:scoped_id_strip(ScopedId) of - [Id] -> Id; - _List -> - ic_error:error(G, {bad_scope_enum_case, ScopedId}), - "" - end. - - -tk_case(G, S, N, X, BaseTK, DiscrTK, Id) -> - case case_eval(G, S, N, DiscrTK, Id) of - Err when element(1, Err) == error -> Err; - Val -> - case iceval:check_tk(G, DiscrTK, Val) of - true -> - {iceval:get_val(Val), ic_forms:get_id2(X), - maybe_array(G, S, N, X#case_dcl.id, BaseTK)}; - false -> - ic_error:error(G, {bad_case_type, DiscrTK, X, - iceval:get_val(Val)}) - end - end. - -tktab_add(G, S, N, X) -> - tktab_add_id(G, S, N, X, ic_forms:get_id2(X), nil, nil). -tktab_add(G, S, N, X, TK) -> - tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, nil). -tktab_add(G, S, N, X, TK, Aux) -> - tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, Aux). - - -tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,enumerator) -> - - %% Check if the "scl" flag is set to true - %% if so, allow old semantics ( errornous ) - %% Warning, this is for compatibility reasons only. - Name = case ic_options:get_opt(G, scl) of - true -> - [Id | N]; - false -> - [Id | tl(N)] - end, - - UName = mk_uppercase(Name), - case ets:lookup(S, Name) of - [_] -> ic_error:error(G, {multiply_defined, X}); - [] -> - case ets:lookup(S, UName) of - [] -> ok; - [_] -> ic_error:error(G, {illegal_spelling, X}) - end - end, - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; -%% -%% Fixes the multiple file module definition check -%% but ONLY for Corba backend -%% -tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,module) -> - case ic_options:get_opt(G, be) of - erl_template -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - erl_corba -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - false -> %% default == erl_corba - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - java -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - erl_genserv -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - erl_plain -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - _Be -> - Name = [Id | N], - UName = mk_uppercase(Name), - case ets:lookup(S, Name) of - [_] -> ic_error:error(G, {multiply_defined, X}); - [] -> - case ets:lookup(S, UName) of - [] -> ok; - [_] -> ic_error:error(G, {illegal_spelling, X}) - end - end, - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK - end; -tktab_add_id(G, S, N, X, Id, TK, Aux) -> - Name = [Id | N], - UName = mk_uppercase(Name), - case ets:lookup(S, Name) of - [{_, forward, _, _}] when is_record(X, interface) -> - ok; - [{_, constr_forward, _, _}] when is_record(X, union) orelse - is_record(X, struct) -> - ok; - [XX] when is_record(X, forward) andalso element(2, XX)==interface -> - ok; - [_] -> - ic_error:error(G, {multiply_defined, X}); - [] -> - case ets:lookup(S, UName) of - [] -> ok; - [_] -> ic_error:error(G, {illegal_spelling, X}) - end - end, - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK. - - - - -%%-------------------------------------------------------------------- -%% enum_body -%% -%% Special because ids are treated different than usual. -%% -enum_body(G, S, N, [Enum | EnumList]) -> - tktab_add(G, S, N, Enum), %%%, enum_val, Enum), - %% tktab_add(G, S, N, X, TK, V), - [ic_forms:get_id2(Enum) | enum_body(G, S, N, EnumList)]; -enum_body(_G, _S, _N, []) -> []. - - -%%-------------------------------------------------------------------- -%% mk_array -%% -%% Multi dimensional arrays are written as nested tk_array -%% -mk_array(G, S, N, [Sz | Szs], TK) -> - case iceval:eval_const(G, S, N, positive_int, Sz) of - Err when element(1, Err) == error -> TK; - Val -> - {tk_array, mk_array(G, S, N, Szs, TK), iceval:get_val(Val)} - end; -mk_array(_G, _S, _N, [], TK) -> TK. - - -%%-------------------------------------------------------------------- -%% len_eval -%% -%% Evaluates the length, which in case it has been left out is a -%% plain 0 (zero) -%% -len_eval(_G, _S, _N, 0) -> 0; -len_eval(G, S, N, X) -> %%iceval:eval_const(G, S, N, positive_int, X). - case iceval:eval_const(G, S, N, positive_int, X) of - Err when element(1, Err) == error -> 0; - Val -> iceval:get_val(Val) - end. - - -%%-------------------------------------------------------------------- -%% case_eval -%% -%% Evaluates the case label. -%% - -case_eval(G, S, N, DiscrTK, X) when element(1, DiscrTK) == tk_enum, - element(1, X) == scoped_id -> - {tk_enum, _, _, Cases} = DiscrTK, - Id = get_case_id_and_check(G, S, N, X, X), - %%io:format("Matching: ~p to ~p~n", [Id, Cases]), - case lists:member(Id, Cases) of - true -> - {enum_id, Id}; - false -> - iceval:mk_val(scoped_lookup(G, S, N, X)) % Will generate error - end; - -case_eval(G, S, N, DiscrTK, X) -> - iceval:eval_e(G, S, N, DiscrTK, X). - - -%% The enum declarator is in the union scope. -do_special_enum(G, S, N, X) when is_record(X, enum) -> - tktab_add(G, S, N, #id_of{id=X#enum.id, type=X}); -do_special_enum(_G, _S, _N, _X) -> - ok. - - -unique_add_case_label(G, _S, _N, Id, TK, TKList) -> -%%%io:format("check_case_labels: TK:~p TKLIST:~p ~n", [TK, TKList]), - if element(1, TK) == error -> - TKList; - true -> - case lists:keysearch(element(1, TK), 1, TKList) of - {value, _} -> - ic_error:error(G, {multiple_cases, Id}), - TKList; - false -> - [TK | TKList] - end - end. - - -%%-------------------------------------------------------------------- -%% default_count -%% -%% Returns the position of the default case. -%% -%% Modified for OTP-2007 -%% -default_count(Xs) -> - default_count2(Xs, 0). - -default_count2([X | Xs], N) -> default_count3(X#case_dcl.label, Xs, N); -default_count2([], _) -> -1. - -default_count3([{default, _} | _Ys], _Xs, N) -> N; -default_count3([_ | Ys], Xs, N) -> default_count3(Ys, Xs, N+1); -default_count3([], Xs, N) -> default_count2(Xs, N). - - - - -%% -%% Type checks. -%% -%% Check constant type references (only for the scoped id case, others -%% are caught by the BNF) -%% -check_const_tk(_G, _S, _N, _X, tk_long) -> true; -check_const_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG -check_const_tk(_G, _S, _N, _X, tk_short) -> true; -check_const_tk(_G, _S, _N, _X, tk_ushort) -> true; -check_const_tk(_G, _S, _N, _X, tk_ulong) -> true; -check_const_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG -check_const_tk(_G, _S, _N, _X, tk_float) -> true; -check_const_tk(_G, _S, _N, _X, tk_double) -> true; -check_const_tk(_G, _S, _N, _X, tk_boolean) -> true; -check_const_tk(_G, _S, _N, _X, tk_char) -> true; -check_const_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR -check_const_tk(_G, _S, _N, _X, tk_octet) -> true; -check_const_tk(_G, _S, _N, _X, {tk_string, _Len}) -> true; -check_const_tk(_G, _S, _N, _X, {tk_wstring, _Len}) -> true; %% WSTRING -check_const_tk(_G, _S, _N, _X, tk_fixed) -> true; -check_const_tk(_G, _S, _N, _X, {tk_fixed, _Digits, _Scale}) -> true; -check_const_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_const_t, X, TK}). - - -check_switch_tk(_G, _S, _N, _X, tk_long) -> true; -check_switch_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG -check_switch_tk(_G, _S, _N, _X, tk_short) -> true; -check_switch_tk(_G, _S, _N, _X, tk_ushort) -> true; -check_switch_tk(_G, _S, _N, _X, tk_ulong) -> true; -check_switch_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG -check_switch_tk(_G, _S, _N, _X, tk_boolean) -> true; -check_switch_tk(_G, _S, _N, _X, tk_char) -> true; -check_switch_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR -check_switch_tk(_G, _S, _N, _X, TK) when element(1, TK) == tk_enum -> true; -check_switch_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_switch_t, X, TK}), - false. - - - -%% Lookup a name -name_lookup(G, S, N, X) -> - case scoped_lookup(G, S, N, X) of - T when is_tuple(T) -> element(1, T) - end. - - -lookup(G, S, N, X, Id) -> - N2 = Id ++ N, - ?DBG(" Trying ~p ...~n", [N2]), - case ets:lookup(S, N2) of - [] -> - case look_for_interface(G, S, [hd(N2)], tl(N2)) of - - %% First attempt: filtering inherited members ! - [{_, member, _, _}] -> - case look_for_interface(G, S, [hd(N)], tl(N2)) of - [T] -> - ?DBG(" -- found ~p~n", [T]), - T; - _ -> - lookup(G, S, tl(N), X, Id) - end; - %% - - [T] -> - ?DBG(" -- found ~p~n", [T]), - T; - - _ -> - if N == [] -> - ic_error:error(G, {tk_not_found, X}); - true -> - lookup(G, S, tl(N), X, Id) - end - - end; - - %% Second attempt: filtering members ! - [{_, member, _, _}] -> - case look_for_interface(G, S, [hd(N2)], tl(N2)) of - [T] -> - ?DBG(" -- found ~p~n", [T]), - T; - _ -> - if N == [] -> - ic_error:error(G, {tk_not_found, X}); - true -> - lookup(G, S, tl(N), X, Id) - end - end; - %% - [T] -> - ?DBG(" -- found ~p~n", [T]), - T - end. - - -look_for_interface(_G, _S, _Hd, []) -> - false; -look_for_interface(G, S, Hd, Tl) -> - case ets:lookup(S, Tl) of - [{_, interface, _TK, Inh}] -> - case look_in_inherit(G, S, Hd, Inh) of - %% gather_inherit(G, S, Inh, [])) of - [X] when is_tuple(X) -> - [X]; - _ -> - look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl)) - end; - _ -> - look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl)) - end. - -look_in_inherit(G, S, Id, [I | Is]) -> - case ets:lookup(S, Id ++ I) of - [X] when is_tuple(X) -> - [X]; - [] -> - look_in_inherit(G, S, Id, Is) - end; -look_in_inherit(_G, _S, _Id, []) -> - false. - - -%% L is a list of names -mk_uppercase(L) -> - lists:map(fun(Z) -> lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; - (X) -> X end, Z) end, L). - - -%%-------------------------------------------------------------------- -%% -%% Inheritance stuff -%% -%% -%%-------------------------------------------------------------------- - -%% InhBody is an accumulating parameter - -calc_inherit_body(G, N, OrigBody, [X|Xs], InhBody) -> - case ic_symtab:retrieve(G, X) of - Intf when is_record(Intf, interface) -> - Body = filter_body(G, X, ic_forms:get_body(Intf), N, OrigBody, InhBody), - calc_inherit_body(G, N, OrigBody, Xs, [{X, Body} | InhBody]); - XXX -> - io:format("Oops, not found ~p~n", [XXX]), - calc_inherit_body(G, N, OrigBody, Xs, InhBody) - end; -calc_inherit_body(_G, _N, _OrigBody, [], InhBody) -> lists:reverse(InhBody). - - -filter_body(G, XPath, [X | Xs], OrigPath, OrigBody, InhBody) -> - case complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) of - true -> - %%io:format("NOT adding ~p~n", [ic_forms:get_id2(X)]), - filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody); - {false, NewX} -> % For those with idlist - %%io:format("Adding from idlist~n", []), - [NewX | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)]; - false -> - %%io:format("Adding: ~p~n", [ic_forms:get_id2(X)]), - [X | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)] - end; -filter_body(_G, _XPath, [], _OrigPath, _OrigBody, _InhBody) -> []. - - -complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> - case has_idlist(X) of - true -> - idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody); - false -> - straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) - end. - - -idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> - XX = #id_of{type=X}, - F = fun(Id) -> - not(straight_member(G, XPath, XX#id_of{id=Id}, OrigPath, - OrigBody, InhBody)) - end, - case lists:filter(F, ic_forms:get_idlist(X)) of - [] -> - true; - IdList -> -%%% io:format("Idlist added: ~p~n",[IdList]), - {false, replace_idlist(X, IdList)} - end. - - -straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> - %%io:format("straight member: ~p~n", [ic_forms:get_id2(X)]), - case body_member(G, XPath, X, OrigPath, OrigBody) of - true -> - true; - false -> - inh_body_member(G, XPath, X, InhBody) - end. - - -inh_body_member(G, XPath, X, [{Name, Body} | InhBody]) -> - case body_member(G, XPath, X, Name, Body) of - true -> - true; - false -> - inh_body_member(G, XPath, X, InhBody) - end; -inh_body_member(_G, _XPath, _X, []) -> false. - - -body_member(G, XPath, X, YPath, [Y|Ys]) -> - case has_idlist(Y) of - true -> - YY = #id_of{type=Y}, - case list_and(fun(Y2) -> - not(is_equal(G, XPath, X, YPath, - YY#id_of{id=Y2})) end, - ic_forms:get_idlist(Y)) of - true -> - body_member(G, XPath, X, YPath, Ys); - false -> - true - end; - false -> - case is_equal(G, XPath, X, YPath, Y) of - false -> - body_member(G, XPath, X, YPath, Ys); - true -> - true - end - end; -body_member(_G, _XPath, _X, _YPath, []) -> false. - - -is_equal(G, XPath, X, YPath, Y) -> - case {ic_forms:get_id2(X), ic_forms:get_id2(Y)} of - {ID, ID} -> - collision(G, XPath, X, YPath, Y), - true; - _ -> - false - end. - - -%% X is the new item, Y is the old one. So it is X that collides with -%% Y and Y shadows X. -collision(G, XPath, X, YPath, Y) -> - I1 = get_beef(X), - % I2 = get_beef(Y), - if is_record(I1, op) -> %%, record(I2, op) -> - ic_error:error(G, {inherit_name_collision, - {YPath, Y}, {XPath, X}}); - is_record(I1, attr) -> %%, record(I2, attr) -> - ic_error:error(G, {inherit_name_collision, - {YPath, Y}, {XPath, X}}); - true -> - ?ifopt(G, warn_name_shadow, - ic_error:warn(G, {inherit_name_shadow, - {YPath, Y}, {XPath, X}})) - end. - -has_idlist(X) when is_record(X, typedef) -> true; -has_idlist(X) when is_record(X, member) -> true; -has_idlist(X) when is_record(X, case_dcl) -> true; -has_idlist(X) when is_record(X, attr) -> true; -has_idlist(_) -> false. - -replace_idlist(X, IdList) when is_record(X, typedef) -> X#typedef{id=IdList}; -replace_idlist(X, IdList) when is_record(X, attr) -> X#attr{id=IdList}. - -get_beef(X) when is_record(X, id_of) -> X#id_of.type; -get_beef(X) -> X. - - -%% And among all elements in list -list_and(F, [X|Xs]) -> - case F(X) of - true -> list_and(F, Xs); - false -> false - end; -list_and(_F, []) -> true. - - - - - -%%-------------------------------------------------------------------- -%% -%% resolve_inherit shall return a list of resolved inheritances, -%% that is all names replaced with their global names. -%% - -inherit_resolve(G, S, N, [X|Rest], Out) -> - case scoped_lookup(G, S, N, X) of - {Name, _T, _TK, Inh} -> - case lists:member(Name, Out) of - true -> - inherit_resolve(G, S, N, Rest, Out); - false -> - case unique_append(Inh, [Name|Out]) of - error -> - ic_error:error(G, {inherit_resolve, X, Name}), - inherit_resolve(G, S, N, Rest, []); - UA -> - inherit_resolve(G, S, N, Rest, UA) - end - end; - _ -> inherit_resolve(G, S, N, Rest, Out) - end; -inherit_resolve(_G, _S, _N, [], Out) -> lists:reverse(Out). - -unique_append([X|Xs], L) -> - case lists:member(X, L) of - true -> unique_append(Xs, L); - false -> unique_append(Xs, [X|L]) - end; -unique_append([], L) -> L; -%% Error -unique_append(_, _L) -> error. - - - - -%%-------------------------------------------------------------------- -%% -%% Utilities -%% - -%% Must preserve order, therefore had to write my own (instead of lists:map) -check_list(G, S, N, [X|Xs]) -> - X1 = check(G, S, N, X), - [X1 | check_list(G, S, N, Xs)]; -check_list(_G, _S, _N, []) -> []. - - - -filter( [] ) -> - error; -filter( [I | Is ] ) -> - case I of - { _, member, { _, TKINFO }, _ } -> - fetchType( TKINFO ); - - { _, struct, _, _ } -> - struct; - - { _, typedef, TKINFO, _ } -> - fetchType( TKINFO ); - - { _, module, _, _ } -> - module; - - { _, interface, _, _ } -> - interface; - - { _, op, _, _ } -> - op; - - { _,enum, _, _ } -> - enum; - - { _, spellcheck } -> - filter( Is ); - - _ -> - error - end. - - -fetchType( { tk_sequence, _, _ } ) -> - sequence; -fetchType( { tk_array, _, _ } ) -> - array; -fetchType( { tk_struct, _, _, _} ) -> - struct; -fetchType( { tk_string, _} ) -> - string; -fetchType( { tk_wstring, _} ) -> %% WSTRING - wstring; -fetchType( { tk_fixed, _, _} ) -> - fixed; -fetchType( tk_short ) -> - short; -fetchType( tk_long ) -> - long; -fetchType( tk_longlong ) -> %% LLONG - longlong; -fetchType( tk_ushort ) -> - ushort; -fetchType( tk_ulong ) -> - ulong; -fetchType( tk_ulonglong ) -> %% ULLONG - ulonglong; -fetchType( tk_float ) -> - float; -fetchType( tk_double ) -> - double; -fetchType( tk_boolean ) -> - boolean; -fetchType( tk_char ) -> - char; -fetchType( tk_wchar ) -> %% WCHAR - wchar; -fetchType( tk_octet ) -> - octet; -fetchType( { tk_enum, _, _, _ } ) -> - enum; -fetchType( { tk_union, _, _, _, _, _ } ) -> - union; -fetchType( tk_any ) -> - any; -fetchType( _ ) -> - error. - -%% Z is a single name -to_uppercase(Z) -> - lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; - (X) -> X end, Z). - - -%%------------------------------------------------------------ -%% -%% Always fetchs TK of a record. -%% -%%------------------------------------------------------------ -fetchTk(G,N,X) -> - case ic_forms:get_tk(X) of - undefined -> - searchTk(G,ictk:get_IR_ID(G, N, X)); - TK -> - TK - end. - - -%%------------------------------------------------------------ -%% -%% seek type code when not accessible by get_tk/1 -%% -%%------------------------------------------------------------ -searchTk(G,IR_ID) -> - S = ic_genobj:tktab(G), - case catch searchTk(S,IR_ID,typedef) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch searchTk(S,IR_ID,struct) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch searchTk(S,IR_ID,union) of - {value,TK} -> - TK; - _ -> - undefined - end - end - end. - - -searchTk(S,IR_ID,Type) -> - L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), - case lists:keysearch(IR_ID,2,L) of - {value,TK} -> - {value,TK}; - false -> - searchInsideTks(L,IR_ID) - end. - - -searchInsideTks([],_IR_ID) -> - false; -searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) -> - case searchIncludedTk(TK,IR_ID) of - {value,TK} -> - {value,TK}; - false -> - searchInsideTks(Xs,IR_ID) - end. - - -searchIncludedTk({tk_array,TK,_},IR_ID) -> - searchIncludedTk(TK,IR_ID); -searchIncludedTk({tk_sequence,TK,_},IR_ID) -> - searchIncludedTk(TK,IR_ID); -searchIncludedTk(TK, _IR_ID) when is_atom(TK) -> - false; -searchIncludedTk(TK,IR_ID) -> - case element(2,TK) == IR_ID of - true -> - {value,TK}; - false -> - false - end. - diff --git a/lib/ic/src/icunion.erl b/lib/ic/src/icunion.erl deleted file mode 100644 index c39a5177e7..0000000000 --- a/lib/ic/src/icunion.erl +++ /dev/null @@ -1,1491 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% - --module(icunion). - --import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). --import(ic_cbe, [mk_c_type/3, mk_c_type/4]). - --include("icforms.hrl"). --include("ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([union_gen/4]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -union_gen(G, N, X, c) when is_record(X, union) -> - emit_c_union(G, N, X); -union_gen(_G, _N, _X, _L) -> - ok. - - -%% Emits the union -emit_c_union(G, N, X) -> - %%io:format("Rec = ~p\n",[X]), - case ic_genobj:is_hrlfile_open(G) of - true -> - - %% Sort Union Default = put it last in case list - NewX = #union{ id = X#union.id, - type = X#union.type, - body = mvDefaultToTail(X#union.body), - tk = X#union.tk }, - - UnionScope = [ic_forms:get_id2(NewX) | N], - - case ic_pragma:is_local(G,UnionScope) of - - true -> - - HFd = ic_genobj:hrlfiled(G), - emit_c_union_values(G, N, NewX, HFd), - UnionName = ic_util:to_undersc(UnionScope), - - emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(UnionName)]), - emit(HFd, "#define __~s__\n",[ictype:to_uppercase(UnionName)]), - ic_codegen:mcomment_light(HFd, - [io_lib:format("Union definition: ~s", - [UnionName])], - c), - emit(HFd, "typedef struct {\n"), - emit(HFd, " ~s _d;\n", [get_c_union_discriminator(G, N, NewX)]), - emit(HFd, " union {\n"), - emit_c_union_values_decl(G, N, NewX, HFd), - emit(HFd, " } _u;\n"), - emit(HFd, "} ~s;\n\n", [UnionName]), - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", - [ic_util:mk_oe_name(G, "sizecalc_"), UnionName]), - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n", - [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]), - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s*);\n", - [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]), - emit(HFd, "\n#endif\n\n"), - create_c_union_file(G, N, NewX, UnionName); - - false -> %% Do not generate included types att all. - ok - end; - false -> - ok - end. - - - -%% Loops over union members and creates members typedefs -emit_c_union_values(G, N, X, Fd) -> - emit_c_union_values_loop(G, N, X, Fd, X#union.body). - -emit_c_union_values_loop(G, N, X, Fd, [CU]) -> - case CU of - {case_dcl,_,Id,Type} -> - case Id of - {array, _AID, _SZ} -> % Check for arrays - mk_array_file(G,N,X,Id,Type,Fd); - _ -> % Elementary types or seq/struct - ok - end; - _ -> - error - end; -emit_c_union_values_loop(G, N, X, Fd, [CU |CUs]) -> - case CU of - {case_dcl,_,Id,Type} -> - case Id of - {array, _AID, _SZ} -> % Check for arrays - mk_array_file(G,N,X,Id,Type,Fd); - _ -> % Elementary types or seq/struct - emit_c_union_values_loop(G, N, X, Fd, CUs) - end; - _ -> - error - end. - - -%% Loops over union members and declares members inside union structure -emit_c_union_values_decl(G, N, X, Fd) -> - emit_c_union_values_decl_loop(G, N, X, Fd, X#union.body). - -emit_c_union_values_decl_loop(G, N, X, Fd, [CU]) -> - case CU of - {case_dcl,_,Id,Type} -> - case Id of - {array, _AID, _SZ} -> % Check for arrays - mk_array_decl(G,N,X,Id,Type,Fd); - _ -> % Elementary types or seq/struct - mk_union_member_decl(G,N,X,Id,Type,Fd), - ok - end; - _ -> - error - end; -emit_c_union_values_decl_loop(G, N, X, Fd, [CU |CUs]) -> - case CU of - {case_dcl,_,Id,Type} -> - case Id of - {array, _AID, _SZ} -> % Check for arrays - mk_array_decl(G,N,X,Id,Type,Fd), - emit_c_union_values_decl_loop(G, N, X, Fd, CUs); - _ -> % Elementary types or seq/struct - mk_union_member_decl(G,N,X,Id,Type,Fd), - emit_c_union_values_decl_loop(G, N, X, Fd, CUs) - end; - _ -> - error - end. - - -%% Makes the declaration for the array in union -mk_array_decl(G,N,X,Id,Type,Fd) -> - emit(Fd, " ~s ~s;\n", - [getCaseTypeStr(G,N,X,Id,Type), - mk_array_name(Id)]). - -mk_array_name({array,Id,D}) -> - ic_forms:get_id2(Id) ++ mk_array_dim(D). - -mk_array_dim([]) -> - ""; -mk_array_dim([{_,_,Dim}|Dims]) -> - "[" ++ Dim ++ "]" ++ mk_array_dim(Dims). - - -%% Creates the array file -mk_array_file(G,N,X,{array,AID,SZ},Type,HFd) -> - ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), - ArrayDim = extract_array_dim(SZ), - emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(ArrayName)]), - emit(HFd, "#define __~s__\n\n",[ictype:to_uppercase(ArrayName)]), - icstruct:create_c_array_coding_file(G, - N, - {ArrayName,ArrayDim}, - Type, - no_typedef), - emit(HFd, "\n#endif\n\n"). - -extract_array_dim([{_,_,Dim}]) -> - [Dim]; -extract_array_dim([{_,_,Dim}|Dims]) -> - [Dim | extract_array_dim(Dims)]. - - -%% Makes the declaration for the member in union -mk_union_member_decl(G,N,X,Id,Type,Fd) -> - emit(Fd, " ~s ~s;\n", - [getCaseTypeStr(G,N,X,Id,Type), - ic_forms:get_id2(Id)]). - - - - -%% File utilities -create_c_union_file(G, N, X, UnionName) -> - - {Fd , SName} = open_c_coding_file(G, UnionName), - _HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - HrlFName = filename:basename(ic_genobj:include_file(G)), - ic_codegen:emit_stub_head(G, Fd, SName, c), - emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile - %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - %% HrlFName = filename:basename(ic_genobj:include_file(G)), - %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - put(op_variable_count, 0), - put(tmp_declarations, []), - - %% Write generated code on file - emit_union_sizecount(G, N, X, Fd, UnionName), - emit_union_encode(G, N, X, Fd, UnionName), - emit_union_decode(G, N, X, Fd, UnionName), - file:close(Fd). - -open_c_coding_file(G, Name) -> - SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), - FName = - ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), - case file:open(FName, [write]) of - {ok, Fd} -> - {Fd, SName}; - Other -> - exit(Other) - end. - - - - -get_c_union_discriminator(G, N, X) -> - case getDiscrStr(G, N, X#union.type) of - error -> - ic_error:fatal_error(G, {illegal_typecode_for_c, X#union.type, N}); - DiscrStr -> - case ic_code:get_basetype(G, DiscrStr) of - {short, _} -> - "CORBA_short"; - {unsigned,{short, _}} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_long"; - {unsigned,{long, _}} -> - "CORBA_unsigned_long"; - {boolean,_} -> - "CORBA_boolean"; - {char,_} -> - "CORBA_char"; - {enum, EnumType} -> - EnumType; - _ -> - DiscrStr - end - end. - -getDiscrStr(G, N, S) when element(1, S) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, S) of - {FSN, _, tk_short, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_ushort, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_long, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_ulong, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_boolean, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_char, _} -> - ic_util:to_undersc(FSN); - {FSN, _, {tk_enum,_,_,_}, _} -> - ic_util:to_undersc(FSN); - _ -> - error - end; -getDiscrStr(_G, N, X) -> - case X of - {short,_} -> - "CORBA_short"; - {unsigned,{short,_}} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_long"; - {unsigned,{long,_}} -> - "CORBA_unsigned_long"; - {boolean,_} -> - "CORBA_boolean"; - {char,_} -> - "CORBA_char"; - {enum,TID,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(TID) | N]); - _ -> - error - end. - - - - -getCaseTypeStr(G, N, X, I, T) when element(1, T) == scoped_id -> - case catch ic_symtab:get_full_scoped_name(G, N, T) of - {FSN, _, _, _} -> - BT = ic_code:get_basetype(G, ic_util:to_undersc(FSN)), - case isList(BT) of - true -> - BT; - false -> - case BT of - {short,_} -> - "CORBA_short"; - {unsigned,{short,_}} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_long"; - {unsigned,{long,_}} -> - "CORBA_unsigned_long"; - {float,_} -> - "CORBA_float"; - {double,_} -> - "CORBA_double"; - {boolean,_} -> - "CORBA_boolean"; - {char,_} -> - "CORBA_char"; - {wchar,_} -> - "CORBA_wchar"; - {octet,_} -> - "CORBA_octet"; - {string,_} -> - "CORBA_char*"; - {wstring,_} -> - "CORBA_wchar*"; - {sequence,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]); - {struct,SID,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]); - {enum,EID} -> - EID; - {any, _} -> %% Fix for any type - "CORBA_long"; - _ -> - %%io:format("BT = ~p~n",[BT]), - error - end - end - end; -getCaseTypeStr(_G, N, X, I, T) -> - case T of - {short,_} -> - "CORBA_short"; - {unsigned,{short,_}} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_long"; - {unsigned,{long,_}} -> - "CORBA_unsigned_long"; - {float,_} -> - "CORBA_float"; - {double,_} -> - "CORBA_double"; - {boolean,_} -> - "CORBA_boolean"; - {char,_} -> - "CORBA_char"; - {wchar,_} -> - "CORBA_wchar"; - {octet,_} -> - "CORBA_octet"; - {string,_} -> - "CORBA_char*"; - {wstring,_} -> - "CORBA_wchar*"; - {sequence,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]); - {struct,SID,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]); - {union,UID,_,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]); - {any, _} -> %% Fix for any type - "CORBA_long"; - _ -> - error - end. - -isList(L) when is_list(L) -> - true; -isList(_) -> - false. - -%% -%% Sizecount facilities -%% -emit_union_sizecount(G, N, X, Fd, UnionName) -> - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, int* oe_size) {\n\n", - [ic_util:mk_oe_name(G, "sizecalc_"), UnionName]), - - emit(Fd, " int oe_malloc_size = 0;\n"), - emit(Fd, " int oe_error_code = 0;\n"), - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_tmp = 0;\n"), - emit_union_discr_var_decl(G, N, X, Fd), - - ic_codegen:nl(Fd), - emit(Fd, " if(*oe_size == 0)\n",[]), - AlignName = lists:concat(["*oe_size + sizeof(",UnionName,")"]), - emit(Fd, " *oe_size = ~s;\n\n", [ic_util:mk_align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - - %%emit(Fd, " if (oe_tmp != 3)\n"), - %%emit(Fd, " return -1;\n\n"), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit_c_union_discr_sizecount(G, N, X, Fd), - emit(Fd, " /* Calculate union size */\n"), - emit(Fd, " switch(oe_discr) {\n"), - - emit_c_union_loop(G, N, X, Fd, X#union.body, sizecalc), - emit(Fd, " }\n\n"), - - emit(Fd, " *oe_size = ~s;\n",[ic_util:mk_align("*oe_size+oe_malloc_size")]), - emit(Fd, " return 0;\n"), - emit(Fd, "}\n\n\n"). - - -emit_union_discr_var_decl(G, N, X, Fd) -> - UD = get_c_union_discriminator(G, N, X), - case UD of - "CORBA_short" -> - emit(Fd, " long oe_discr = 0;\n"); - "CORBA_unsigned_short" -> - emit(Fd, " unsigned long oe_discr = 0;\n"); - "CORBA_long" -> - emit(Fd, " long oe_discr = 0;\n"); - "CORBA_unsigned_long" -> - emit(Fd, " unsigned long oe_discr = 0;\n"); - "CORBA_boolean" -> - emit(Fd, " int oe_discr = 0;\n"), - emit(Fd, " char oe_bool[256];\n"); - "CORBA_char" -> - emit(Fd, " char oe_discr = 0;\n"); - _T -> - emit(Fd, " int oe_dummy = 0;\n"), - emit(Fd, " ~s oe_discr = 0;\n",[UD]) - end. - - -emit_c_union_discr_sizecount(G, N, X, Fd) -> - emit(Fd, " /* Calculate discriminator size */\n"), - UD = get_c_union_discriminator(G, N, X), - case UD of - "CORBA_short" -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_short" -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_long" -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_long" -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_boolean" -> - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, oe_bool)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " oe_discr = 0;\n"), - emit(Fd, " }\n"), - emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " oe_discr = 1;\n"), - emit(Fd, " }\n"), - emit(Fd, " else {\n"), - emit_c_dec_rpt(Fd, " ", "not boolean", []), - emit(Fd, " return -1;\n }\n"); - - "CORBA_char" -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - T -> - emit(Fd, " oe_tmp = *oe_size_count_index;\n"), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", [T]), - ?emit_c_dec_rpt(Fd, " ", "oe_size_calc_~s", [T]), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " *oe_size_count_index = oe_tmp;\n"), - emit(Fd, " oe_tmp = oe_env->_iin;\n"), - emit(Fd, " oe_env->_iin = *oe_size_count_index;\n"), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, NULL, &oe_dummy, &oe_discr)) < 0) {\n", [T]), - ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", [T]), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " *oe_size_count_index = oe_env->_iin;\n"), - emit(Fd, " oe_env->_iin = oe_tmp;\n\n") - end. - - - -emit_c_union_loop(G, N, X, Fd, CaseList, Case) -> - emit_c_union_loop(G, N, X, Fd, CaseList, false, Case). - -emit_c_union_loop(G, N, X, Fd, [], GotDefaultCase, Case) -> - case GotDefaultCase of - false -> - emit_c_union_valueless_discriminator(G, N, X, Fd, Case) - end; -emit_c_union_loop(G, N, X, Fd, [CU|CUs], GotDefaultCase, Case) -> - case CU of - {case_dcl,CaseList,I,T} -> - GotDefaultCase = emit_c_union_case(G, N, X, Fd, I, T, CaseList, Case), - emit_c_union_loop(G, N, X, Fd, CUs, GotDefaultCase, Case); - _ -> - error - end. - -emit_c_union_valueless_discriminator(_G, _N, _X, Fd, Case) -> - emit(Fd, " default:\n"), - case Case of - sizecalc -> - emit(Fd, " {\n"), - emit(Fd, " char oe_undefined[15];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, " - "oe_size_count_index, oe_undefined)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " }\n"); - encode -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"undefined\")) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"); - decode -> - emit(Fd, " {\n"), - emit(Fd, " char oe_undefined[15];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, " - "oe_undefined)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_undefined, \"undefined\") != 0) {\n"), - emit_c_dec_rpt(Fd, " ", "undefined", []), - emit(Fd, " return -1;\n }\n"), - emit(Fd, " }\n") - end. - - -emit_c_union_case(G, N, X, Fd, I, T, [{default,_}], Case) -> - emit(Fd, " default:\n"), - case Case of - sizecalc -> - getCaseTypeSizecalc(G, N, X, Fd, I, T); - encode -> - getCaseTypeEncode(G, N, X, Fd, I, T); - decode -> - getCaseTypeDecode(G, N, X, Fd, I, T) - end, - true; -emit_c_union_case(G, N, X, Fd, I, T, [{Bool,_}], Case) -> %% Boolean discriminator - case Bool of - 'TRUE' -> - emit(Fd, " case 1:\n"); - 'FALSE' -> - emit(Fd, " case 0:\n") - end, - case Case of - sizecalc -> - getCaseTypeSizecalc(G, N, X, Fd, I, T); - encode -> - getCaseTypeEncode(G, N, X, Fd, I, T); - decode -> - getCaseTypeDecode(G, N, X, Fd, I, T) - end, - emit(Fd, " break;\n\n"), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{Bool,_}|Rest], Case) -> %% Boolean discriminator - case Bool of - 'TRUE' -> - emit(Fd, " case 1:\n"); - 'FALSE' -> - emit(Fd, " case 0:\n") - end, - emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{_,_,NrStr}], Case) -> %% Integer type discriminator - case get_c_union_discriminator(G, N, X) of - "CORBA_char" -> - emit(Fd, " case \'~s\':\n",[NrStr]); - _ -> - emit(Fd, " case ~s:\n",[NrStr]) - end, - case Case of - sizecalc -> - getCaseTypeSizecalc(G, N, X, Fd, I, T); - encode -> - getCaseTypeEncode(G, N, X, Fd, I, T); - decode -> - getCaseTypeDecode(G, N, X, Fd, I, T) - end, - emit(Fd, " break;\n\n"), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{_,_,NrStr}|Rest], Case) -> %% Integer type discriminator - emit(Fd, " case ~s:\n",[NrStr]), - emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{scoped_id,_,_,[EID]}], Case) -> %% Enumerant type discriminator - SID = ic_util:to_undersc([EID|get_c_union_discriminator_scope(G, N, X)]), - %%io:format("SID = ~p~n",[SID]), - emit(Fd, " case ~s:\n",[SID]), - case Case of - sizecalc -> - getCaseTypeSizecalc(G, N, X, Fd, I, T); - encode -> - getCaseTypeEncode(G, N, X, Fd, I, T); - decode -> - getCaseTypeDecode(G, N, X, Fd, I, T) - end, - emit(Fd, " break;\n\n"), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{scoped_id,_,_,[EID]}|Rest], Case) -> %% Enumerant type discriminator - SID = ic_util:to_undersc([EID|get_c_union_discriminator_scope(G, N, X)]), - %%io:format("SID = ~p~n",[SID]), - emit(Fd, " case ~s:\n",[SID]), - emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), - false. - - -%% -%% Returns the enumerant discriminator scope -%% -get_c_union_discriminator_scope(G, N, X) -> - {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, X#union.type), - BT = case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of - {enum,ST} -> - ST; - Other -> - Other - end, - tl(lists:reverse(string:tokens(BT,"_"))). %% Ugly work arround - - - - - -getCaseTypeSizecalc(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> - case ic_fetch:member2type(G,X,I) of - ushort -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - ulong -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - short -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - long -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - float -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - double -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - boolean -> - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"); - char -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - octet -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - string -> - emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_malloc_size = ~s;\n",[ic_util:mk_align("oe_malloc_size+oe_tmp+1")]); - any -> %% Fix for any type - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - - _ -> - case getCaseTypeStr(G, N, X, I, T) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = ei_decode_pid(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", - []), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = ei_decode_port(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", - []), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = ei_decode_ref(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", - []), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_term" -> - emit(Fd, " if ((oe_error_code = ei_decode_term(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", - []), - ?emit_c_dec_rpt(Fd, " ", "ei_deoce_term", []), - emit(Fd, " return oe_error_code;\n }\n"); - - Other -> - - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [Other]), - ?emit_c_dec_rpt(Fd, " ", "oe_sizecalc_~s", [Other]), - emit(Fd, " return oe_error_code;\n }\n") - end - end; -getCaseTypeSizecalc(G, N, X, Fd, I, T) -> - case I of - {array,_,_} -> - ArrayName = ic_util:to_undersc([ic_forms:get_id2(I),ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ArrayName]), - ?emit_c_dec_rpt(Fd, " ", "oe_sizecalc_~s", [ArrayName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - case T of - {short,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{short,_}} -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {long, _} -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{long,_}} -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {float,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }"); - {double,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - {boolean,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"); - {char,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {octet,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {string,_} -> - emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_malloc_size = ~s;\n",[ic_util:mk_align("oe_malloc_size+oe_tmp+1")]); - {sequence,_,_} -> - SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [SeqName]), - ?emit_c_dec_rpt(Fd, " ", "sequence:oe_sizecalc_~s", [SeqName]), - emit(Fd, " return oe_error_code;\n }\n"); - {struct,SID,_,_} -> - StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [StructName]), - ?emit_c_dec_rpt(Fd, " ", "struct:oe_sizecalc_~s", [StructName]), - emit(Fd, " return oe_error_code;\n }\n"); - {union,UID,_,_,_} -> - UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [UnionName]), - ?emit_c_dec_rpt(Fd, " ", "union:oe_sizecalce_~s", [UnionName]), - emit(Fd, " return oe_error_code;\n }\n"); - {any, _} -> %% Fix for any type - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "any:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end - end. - - - - - -%% -%% Encode facilities -%% -emit_union_encode(G, N, X, Fd, UnionName) -> - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec) {\n\n", - [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]), - - emit(Fd, " int oe_error_code = 0;\n\n"), - - emit(Fd, " if ((oe_error_code = oe_ei_encode_tuple_header(oe_env, 3)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"~s\")) < 0) {\n", - [UnionName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit_c_union_discr_encode(G, N, X, Fd), - emit(Fd, " /* Encode union */\n"), - emit(Fd, " switch(oe_rec->_d) {\n"), - emit_c_union_loop(G, N, X, Fd, X#union.body, encode), - emit(Fd, " }\n\n"), - emit(Fd, " return 0;\n"), - emit(Fd, "}\n\n\n"). - - -emit_c_union_discr_encode(G, N, X, Fd) -> - emit(Fd, " /* Encode descriminator */\n"), - UD = get_c_union_discriminator(G, N, X), - case UD of - "CORBA_short" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_short" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_long" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_long" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_boolean" -> - emit(Fd, " switch(oe_rec->_d) {\n"), - emit(Fd, " case 0:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default:\n"), - emit_c_enc_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n\n"); - "CORBA_char" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - T -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_d)) < 0) {\n", [T]), - ?emit_c_enc_rpt(Fd, " ", "oe_encode_~s", [T]), - emit(Fd, " return oe_error_code;\n }\n") - end. - - -getCaseTypeEncode(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> - case ic_fetch:member2type(G,X,I) of - ushort -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "ushort:oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - ulong -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "ulong:oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - short -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "short:oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - long -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "long:oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - float -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "float:oe_ei_encode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - double -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "double:oe_ei_encode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - boolean -> - emit(Fd, " switch(oe_rec->_u.~s) {\n",[ic_forms:get_id2(I)]), - emit(Fd, " case 0:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default:\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"); - char -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "char:oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - octet -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "octet:oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - string -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_string", []), - emit(Fd, " return oe_error_code;\n }\n"); - struct -> - case ic_cbe:mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_pid(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_port(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ref(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_term(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T), ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n") - end; - sequence -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "sequence:oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - array -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "array:oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - union -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "union:oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - enum -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "enum:oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - any -> %% Fix for any type - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "enum:oe_ei_encodelong", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end; -getCaseTypeEncode(G, N, X, Fd, I, T) -> - case I of - {array,AID,_} -> - ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ArrayName,ic_forms:get_id2(AID)]), - ?emit_c_enc_rpt(Fd, " ", "array:oe_encode_~s", [ArrayName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - case T of - {short,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "short:oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{short,_}} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "ushort:oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {long, _} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "long:oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{long,_}} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "ulong:oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {float,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "float:oe_ei_encode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - {double,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "double:oe_ei_encode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - {boolean,_} -> - emit(Fd, " switch(oe_rec->_u.~s) {\n",[ic_forms:get_id2(I)]), - emit(Fd, " case 0:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default:\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"); - {char,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "char:oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {octet,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "octet:oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {string,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_string", []), - emit(Fd, " return oe_error_code;\n }\n"); - {sequence,_,_} -> - SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [SeqName,ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "sequence:oe_encode_~s", [SeqName]), - emit(Fd, " return oe_error_code;\n }\n"); - {struct,SID,_,_} -> - StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [StructName,ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "struct:oe_encode_~s", [StructName]), - emit(Fd, " return oe_error_code;\n }\n"); - {union,UID,_,_,_} -> - UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [UnionName,ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "union:oe_encode_~s", [UnionName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end - end. - - - - -%% -%% Decode facilities -%% -emit_union_decode(G, N, X, Fd, UnionName) -> - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, int* oe_index, ~s* oe_rec) {\n\n", - [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]), - - emit(Fd, " int oe_error_code = 0;\n"), - emit(Fd, " int oe_tmp = 0;\n"), - emit(Fd, " char oe_union_name[256];\n\n"), - - emit(Fd, " if((char*) oe_rec == oe_first)\n",[]), - AlignName = lists:concat(["*oe_index + sizeof(",UnionName,")"]), - emit(Fd, " *oe_index = ~s;\n\n", [ic_util:mk_align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, &oe_env->_iin, &oe_tmp)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_union_name)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit_c_union_discr_decode(G, N, X, Fd), - emit(Fd, " /* Decode union */\n"), - emit(Fd, " switch(oe_rec->_d) {\n"), - emit_c_union_loop(G, N, X, Fd, X#union.body, decode), - emit(Fd, " }\n\n"), - - emit(Fd, " *oe_index = ~s;\n", [ic_util:mk_align("*oe_index")]), - emit(Fd, " return 0;\n"), - emit(Fd, "}\n\n\n"). - - -emit_c_union_discr_decode(G, N, X, Fd) -> - emit(Fd, " /* Decode descriminator */\n"), - UD = get_c_union_discriminator(G, N, X), - case UD of - "CORBA_short" -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_d = (short) oe_long;\n\n"), - emit(Fd, " if (oe_rec->_d != oe_long)\n return -1;\n"), - emit(Fd, " }\n\n"); - "CORBA_unsigned_short" -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "unshort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_d = (unsigned short) oe_ulong;\n\n"), - emit(Fd, " if (oe_rec->_d != oe_ulong)\n return -1;\n"), - emit(Fd, " }\n\n"); - "CORBA_long" -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_long" -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_boolean" -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " oe_rec->_d = 0;\n"), - emit(Fd, " }else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " oe_rec->_d = 1;\n"), - emit(Fd, " } else {\n"), - emit_c_dec_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n }\n"), - emit(Fd, " }\n\n"); - "CORBA_char" -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - T -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_d)) < 0) {\n", - [T]), - ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", [T]), - emit(Fd, " return oe_error_code;\n }\n") - end. - - - -getCaseTypeDecode(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> - case ic_fetch:member2type(G,X,I) of - ushort -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (unsigned short) oe_ulong;\n\n",[ic_forms:get_id2(I)]), - emit(Fd, " if (oe_rec->_u.~s != oe_ulong)\n return -1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - ulong -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - short -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (short) oe_long;\n\n",[ic_forms:get_id2(I)]), - emit(Fd, " if (oe_rec->_u.~s != oe_long)\n return -1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - long -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - float -> - emit(Fd, " {\n"), - emit(Fd, " double oe_double;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_double)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (float) oe_double;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - double -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - boolean -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " oe_rec->_u.~s = 0;\n",[ic_forms:get_id2(I)]), - emit(Fd, " } else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " oe_rec->_u.~s = 1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " } else {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n }\n"), - emit(Fd, " }\n"); - char -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - octet -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - string -> - emit(Fd, " {\n"), - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_string_ctr = 0;\n\n"), - - emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, &oe_type, &oe_string_ctr);\n\n"), - - emit(Fd, " oe_rec->_u.~s = (void *) (oe_first + *oe_index);\n\n",[ic_forms:get_id2(I)]), - - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, &oe_env->_iin, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " *oe_index = ~s;\n",[ic_util:mk_align("*oe_index+oe_string_ctr+1")]), - emit(Fd, " }\n"); - struct -> - case ic_cbe:mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = ei_decode_pid(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = ei_decode_port(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = ei_decode_ref(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - emit(Fd, " if ((oe_error_code = ei_decode_term(oe_env->_inbuf, &oe_env->_iin, (void **)&oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_term", []), - emit(Fd, " return oe_error_code;\n }\n"); - - _ -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n") - end; - sequence -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "sequence:oe_decode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - array -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "array:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - union -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "union:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - enum -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "enum:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - any -> %% Fix for any type - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "any:ei_decodelong", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end; -getCaseTypeDecode(G, N, X, Fd, I, T) -> - case I of - {array,AID,_} -> - ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, oe_rec->_u.~s)) < 0) {\n", - [ArrayName,ic_forms:get_id2(AID)]), - ?emit_c_dec_rpt(Fd, " ", "array:oe_decode_~s", [ArrayName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - case T of - {short,_} -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (short) oe_long;\n\n",[ic_forms:get_id2(I)]), - emit(Fd, " if (oe_rec->_u.~s != oe_long)\n return -1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - {unsigned,{short,_}} -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (unsigned short) oe_ulong;\n\n",[ic_forms:get_id2(I)]), - emit(Fd, " if (oe_rec->_u.~s != oe_ulong)\n return -1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - {long, _} -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{long,_}} -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {float,_} -> - emit(Fd, " {\n"), - emit(Fd, " double oe_double;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_double)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (float) oe_double;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - {double,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "dobule:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - {boolean,_} -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " oe_rec->_u.~s = 0;\n",[ic_forms:get_id2(I)]), - emit(Fd, " } else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " oe_rec->_u.~s = 1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " } else {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n }\n"), - emit(Fd, " }\n"); - {char,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {octet,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - emit(Fd, " return oe_error_code;\n }\n"); - {string,_} -> - emit(Fd, " {\n"), - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_string_ctr = 0;\n\n"), - - emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, &oe_type, &oe_string_ctr);\n\n"), - - emit(Fd, " oe_rec->_u.~s = (void *) (oe_first + *oe_index);\n\n",[ic_forms:get_id2(I)]), - - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, &oe_env->_iin, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " *oe_index = ~s;\n",[ic_util:mk_align("*oe_index+oe_string_ctr+1")]), - emit(Fd, " }\n"); - {sequence,_,_} -> - SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [SeqName,ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "sequence:oe_decode_~s", [SeqName]), - emit(Fd, " return oe_error_code;\n }\n"); - {struct,SID,_,_} -> - StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [StructName,ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "struct:oe_decode_~s", [StructName]), - emit(Fd, " return oe_error_code;\n }\n"); - {union,UID,_,_,_} -> - UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [UnionName,ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "union:oe_decode_~s", [UnionName]), - emit(Fd, " return oe_error_code;\n }"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end - end. - -mvDefaultToTail(CDclL) -> - mvDefaultToTail(CDclL,[],[]). - - -mvDefaultToTail([], F, FD) -> - lists:reverse(F) ++ FD; -mvDefaultToTail([{case_dcl,CaseList,I,T}|Rest], Found, FoundDefault) -> - case lists:keysearch(default, 1, CaseList) of - {value,Default} -> - NewCaseList = lists:delete(Default, CaseList) ++ [Default], - mvDefaultToTail(Rest, Found, [{case_dcl,NewCaseList,I,T}|FoundDefault]); - false -> - mvDefaultToTail(Rest, [{case_dcl,CaseList,I,T}|Found], FoundDefault) - end. - - diff --git a/lib/ic/src/icyeccpre.hrl b/lib/ic/src/icyeccpre.hrl deleted file mode 100644 index 3a2fad185f..0000000000 --- a/lib/ic/src/icyeccpre.hrl +++ /dev/null @@ -1,125 +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% -%% -%% - - --export([parse/1, parse_and_scan/1, format_error/1]). - --import(lists, [reverse/1]). - --ifdef(JAM). --compile([{parse_transform,jam_yecc_pj},pj]). --endif. - - --include("icforms.hrl"). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% The parser generator will insert appropriate declarations before this line.% - -parse(Tokens) -> - case catch yeccpars1(Tokens, false, 0, [], []) of - error -> - Errorline = - if Tokens == [] -> 0; true -> element(2, hd(Tokens)) end, - {error, - {Errorline, ?MODULE, "syntax error at or after this line."}}; - Other -> - Other - end. - -parse_and_scan({Mod, Fun, Args}) -> - case apply(Mod, Fun, Args) of - {eof, _} -> - {ok, eof}; - {error, Descriptor, _} -> - {error, Descriptor}; - {ok, Tokens, _} -> - yeccpars1(Tokens, {Mod, Fun, Args}, 0, [], []) - end. - -format_error(Message) -> - case io_lib:deep_char_list(Message) of - true -> - Message; - _ -> - io_lib:write(Message) - end. - -% To be used in grammar files to throw an error message to the parser toplevel. -% Doesn't have to be exported! -return_error(Line, Message) -> - throw({error, {Line, ?MODULE, Message}}). - - -% Don't change yeccpars1/6 too much, it is called recursively by yeccpars2/8! -yeccpars1([Token | Tokens], Tokenizer, State, States, Vstack) -> - yeccpars2(State, element(1, Token), States, Vstack, Token, Tokens, - Tokenizer); -yeccpars1([], {M, F, A}, State, States, Vstack) -> - case catch apply(M, F, A) of - {eof, Endline} -> - {error, {Endline, ?MODULE, "end_of_file"}}; - {error, Descriptor, _Endline} -> - {error, Descriptor}; - {'EXIT', Reason} -> - {error, {0, ?MODULE, Reason}}; - {ok, Tokens, _Endline} -> - case catch yeccpars1(Tokens, {M, F, A}, State, States, Vstack) of - error -> - Errorline = element(2, hd(Tokens)), - {error, {Errorline, ?MODULE, - "syntax error at or after this line."}}; - Other -> - Other - end - end; -yeccpars1([], false, State, States, Vstack) -> - yeccpars2(State, '$end', States, Vstack, {'$end', 999999}, [], false). - -% For internal use only. -yeccerror(Token) -> - {error, - {element(2, Token), ?MODULE, - ["syntax error before: ", yecctoken2string(Token)]}}. - -yecctoken2string({atom, _, A}) -> io_lib:write(A); -yecctoken2string({integer,_,N}) -> io_lib:write(N); -yecctoken2string({float,_,F}) -> io_lib:write(F); -yecctoken2string({char,_,C}) -> io_lib:write_char(C); -yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]); -yecctoken2string({string,_,S}) -> io_lib:write_string(S); -yecctoken2string({reserved_symbol, _, A}) -> io_lib:format("~w", [A]); -yecctoken2string({'dot', _}) -> "'.'"; -yecctoken2string({'$end', _}) -> - []; -yecctoken2string({Other, _}) when is_atom(Other) -> - io_lib:format("~w", [Other]); -yecctoken2string({_, _, Other}) when is_list(Other) andalso is_number(hd(Other)) -> - Other; -yecctoken2string({_, _, Other}) -> - io_lib:format("~p", [Other]); -yecctoken2string(Other) -> - io_lib:write(Other). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - diff --git a/lib/ic/test/Makefile b/lib/ic/test/Makefile deleted file mode 100644 index 55b8915875..0000000000 --- a/lib/ic/test/Makefile +++ /dev/null @@ -1,276 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-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% -# -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(IC_VSN) -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/ic_test - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -TEST_SPEC_FILE = ic.spec ic_smoke.spec - - -IDL_FILES = - -COMPILER_TEST_FILES = \ - ic_SUITE_data/Corba.idl \ - ic_SUITE_data/Coss.idl \ - ic_SUITE_data/attr.idl \ - ic_SUITE_data/c_err1.idl \ - ic_SUITE_data/c_err2.idl \ - ic_SUITE_data/c_err3.idl \ - ic_SUITE_data/c_norm.idl \ - ic_SUITE_data/enum.idl \ - ic_SUITE_data/forward.idl \ - ic_SUITE_data/include.idl \ - ic_SUITE_data/include2.idl \ - ic_SUITE_data/include3.idl \ - ic_SUITE_data/inherit.idl \ - ic_SUITE_data/inherit_err.idl \ - ic_SUITE_data/inherit_warn.idl \ - ic_SUITE_data/mult_ids.idl \ - ic_SUITE_data/nasty.idl \ - ic_SUITE_data/one.idl \ - ic_SUITE_data/one_out.idl \ - ic_SUITE_data/one_raises.idl \ - ic_SUITE_data/one_followed.idl \ - ic_SUITE_data/one_void.idl \ - ic_SUITE_data/raises_reg.idl \ - ic_SUITE_data/struct.idl \ - ic_SUITE_data/syntax1.idl \ - ic_SUITE_data/syntax2.idl \ - ic_SUITE_data/syntax3.idl \ - ic_SUITE_data/syntax4.idl \ - ic_SUITE_data/syntax5.idl \ - ic_SUITE_data/syntax6.idl \ - ic_SUITE_data/type.idl \ - ic_SUITE_data/typeid.idl \ - ic_SUITE_data/u_case_mult.idl \ - ic_SUITE_data/u_mult.idl \ - ic_SUITE_data/u_norm.idl \ - ic_SUITE_data/u_type.idl \ - ic_SUITE_data/u_default.idl \ - ic_SUITE_data/undef_id.idl - - -COMPILER_TEST_FILES2 = \ - ic_register_SUITE_data/reg_m8.idl \ - ic_register_SUITE_data/reg_m9.idl \ - ic_register_SUITE_data/reg_m10.idl \ - ic_register_SUITE_data/reg_m11.idl \ - ic_register_SUITE_data/reg_m12.idl - - -COMPILER_TEST_FILES3 = \ - ic_pragma_SUITE_data/reg_m0.idl \ - ic_pragma_SUITE_data/reg_m1.idl \ - ic_pragma_SUITE_data/reg_m2.idl \ - ic_pragma_SUITE_data/reg_m3.idl \ - ic_pragma_SUITE_data/reg_m4.idl \ - ic_pragma_SUITE_data/reg_m5.idl \ - ic_pragma_SUITE_data/reg_m6.idl \ - ic_pragma_SUITE_data/reg_m7.idl \ - ic_pragma_SUITE_data/uggly.idl - - -COMPILER_TEST_FILES4 = \ - ic_be_SUITE_data/plain.idl - - -PREPROCESSOR_TEST_FILES = \ - ic_pp_SUITE_data/arg.idl \ - ic_pp_SUITE_data/cascade.idl \ - ic_pp_SUITE_data/comment.idl \ - ic_pp_SUITE_data/concat.idl \ - ic_pp_SUITE_data/define.idl \ - ic_pp_SUITE_data/if.idl \ - ic_pp_SUITE_data/if_zero.idl \ - ic_pp_SUITE_data/improp_nest_constr.idl \ - ic_pp_SUITE_data/inc.idl \ - ic_pp_SUITE_data/line.idl \ - ic_pp_SUITE_data/misc.idl \ - ic_pp_SUITE_data/nopara.idl \ - ic_pp_SUITE_data/predef.idl \ - ic_pp_SUITE_data/predef_time.idl \ - ic_pp_SUITE_data/self_ref.idl \ - ic_pp_SUITE_data/separate.idl \ - ic_pp_SUITE_data/swallow_sc.idl \ - ic_pp_SUITE_data/unintended_grp.idl - -C_CLIENT_ERL_SERVER_TEST_FILES = \ - c_client_erl_server_SUITE_data/Makefile.src \ - c_client_erl_server_SUITE_data/c_erl_test.idl \ - c_client_erl_server_SUITE_data/c_client.c \ - c_client_erl_server_SUITE_data/m_i_impl.erl - -C_CLIENT_ERL_SERVER_PROTO_TEST_FILES = \ - c_client_erl_server_proto_SUITE_data/Makefile.src \ - c_client_erl_server_proto_SUITE_data/c_erl_test.idl \ - c_client_erl_server_proto_SUITE_data/c_client.c \ - c_client_erl_server_proto_SUITE_data/my.c \ - c_client_erl_server_proto_SUITE_data/m_i_impl.erl - -C_CLIENT_ERL_SERVER_PROTO_TMO_TEST_FILES = \ - c_client_erl_server_proto_tmo_SUITE_data/Makefile.src \ - c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl \ - c_client_erl_server_proto_tmo_SUITE_data/c_client.c \ - c_client_erl_server_proto_tmo_SUITE_data/my.c \ - c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl - -ERL_CLIENT_C_SERVER_TEST_FILES = \ - erl_client_c_server_SUITE_data/Makefile.src \ - erl_client_c_server_SUITE_data/erl_c_test.idl \ - erl_client_c_server_SUITE_data/erl_client.erl \ - erl_client_c_server_SUITE_data/c_server.c \ - erl_client_c_server_SUITE_data/callbacks.c - -ERL_CLIENT_C_SERVER_PROTO_TEST_FILES = \ - erl_client_c_server_proto_SUITE_data/Makefile.src \ - erl_client_c_server_proto_SUITE_data/erl_c_test.idl \ - erl_client_c_server_proto_SUITE_data/erl_client.erl \ - erl_client_c_server_proto_SUITE_data/c_server.c \ - erl_client_c_server_proto_SUITE_data/callbacks.c - -JAVA_CLIENT_ERL_SERVER_TEST_FILES = \ - java_client_erl_server_SUITE_data/Makefile.src \ - java_client_erl_server_SUITE_data/java_erl_test.idl \ - java_client_erl_server_SUITE_data/JavaClient.java \ - java_client_erl_server_SUITE_data/m_i_impl.erl - -MODULES = \ - ic_SUITE \ - ic_register_SUITE \ - ic_pragma_SUITE \ - ic_pp_SUITE \ - ic_be_SUITE \ - c_client_erl_server_SUITE \ - c_client_erl_server_proto_SUITE \ - c_client_erl_server_proto_tmo_SUITE \ - erl_client_c_server_SUITE \ - erl_client_c_server_proto_SUITE \ - java_client_erl_server_SUITE - -GEN_MODULES = - -ERL_FILES = $(MODULES:%=%.erl) - -HRL_FILES = - -GEN_HRL_FILES = - - -GEN_FILES = \ - $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \ - $(GEN_MODULES=:%=$(IDLOUTDIR)/%.erl) - -GEN_TARGET_FILES = $(GEN_MODULES:%=$(IDLOUTDIR)/%.$(EMULATOR)) - -SUITE_TARGET_FILES = $(MODULES:%=%.$(EMULATOR)) - -TARGET_FILES = \ - $(GEN_TARGET_FILES) \ - $(SUITE_TARGET_FILES) - -# ---------------------------------------------------- -# PROGRAMS -# ---------------------------------------------------- - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_LOCAL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin -pa $(ERL_TOP)/lib/ic/ebin - -ERL_COMPILE_FLAGS += \ - $(ERL_LOCAL_FLAGS) \ - -pa $(ERL_TOP)/lib/orber/ebin \ - -I$(ERL_TOP)/lib/orber - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -tests debug opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - -docs: - -# ---------------------------------------------------- -# Special Targets -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# Release Targets -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: - -release_docs_spec: - -release_tests_spec: tests - $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELSYSDIR)/ic_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/ic_register_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/ic_pragma_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/ic_pp_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/ic_be_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/c_client_erl_server_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/c_client_erl_server_proto_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/c_client_erl_server_proto_tmo_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/erl_client_c_server_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/erl_client_c_server_proto_SUITE_data" - $(INSTALL_DIR) "$(RELSYSDIR)/java_client_erl_server_SUITE_data" - $(INSTALL_DATA) $(IDL_FILES) ic.cover $(TEST_SPEC_FILE) $(ERL_FILES) \ - "$(RELSYSDIR)" - $(INSTALL_DATA) $(COMPILER_TEST_FILES) "$(RELSYSDIR)/ic_SUITE_data" - $(INSTALL_DATA) $(COMPILER_TEST_FILES2) \ - "$(RELSYSDIR)/ic_register_SUITE_data" - $(INSTALL_DATA) $(COMPILER_TEST_FILES3) \ - "$(RELSYSDIR)/ic_pragma_SUITE_data" - $(INSTALL_DATA) $(COMPILER_TEST_FILES4) \ - "$(RELSYSDIR)/ic_be_SUITE_data" - $(INSTALL_DATA) $(PREPROCESSOR_TEST_FILES) \ - "$(RELSYSDIR)/ic_pp_SUITE_data" - $(INSTALL_DATA) $(C_CLIENT_ERL_SERVER_TEST_FILES) \ - "$(RELSYSDIR)/c_client_erl_server_SUITE_data" - $(INSTALL_DATA) $(C_CLIENT_ERL_SERVER_PROTO_TEST_FILES) \ - "$(RELSYSDIR)/c_client_erl_server_proto_SUITE_data" - $(INSTALL_DATA) $(C_CLIENT_ERL_SERVER_PROTO_TMO_TEST_FILES) \ - "$(RELSYSDIR)/c_client_erl_server_proto_tmo_SUITE_data" - $(INSTALL_DATA) $(ERL_CLIENT_C_SERVER_TEST_FILES) \ - "$(RELSYSDIR)/erl_client_c_server_SUITE_data" - $(INSTALL_DATA) $(ERL_CLIENT_C_SERVER_PROTO_TEST_FILES) \ - "$(RELSYSDIR)/erl_client_c_server_proto_SUITE_data" - $(INSTALL_DATA) $(SUITE_TARGET_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) $(JAVA_CLIENT_ERL_SERVER_TEST_FILES) \ - "$(RELSYSDIR)/java_client_erl_server_SUITE_data" diff --git a/lib/ic/test/c_client_erl_server_SUITE.erl b/lib/ic/test/c_client_erl_server_SUITE.erl deleted file mode 100644 index b6e100e102..0000000000 --- a/lib/ic/test/c_client_erl_server_SUITE.erl +++ /dev/null @@ -1,265 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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 c-client/erl-server -%%---------------------------------------------------------------------- - - --module(c_client_erl_server_SUITE). --include_lib("common_test/include/ct.hrl"). - --export([init_per_testcase/2, end_per_testcase/2, - all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - void_test/1, long_test/1, long_long_test/1, - unsigned_short_test/1, unsigned_long_test/1, - unsigned_long_long_test/1, double_test/1, char_test/1, - wchar_test/1, octet_test/1, bool_test/1, struct_test/1, - struct2_test/1, seq1_test/1, seq2_test/1, seq3_test/1, - seq4_test/1, seq5_test/1, array1_test/1, array2_test/1, - enum_test/1, string1_test/1, string2_test/1, string3_test/1, - string4_test/1, pid_test/1, port_test/1, ref_test/1, term_test/1, - typedef_test/1, inline_sequence_test/1, term_sequence_test/1, - term_struct_test/1, wstring1_test/1]). - --define(DEFAULT_TIMEOUT, 20000). --define(PORT_TIMEOUT, 15000). --define(ERLANG_SERVER_NAME, idl_erlang_server). --define(C_CLIENT_NODE_NAME, c_client_idl_test). - -%% Add/remove code path and watchdog before/after each test case. -%% -init_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:add_patha(DataDir), - - %% Since other test suites use the module m_i, we have - %% to make sure we are using the right m_i module. - code:purge(m_i), - code:load_file(m_i), - - WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:del_path(DataDir), - WatchDog = proplists:get_value(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [void_test, long_test, long_long_test, - unsigned_short_test, unsigned_long_test, - unsigned_long_long_test, double_test, char_test, - wchar_test, octet_test, bool_test, struct_test, - struct2_test, seq1_test, seq2_test, seq3_test, - seq4_test, seq5_test, array1_test, array2_test, - enum_test, string1_test, string2_test, string3_test, - string4_test, pid_test, port_test, ref_test, term_test, - typedef_test, inline_sequence_test, term_sequence_test, - term_struct_test, wstring1_test]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -array1_test(Config) -> - do_test(array1_test, Config). - -array2_test(Config) -> - do_test(array2_test, Config). - -bool_test(Config) -> - do_test(bool_test, Config). - -char_test(Config) -> - do_test(char_test, Config). - -double_test(Config) -> - do_test(double_test, Config). - -enum_test(Config) -> - do_test(enum_test, Config). - -inline_sequence_test(Config) -> - do_test(inline_sequence_test, Config). - -long_long_test(Config) -> - do_test(long_long_test, Config). - -long_test(Config) -> - do_test(long_test, Config). - -octet_test(Config) -> - do_test(octet_test, Config). - -pid_test(Config) -> - do_test(pid_test, Config). - -port_test(Config) -> - do_test(port_test, Config). - -ref_test(Config) -> - do_test(ref_test, Config). - -seq1_test(Config) -> - do_test(seq1_test, Config). - -seq2_test(Config) -> - do_test(seq2_test, Config). - -seq3_test(Config) -> - do_test(seq3_test, Config). - -seq4_test(Config) -> - do_test(seq4_test, Config). - -seq5_test(Config) -> - do_test(seq5_test, Config). - -string1_test(Config) -> - do_test(string1_test, Config). - -string2_test(Config) -> - do_test(string2_test, Config). - -string3_test(Config) -> - do_test(string3_test, Config). - -string4_test(Config) -> - do_test(string4_test, Config). - -struct2_test(Config) -> - do_test(struct2_test, Config). - -struct_test(Config) -> - do_test(struct_test, Config). - -term_sequence_test(Config) -> - do_test(term_sequence_test, Config). - -term_struct_test(Config) -> - do_test(term_struct_test, Config). - -term_test(Config) -> - do_test(term_test, Config). - -typedef_test(Config) -> - do_test(typedef_test, Config). - -unsigned_long_long_test(Config) -> - do_test(unsigned_long_long_test, Config). - -unsigned_long_test(Config) -> - do_test(unsigned_long_test, Config). - -unsigned_short_test(Config) -> - do_test(unsigned_short_test, Config). - -void_test(Config) -> - do_test(void_test, Config). - -wchar_test(Config) -> - do_test(wchar_test, Config). - -wstring1_test(Config) -> - do_test(wstring1_test, Config). - - -%% It is here that all tests really are done. -%% - -do_test(Case, Config) -> - %% Trap exits - process_flag(trap_exit, true), - %% Start the server - {ok, _Pid} = m_i:oe_create_link([], {local, ?ERLANG_SERVER_NAME}), - Node = atom_to_list(node()), - DataDir = proplists:get_value(data_dir, Config), - %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]), - Cookie = atom_to_list(erlang:get_cookie()), - %% Start C-client node as a port program. - Cmd = filename:join([DataDir, "c_client"]) ++ - " -this-node-name " ++ atom_to_list(?C_CLIENT_NODE_NAME) ++ - " -peer-node " ++ Node ++ - " -peer-process-name " ++ atom_to_list(?ERLANG_SERVER_NAME) ++ - " -cookie " ++ Cookie ++ - " -test-case " ++ atom_to_list(Case), - Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]), - Res = wait_for_completion(Port), - %% Kill off node if there was timeout - case Res of - {error, timeout} -> - catch rpc:cast(?C_CLIENT_NODE_NAME, erlang, halt, [1]); - _ -> - ok - end, - process_flag(trap_exit, false), - catch m_i:stop(?ERLANG_SERVER_NAME), - ok = Res. - - -%% Wait for eof *and* exit status, but return if exit status indicates -%% an error, or we have been waiting more than PORT_TIMEOUT seconds. -%% -wait_for_completion(Port) -> - wait_for_completion(Port, 0). - -wait_for_completion(Port, N) when N < 2 -> - receive - {Port, {data, Bytes}} -> - %% Relay output - io:format("~s", [Bytes]), - wait_for_completion(Port, N); - {Port, {exit_status, 0}} -> - wait_for_completion(Port, N + 1); - {Port, {exit_status, Status}} -> - {error, Status}; - {Port, eof} -> - wait_for_completion(Port, N + 1); - {'EXIT', Port, Reason} -> - io:format("Port exited with reason: ~w~n", [Reason]), - wait_for_completion(Port, N); - {'EXIT', From, Reason} -> - io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]), - wait_for_completion(Port, N) - after ?PORT_TIMEOUT -> - {error, timeout} - end; -wait_for_completion(_, _) -> - ok. - - - diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/Makefile.src b/lib/ic/test/c_client_erl_server_SUITE_data/Makefile.src deleted file mode 100644 index 60ea8ea598..0000000000 --- a/lib/ic/test/c_client_erl_server_SUITE_data/Makefile.src +++ /dev/null @@ -1,155 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2001-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% -# -# -# Makefile.src for c_client_erl_server test -# Note: This file *must* work for both Unix and Windows -# -# We use both `rm' (Unix) and `del' (Windows) for removing files, but -# with a `-' in front so that the error in not finding `rm' (`del') on -# Windows (Unix) is ignored. -# -# VxWorks? XXX -# - -.SUFFIXES: -.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@ - - -# Variables from ts: -# - -ERL_INCLUDE = @erl_include@ - -IC_INCLUDE_PATH = @ic_include_path@ -IC_LIB = @ic_lib@ - -ERL_INTERFACE_INCLUDE = @erl_interface_include@ -ERL_INTERFACE_LIB = @erl_interface_lib@ -ERL_INTERFACE_EILIB = @erl_interface_eilib@ -ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@ -ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@ - -CC = @CC@ -## XXX Should set warning flag with a DEBUG_FLAG -CFLAGS = @CFLAGS@ @DEFS@ -I@erl_include@ \ - -I@ic_include_path@ -I@erl_interface_include@ - -LD = @LD@ -LDFLAGS = @CROSSLDFLAGS@ -LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \ - $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS) -ERLC = erlc - -# Generated C header files -GEN_H_FILES = \ - m.h \ - m_i.h \ - oe_c_erl_test.h - -# Generated C files -GEN_C_FILES = \ - m.c \ - m_i.c \ - oe_c_erl_test.c \ - oe_code_m_a.c \ - oe_code_m_arr1.c \ - oe_code_m_arr2.c \ - oe_code_m_arr3.c \ - oe_code_m_aseq.c \ - oe_code_m_b.c \ - oe_code_m_bseq.c \ - oe_code_m_dd.c \ - oe_code_m_dyn.c \ - oe_code_m_dyn_sl.c \ - oe_code_m_es.c \ - oe_code_m_et.c \ - oe_code_m_etseq.c \ - oe_code_m_fruit.c \ - oe_code_m_lseq.c \ - oe_code_m_s.c \ - oe_code_m_s_sl.c \ - oe_code_m_sarr3.c \ - oe_code_m_simple.c \ - oe_code_m_ssarr3.c \ - oe_code_m_sseq.c \ - oe_code_m_ssstr3.c \ - oe_code_m_sstr3.c \ - oe_code_m_str1.c \ - oe_code_m_str3.c \ - oe_code_m_strRec.c \ - oe_code_m_strRec_str5.c \ - oe_code_m_strRec_str7.c - -GEN_HRL_FILES = \ - m.hrl \ - m_i.hrl \ - oe_c_erl_test.hrl - -GEN_ERL_FILES = \ - m.erl \ - m_arr2.erl \ - m_arr3.erl \ - m_i.erl \ - m_str3.erl \ - oe_c_erl_test.erl - -C_FILES = $(GEN_C_FILES) c_client.c - -OBJS = $(C_FILES:.c=@obj@) - -PGMS = c_client@exe@ - -ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl - -EBINS = $(ERL_FILES:.erl=.@EMULATOR@) - - -all: $(PGMS) $(EBINS) - -$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl -$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c -$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES) -$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES) - -clean: - -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -$(PGMS): $(OBJS) - $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS) - -c_erl_test.built_c: c_erl_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_client}" c_erl_test.idl - echo done > c_erl_test.built_c - -c_erl_test.built_erl: c_erl_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" c_erl_test.idl - echo done > c_erl_test.built_erl - -.c@obj@: - $(CC) -c -o $*@obj@ $(CFLAGS) $< - -.erl.@EMULATOR@: - $(ERLC) -I $(IC_INCLUDE_PATH) $< - diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c deleted file mode 100644 index 446b46ad82..0000000000 --- a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c +++ /dev/null @@ -1,1760 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2001-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% - * - */ -/* C-client for test of IC. - * - */ - -#include <stdio.h> -#include <stdlib.h> - -#ifndef __WIN32__ -# include <unistd.h> -#endif - -#include <string.h> - -#ifdef __WIN32__ -# include <time.h> -# include <sys/timeb.h> -#elif defined VXWORKS -#include <time.h> -#include <sys/times.h> -#else -#include <sys/time.h> -#endif - -#include <ctype.h> - -#ifdef __WIN32__ -# include <winsock2.h> -# include <windows.h> -#else -# include <sys/types.h> -# include <sys/socket.h> -# include <netinet/in.h> -# include <arpa/inet.h> -# include <netdb.h> -#endif - -#include "ei.h" -#include "erl_interface.h" -#include "m_i.h" - -#define HOSTNAMESZ 255 -#define NODENAMESZ 512 - -#define INBUFSZ 10 -#define OUTBUFSZ 0 - -#define MAXTRIES 5 - -#define CHECK_EXCEPTION(x) \ - if ((x)->_major != CORBA_NO_EXCEPTION) { \ - fprintf(stderr,"\n\nException: %s\n\n", \ - (char *)CORBA_exception_value((x))); \ - CORBA_exception_free((x)); \ - return -1; \ - } \ - -/* XXX Should free things here too! */ -#define RETURN_IF_OK(x) \ - if ((x)) {\ - fprintf(stdout, "ok\n");\ - return 0;\ - }\ - -#define cmp_str(x,y) (!strcmp((x),(y))) -#define cmp_wstr(x,y) (!ic_wstrcmp((x),(y))) - -typedef CORBA_Environment IC_Env; - -typedef int (*TestFunc)(IC_Env *); -typedef struct { - char *name; - TestFunc func; -} TestCase; - -static char longtext[] = -"Introduction The IC application is an IDL compiler implemented in Erlang." -" The IDL compiler generates client stubs and server skeletons." -" Several back-ends are supported, and they fall into three main groups." -" For more details on IC compiler options consult the ic(3) manual page." -" Argument passing cases 1 Caller allocates all necessary storage," -" except that which may be encapsulated and managed within the parameter itself." -" 2 The caller allocates a pointer and passes it by reference to the callee." -" The callee sets the pointer to point to a valid instance of the parameter's type." -" The caller is responsible for releasing the returned storage." -" Following completion of a request, the caller is not allowed to modify any values" -" in the returned storage. To do so the caller must first copy the returned instance" -" into a new instance, then modify the new instance. 3 The caller allocates a" -" pointer to an array slice which has all the same dimensions of the original" -" array except the first, and passes it by reference to the callee. The callee sets" -" the pointer to point to a valid instance of the array. The caller is responsible for" -" releasing the returned storage. Following completion of a request, the caller is not" -" allowed to modify any values in the returned storage. To do so the caller must first" -" copy the returned instance into a new instance, then modify the new instance." -" Generated Files Two files will be generated for each scope. One set of files will be" -" generated for each module and each interface scope. An extra set is generated for" -" those definitions at top level scope. One of the files is a header file(.h), and the" -" other file is a C source code file (.c). In addition to these files a number of C" -" source files will be generated for type encodings, they are named according to the " -"following template: oe_code_<type>.c."; -static char this_node[NODENAMESZ + 1]; -static char *progname; - -/* Test function prototypes */ - -static int void_test(IC_Env *env); -static int long_test(IC_Env *env); -static int long_long_test(IC_Env *env); -static int unsigned_short_test(IC_Env *env); -static int unsigned_long_test(IC_Env *env); -static int unsigned_long_long_test(IC_Env *env); -static int double_test(IC_Env *env); -static int char_test(IC_Env *env); -static int wchar_test(IC_Env *env); -static int octet_test(IC_Env *env); -static int bool_test(IC_Env *env); -static int struct_test(IC_Env *env); -static int struct2_test(IC_Env *env); -static int seq1_test(IC_Env *env); -static int seq2_test(IC_Env *env); -static int seq3_test(IC_Env *env); -static int seq4_test(IC_Env *env); -static int seq5_test(IC_Env *env); -static int array1_test(IC_Env *env); -static int array2_test(IC_Env *env); -static int enum_test(IC_Env *env); -static int string1_test(IC_Env *env); -static int string2_test(IC_Env *env); -static int string3_test(IC_Env *env); -static int string4_test(IC_Env *env); -static int pid_test(IC_Env *env); -static int port_test(IC_Env *env); -static int ref_test(IC_Env *env); -static int term_test(IC_Env *env); -static int typedef_test(IC_Env *env); -static int inline_sequence_test(IC_Env *env); -static int term_sequence_test(IC_Env *env); -static int term_struct_test(IC_Env *env); -static int wstring1_test(IC_Env *env); - -static TestCase test_cases[] = { - {"void_test", void_test}, - {"long_test", long_test}, - {"long_long_test", long_long_test}, - {"unsigned_short_test", unsigned_short_test}, - {"unsigned_long_test", unsigned_long_test}, - {"unsigned_long_long_test", unsigned_long_long_test}, - {"double_test", double_test}, - {"char_test", char_test}, - {"wchar_test", wchar_test}, - {"octet_test", octet_test}, - {"bool_test", bool_test}, - {"struct_test", struct_test}, - {"struct2_test", struct2_test}, - {"seq1_test", seq1_test}, - {"seq2_test", seq2_test}, - {"seq3_test", seq3_test}, - {"seq4_test", seq4_test}, - {"seq5_test", seq5_test}, - {"array1_test", array1_test}, - {"array2_test", array2_test}, - {"enum_test", enum_test}, - {"string1_test", string1_test}, - {"string2_test", string2_test}, - {"string3_test", string3_test}, - {"string4_test", string4_test}, - {"pid_test", pid_test}, - {"port_test", port_test}, - {"ref_test", ref_test}, - {"term_test", term_test}, - {"typedef_test", typedef_test}, - {"inline_sequence_test", inline_sequence_test}, - {"term_sequence_test", term_sequence_test}, - {"term_struct_test", term_struct_test}, - {"wstring1_test", wstring1_test}, - {"", NULL} -}; - -/* Other prototypes */ -static int cmp_aseq(m_aseq *a1, m_aseq *a2); -static int cmp_a(m_a *a1, m_a *a2); -static int cmp_bseq(m_bseq *b1, m_bseq *b2); -static int cmp_b(m_b *b1, m_b *b2); -static int cmp_lseq(m_lseq *b1, m_lseq *b2); -static int cmp_etseq(m_etseq *b1, m_etseq *b2); -static int cmp_et(m_et* b1, m_et *b2); -static int cmp_es(m_es *b1, m_es *b2); -static int cmp_arr1(m_arr1 b1, m_arr1 b2); -static int cmp_dd(m_dd b1, m_dd b2); -static int cmp_strRec(m_strRec *b1, m_strRec *b2); -static int cmp_sseq(m_sseq *b1, m_sseq *b2); -static int cmp_pid(erlang_pid *p1, erlang_pid *p2); -static int cmp_port(erlang_port *p1, erlang_port *p2); -static int cmp_ref(erlang_ref *p1, erlang_ref *p2); -static int cmp_s(m_s *b1, m_s *b2); -static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2); -static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2); -static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2); -static int cmp_arr3(m_arr3 b1, m_arr3 b2); - -static void print_aseq(m_aseq *a); -static void print_a(m_a *a); -static void print_bseq(m_bseq *b); -static void print_lseq(m_lseq *b); -static void print_b(m_b *b); -static void print_etseq(m_etseq *b); -static void print_et(m_et* b); -static void print_es(m_es *b); -static void print_arr1(long a[500]); -static void print_dd(long a[2][3]); -static void print_strRec(m_strRec* sr); -static void print_sseq(m_sseq *b); -static void print_pid(erlang_pid *p); -static void print_port(erlang_port *p); -static void print_ref(erlang_ref *p); -static void print_term(ETERM *t); -static void print_s(m_s *p); -static void print_ssstr3(m_ssstr3 *b1); -static void print_ssarr3(m_ssarr3 *b1); -static void print_sarr3(m_sarr3 *b1); -static void print_arr3(m_arr3 b1); -static void print_wstr(CORBA_wchar *ws); - -static void free_etseq_buf(m_etseq *b); -static void free_et(m_et* b); - -#ifdef __WIN32__ -typedef struct { - long tv_sec; - long tv_usec; -} MyTimeval; -#else -typedef struct timeval MyTimeval; -#endif -static void my_gettimeofday(MyTimeval *tv); -static void showtime(MyTimeval *start, MyTimeval *stop); -static void usage(void); -static void done(int r); - - - -/* main */ - -#ifdef VXWORKS -int client(int argc, char **argv) -#else -int main(int argc, char **argv) -#endif -{ - struct hostent *hp; - erlang_pid pid; - MyTimeval start, stop; - int i, fd, ires, tres; - IC_Env *env; - int tries = 0; - char *this_node_name = NULL; - char *peer_node = NULL; - char *peer_process_name = NULL; - char *cookie = NULL; - char host[HOSTNAMESZ + 1]; - TestFunc test_func = NULL; - TestCase *test_case; - char *test_case_name = NULL; - -#ifdef __WIN32__ - WORD wVersionRequested; - WSADATA wsaData; - - wVersionRequested = MAKEWORD(2, 0); - - if (WSAStartup(wVersionRequested, &wsaData) != 0) { - fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL"); - exit(1); - } -#endif - - progname = argv[0]; - host[HOSTNAMESZ] = '\0'; - if (gethostname(host, HOSTNAMESZ + 1) < 0) { - fprintf(stderr, "Can't find own hostname\n"); - done(1); - } - if ((hp = gethostbyname(host)) == 0) { - fprintf(stderr, "Can't get ip address for host %s\n", host); - done(1); - } - for (i = 1; i < argc; i++) { - if (cmp_str(argv[i], "-help")) { - usage(); - done(0); - } else if (cmp_str(argv[i], "-this-node-name")) { - i++; - this_node_name = argv[i]; - } else if (cmp_str(argv[i], "-peer-node")) { - i++; - peer_node = argv[i]; - } else if (cmp_str(argv[i], "-peer-process-name")) { - i++; - peer_process_name = argv[i]; - } else if (cmp_str(argv[i], "-cookie")) { - i++; - cookie = argv[i]; - } else if (cmp_str(argv[i], "-test-case")) { - i++; - test_case_name = argv[i]; - } else { - fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]); - usage(); - done(1); - } - } - - if (this_node_name == NULL || peer_node == NULL || test_case_name == NULL - || peer_process_name == NULL || cookie == NULL) { - fprintf(stderr, "Error: missing option\n"); - usage(); - done(1); - } - - test_case = test_cases; - while (test_case->func) { - if (cmp_str(test_case->name, test_case_name)) { - test_func = test_case->func; - break; - } - test_case++; - } - if (test_func == NULL) { - fprintf(stderr, "Error: illegal test case: \"%s\"\n", test_case_name); - done(1); - } - - /* Behead hostname at first dot */ - for (i=0; host[i] != '\0'; i++) { - if (host[i] == '.') { host[i] = '\0'; break; } - } - sprintf(this_node, "%s@%s", this_node_name, host); - fprintf(stderr, "c_client: this node: \"%s\"\n", this_node); - fprintf(stderr, "c_client: peer node: \"%s\"\n", peer_node); - fprintf(stderr, "c_client: test case: \"%s\"\n", test_case_name); - - fprintf(stderr, "c_client: starting\n"); - - /* initialize erl_interface */ - erl_init(NULL, 0); - - for (tries = 0; tries < MAXTRIES; tries++) { - - /* connect to erlang node */ - - ires = erl_connect_xinit(host, this_node_name, this_node, - (struct in_addr *)*hp->h_addr_list, - cookie, 0); - - fprintf(stderr, "c_client: erl_connect_xinit(): %d\n", ires); - - fd = erl_connect(peer_node); - fprintf(stderr, "c_client: erl_connect(): %d\n", fd); - - if (fd >= 0) - break; - fprintf(stderr, "c_client: cannot connect, retrying\n"); - } - if (fd < 0) { - fprintf(stderr, "c_client: cannot connect, exiting\n"); - done(1); - } - env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ); - env->_fd = fd; - strcpy(env->_regname, peer_process_name); - env->_to_pid = NULL; - env->_from_pid = &pid; - - strcpy(pid.node, this_node); - pid.num = fd; - pid.serial = 0; - pid.creation = 0; - - my_gettimeofday(&start); - tres = test_func(env); /* Call test case */ - my_gettimeofday(&stop); - showtime(&start, &stop); - erl_close_connection(fd); - - printf("c_client: env->_inbuf before : %d\n", INBUFSZ); - printf("c_client: env->_outbuf before : %d\n", OUTBUFSZ); - printf("c_client: env->_inbuf after : %d\n", env->_inbufsz); - printf("c_client: env->_outbuf after : %d\n", env->_outbufsz); - - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - done(tres); -} - -static void usage() -{ - fprintf(stderr, "Usage: %s [-help] -this-node-name <name> " - "-peer-node <nodename> -peer-process-name <name> " - "-cookie <cookie> -test-case <test case name>\n", progname); - fprintf(stderr, "Example:\n %s -this-node-name kalle " - "-peer-node olle@home -peer-process-name idltest " - "-cookie oa678er -test-case octet_test\n", progname); -} - -static void done(int r) -{ -#ifdef __WIN32__ - WSACleanup(); -#endif - exit(r); -} - - -/* TESTS */ - -static int void_test(IC_Env *env) -{ - fprintf(stdout, "\n======== m_i_void test ======\n\n"); - m_i_void_test(NULL,env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(1); -} - -static int long_test(IC_Env *env) -{ - long l = 4711, lo, lr; - - fprintf(stdout, "\n======== m_i_long test ======\n\n"); - lr = m_i_long_test(NULL, l, &lo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(l == lo && l == lr); - if (l != lo) - fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", l, lo); - if (l != lr) - fprintf(stdout, " result error, sent: %ld, got: %ld\n", l, lr); - return -1; -} - -static int long_long_test(IC_Env *env) -{ - CORBA_long_long ll = 4711, llo, llr; - - fprintf(stdout, "\n======== m_i_longlong test ======\n\n"); - llr = m_i_longlong_test(NULL, ll, &llo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ll == llo && ll == llr); - if (ll != llo) - fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", - ll, llo); - if (ll != llr) - fprintf(stdout, " result error, sent: %ld, got: %ld\n", ll, llr); - return -1; -} - -static int unsigned_short_test(IC_Env *env) -{ - unsigned short x, y = 2, z; - - fprintf(stdout, "\n======== m_i_ushort test ======\n\n"); - x = m_i_ushort_test(NULL, y, &z, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(y == z && y == x); - if (y != z) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", y, z); - if (y != x) - fprintf(stdout, " result error, sent: %d, got: %d\n", y, x); - return -1; -} - - -static int unsigned_long_test(IC_Env *env) -{ - unsigned long ul = 5050, ulo, ulr; - - fprintf(stdout, "\n======== m_i_ulong test ======\n\n"); - ulr = m_i_ulong_test(NULL, ul, &ulo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ul == ulo && ul == ulr); - if (ul != ulo) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - ul, ulo); - if (ul != ulr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", ul, ulr); - return -1; -} - -/* - * Note: CORBA_unsigned_long_long is in fact a plain long. - */ -static int unsigned_long_long_test(IC_Env *env) -{ - CORBA_unsigned_long_long ull = 5050, ullo, ullr; - - fprintf(stdout, "\n======== m_i_ulonglong test ======\n\n"); - ullr = m_i_ulonglong_test(NULL, ull, &ullo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ull == ullo && ull == ullr); - if (ull != ullo) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - ull, ullo); - if (ull != ullr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", - ull, ullr); - return -1; -} - -static int double_test(IC_Env *env) -{ - double d = 12.1212, db, dr; - - fprintf(stdout, "\n======== m_i_double test ======\n\n"); - dr = m_i_double_test(NULL, d, &db, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(d == db && d == dr); - if (d != db) - fprintf(stdout, " out parameter error, sent: %f, got: %f\n", d, db); - if (d != dr) - fprintf(stdout, " result error, sent: %f, got: %f\n", d, dr); - return -1; -} - -static int char_test(IC_Env *env) -{ - char c = 'g', co, cr; - - /* char test */ - fprintf(stdout, "\n======== m_i_char test ======\n\n"); - cr = m_i_char_test(NULL, c, &co, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(c == co && c == cr); - if (c !=co) - fprintf(stdout, " out parameter error, sent: %c, got: %c\n", c, co); - if (c != cr) - fprintf(stdout, " result error, sent: %c, got: %c\n", c, cr); - return -1; -} - -static int wchar_test(IC_Env *env) -{ - CORBA_wchar wc = 103, wco, wcr; - - fprintf(stdout, "\n======== m_i_wchar test ======\n\n"); - wcr = m_i_wchar_test(NULL, wc, &wco, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(wc == wco && wc == wcr); - if (wc != wco) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - wc, wco); - if (wc != wcr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", - wc, wcr); - return -1; -} - -static int octet_test(IC_Env *env) -{ - char o ='r', oo, or; - - fprintf(stdout, "\n======== m_i_octet test ======\n\n"); - or = m_i_octet_test(NULL, o, &oo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(o == oo && o == or); - if (o != oo) - fprintf(stdout, " out parameter error, sent: %c, got: %c\n", o, oo); - if (o != or) - fprintf(stdout, " result error, sent: %c, got: %c\n", o, or); - return -1; -} - -static int bool_test(IC_Env *env) -{ - unsigned char i = 0, io, ir; - - fprintf(stdout, "\n======== m_i_bool test ======\n\n"); - ir = m_i_bool_test(NULL, i, &io, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(i == io && i == ir); - if (i != io) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", i, io); - if (i != ir) - fprintf(stdout, " result error, sent: %d, got: %d\n", i, ir); - return -1; -} - -static int struct_test(IC_Env *env) -{ - m_b b = {4711, 'a'}, bo, br; - - fprintf(stdout, "\n======== m_i_struct test ======\n\n"); - br = m_i_struct_test(NULL, &b, &bo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_b(&b, &bo) && cmp_b(&b, &br)); - if (!cmp_b(&b, &bo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_b(&b); - fprintf(stdout, " got:\n"); - print_b(&bo); - fprintf(stdout, "\n"); - } - if (!cmp_b(&b, &br)) { - fprintf(stdout, " result error, sent:\n"); - print_b(&b); - fprintf(stdout, " got:\n"); - print_b(&br); - fprintf(stdout, "\n"); - } - return -1; -} - -static int struct2_test(IC_Env *env) -{ - m_es esi = {m_peach, 5050}, eso, esr; - - fprintf(stdout, "\n======== m_i_struct2 test ======\n\n"); - esr = m_i_struct2_test(NULL, &esi, &eso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_es(&esi, &eso) && cmp_es(&esi, &esr)); - if (!cmp_es(&esi, &eso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_es(&esi); - fprintf(stdout, " got:\n"); - print_es(&eso); - fprintf(stdout, "\n"); - } - if (!cmp_es(&esi, &esr)) { - fprintf(stdout, " result error, sent:\n"); - print_es(&esi); - fprintf(stdout, " got:\n"); - print_es(&esr); - fprintf(stdout, "\n"); - } - return -1; -} - - -static int seq1_test(IC_Env *env) -{ - m_bseq bs, *bso, *bsr; - - m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}}; - bs._length = 3; - bs._buffer = ba; - - fprintf(stdout, "\n======== m_i_seq1 test ======\n\n"); - bsr = m_i_seq1_test(NULL, &bs, &bso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_bseq(&bs, bso) && cmp_bseq(&bs, bsr)); - if (!cmp_bseq(&bs, bso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_bseq(&bs); - fprintf(stdout, " got:\n"); - print_bseq(bso); - fprintf(stdout, "\n"); - } - if (!cmp_bseq(&bs, bsr)) { - fprintf(stdout, " result error, sent:\n"); - print_bseq(&bs); - fprintf(stdout, " got:\n"); - print_bseq(bsr); - fprintf(stdout, "\n"); - } - CORBA_free(bso); - CORBA_free(bsr); - return -1; -} - -static int seq2_test(IC_Env *env) -{ - m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}}; - m_a a; - m_a aa[2]; - m_aseq as, *aso, *asr; - - a.l = 9999; - a.y._length = 3; - a.y._buffer = ba; - a.d = 66.89898989; - - aa[0] = a; - aa[1] = a; - as._length = 2; - as._buffer = aa; - - fprintf(stdout, "\n======== m_i_seq2 test ======\n\n"); - asr = m_i_seq2_test(NULL, &as, &aso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_aseq(&as, aso) && cmp_aseq(&as, asr)); - if (!cmp_aseq(&as, aso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_aseq(&as); - fprintf(stdout, " got:\n"); - print_aseq(aso); - fprintf(stdout, "\n"); - } - if (!cmp_aseq(&as, asr)) { - fprintf(stdout, " result error, sent:\n"); - print_aseq(&as); - fprintf(stdout, " got:\n"); - print_aseq(asr); - fprintf(stdout, "\n"); - } - CORBA_free(aso); - CORBA_free(asr); - return -1; -} - -static int seq3_test(IC_Env *env) -{ - m_lseq lsi, *lso, *lsr; - long al[500]; - int i=0; - - for (i = 0; i < 500; i++) - al[i]=i; - lsi._length = 500; - lsi._buffer = al; - - fprintf(stdout, "\n======== m_i_seq3 test ======\n\n"); - lsr = m_i_seq3_test(NULL, &lsi, &lso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_lseq(&lsi, lso) && cmp_lseq(&lsi, lsr)); - if (!cmp_lseq(&lsi, lso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_lseq(&lsi); - fprintf(stdout, " got:\n"); - print_lseq(lso); - fprintf(stdout, "\n"); - } - if (!cmp_lseq(&lsi, lsr)) { - fprintf(stdout, " result error, sent:\n"); - print_lseq(&lsi); - fprintf(stdout, " got:\n"); - print_lseq(lsr); - fprintf(stdout, "\n"); - } - CORBA_free(lso); - CORBA_free(lsr); - return -1; -} - -static int seq4_test(IC_Env *env) -{ - char *stra0[3] = {"a", "long", "time"}; - char *stra1[3] = {"ago", "there", "was"}; - char *stra2[3] = {"a", "buggy", "compiler"}; - m_sstr3 str3s[3] = {{3, 3, stra0}, {3, 3, stra1}, {3, 3, stra2}}; - m_ssstr3 str3ssi = {3, 3, str3s}; - m_ssstr3 *str3sso, *str3ssr; - - fprintf(stdout, "\n======== m_i_seq4 test ======\n\n"); - str3ssr = m_i_seq4_test(NULL, &str3ssi, &str3sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ssstr3(&str3ssi, str3sso) && - cmp_ssstr3(&str3ssi, str3ssr)); - if (!cmp_ssstr3(&str3ssi, str3sso)){ - fprintf(stdout, " out parameter error, sent:\n"); - print_ssstr3(&str3ssi); - fprintf(stdout, " got:\n"); - print_ssstr3(str3sso); - fprintf(stdout, "\n"); - } - if (!cmp_ssstr3(&str3ssi, str3ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_ssstr3(&str3ssi); - fprintf(stdout, " got:\n"); - print_ssstr3(str3ssr); - fprintf(stdout, "\n"); - } - CORBA_free(str3sso); - CORBA_free(str3ssr); - return -1; -} - -static int seq5_test(IC_Env *env) -{ - m_arr3 arr3a[3] = { - {4711, 18931947, 3}, - {4711, 18931947, 3}, - {4711, 18931947, 3}}; - m_sarr3 arr3sa[3] = {{3, 3, arr3a}, {3, 3, arr3a}, {3, 3, arr3a}}; - m_ssarr3 arr3ssi = {3, 3, arr3sa}; - m_ssarr3 *arr3sso; - m_ssarr3 *arr3ssr; - - fprintf(stdout, "\n======== m_i_seq5 test ======\n\n"); - arr3ssr = m_i_seq5_test(NULL, &arr3ssi, &arr3sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ssarr3(&arr3ssi, arr3sso) && - cmp_ssarr3(&arr3ssi, arr3ssr)); - if (!cmp_ssarr3(&arr3ssi, arr3sso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_ssarr3(&arr3ssi); - fprintf(stdout, " got:\n"); - print_ssarr3(arr3sso); - fprintf(stdout, "\n"); - } - if (!cmp_ssarr3(&arr3ssi, arr3ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_ssarr3(&arr3ssi); - fprintf(stdout, " got:\n"); - print_ssarr3(arr3ssr); - fprintf(stdout, "\n"); - } - CORBA_free(arr3sso); - CORBA_free(arr3ssr); - return -1; -} - -static int array1_test(IC_Env *env) -{ - int i; - long al[500]; - m_arr1 alo; - m_arr1_slice* alr; - - for (i = 0; i < 500; i++) - al[i]=i; - - fprintf(stdout, "\n======== m_i_array1 test ======\n\n"); - alr = m_i_array1_test(NULL, al, alo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_arr1(al, alo) && cmp_arr1(al, alr)); - if (!cmp_arr1(al, alo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_arr1(al); - fprintf(stdout, " got:\n"); - print_arr1(alo); - fprintf(stdout, "\n"); - } - if (!cmp_arr1(al,alr)) { - fprintf(stdout, " result error, sent:\n"); - print_arr1(al); - fprintf(stdout, " got:\n"); - print_arr1(alr); - fprintf(stdout, "\n"); - } - free(alr); - return -1; -} - -static int array2_test(IC_Env *env) -{ - long dl[2][3] = {{11, 2, 7}, {22, 8 ,13}}; - m_dd dlo; - m_dd_slice* dlr; - - fprintf(stdout, "\n======== m_i_array2 test ======\n\n"); - dlr = m_i_array2_test(NULL, dl, dlo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_dd(dl,dlo) && cmp_dd(dl,dlr)); - if (!cmp_dd(dl,dlo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_dd(dl); - fprintf(stdout, " got:\n"); - print_dd(dlo); - fprintf(stdout, "\n"); - } - if (!cmp_dd(dl,dlr)) { - fprintf(stdout, " result error, sent:\n"); - print_dd(dl); - fprintf(stdout, " got:\n"); - print_dd(dlr); - fprintf(stdout, "\n"); - } - free(*dlr); - return -1; -} - -static int enum_test(IC_Env *env) -{ - m_fruit ei = m_banana, eo, er; - - fprintf(stdout, "\n======== m_i_enum test ======\n\n"); - er = m_i_enum_test(NULL, ei, &eo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ei == eo && ei == er); - if (ei != eo) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", ei, eo); - if (ei != er) - fprintf(stdout, " result error, sent: %d, got: %d\n", ei, er); - return -1; -} - -static int string1_test(IC_Env *env) -{ - char* si = longtext; - char* so; - char* sr; - - fprintf(stdout, "\n======== m_i_string1 test ======\n\n"); - sr = m_i_string1_test(NULL, si, &so, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, sr)); - if (!cmp_str(si, so)) - fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so); - if (!cmp_str(si, sr)) - fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr); - CORBA_free(so); - CORBA_free(sr); - return -1; -} - -static int string2_test(IC_Env *env) -{ - char* sa[3] = {"hello", "foo", "bar"}; - m_sseq ssi = {3, 3, sa}; - m_sseq *sso, *ssr; - - fprintf(stdout, "\n======== m_i_string2 test ======\n\n"); - ssr = m_i_string2_test(NULL, &ssi, &sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_sseq(&ssi, sso) && cmp_sseq(&ssi, sso)); - if (!cmp_sseq(&ssi, sso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_sseq(&ssi); - fprintf(stdout, "got:\n"); - print_sseq(sso); - } - if (!cmp_sseq(&ssi, ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_sseq(&ssi); - fprintf(stdout, "got:\n"); - print_sseq(ssr); - } - CORBA_free(sso); - CORBA_free(ssr); - return -1; -} - -static int string3_test(IC_Env *env) -{ - char* si = longtext; - char* so; - char* sr; - - fprintf(stdout, "\n======== m_i_string3 test ======\n\n"); - sr = m_i_string3_test(NULL, si, &so, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, so)); - if (!cmp_str(si, so)) - fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so); - if (!cmp_str(si, sr)) - fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr); - CORBA_free(so); - CORBA_free(sr); - return -1; -} - -static int string4_test(IC_Env *env) -{ - char as1[100] = "a string", as2[200] = "help", as3[200] = "hello there"; - m_strRec stri = { 1, /* dd */ - as1, /* str4 */ - {{'a', 'k'}, {'z', 'g'}, {'n', 'q'}}, /* str7 */ - {3, 3, "buf"}, /* str5 */ - as2, /* str6 */ - {'m', 'f', 'o'}, /* str8 */ - as3, /* str9 */ - {3, 3, "stu"} /* str10 */ - }; - m_strRec *stro, *strr; - - fprintf(stdout, "\n======== m_i_string4 test ======\n\n"); - strr = m_i_string4_test(NULL, &stri, &stro, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_strRec(&stri,stro) && cmp_strRec(&stri,strr)); - if (!cmp_strRec(&stri,stro)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_strRec(&stri); - fprintf(stdout, " got:\n"); - print_strRec(stro); - fprintf(stdout, "\n"); - } - if (!cmp_strRec(&stri,strr)) { - fprintf(stdout, " result error, sent:\n"); - print_strRec(&stri); - fprintf(stdout, " got:\n"); - print_strRec(strr); - fprintf(stdout, "\n"); - } - CORBA_free(stro); - CORBA_free(strr); - return -1; -} - - -static int pid_test(IC_Env *env) -{ - erlang_pid pid = {"", 7, 0, 0}, pido, pidr; - - strcpy(pid.node, this_node), /* this currently running node */ - fprintf(stdout, "\n======== m_i_pid test ======\n\n"); - pidr = m_i_pid_test(NULL, &pid, &pido, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_pid(&pid, &pido) && cmp_pid(&pid, &pidr)); - if (!cmp_pid(&pid, &pido)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_pid(&pid); - fprintf(stdout, "got:\n"); - print_pid(&pido); - } - if (!cmp_pid(&pid, &pidr)) { - fprintf(stdout, " result error, sent:\n"); - print_pid(&pid); - fprintf(stdout, "got:\n"); - print_pid(&pidr); - } - return -1; -} - -static int port_test(IC_Env *env) -{ - erlang_port porti = {"node", 5, 1}, porto, portr; - - fprintf(stdout, "\n======== m_i_port test ======\n\n"); - portr = m_i_port_test(NULL, &porti, &porto, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_port(&porti, &porto) && cmp_port(&porti, &portr)); - if (!cmp_port(&porti, &porto)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_port(&porti); - fprintf(stdout, "got:\n"); - print_port(&porto); - } - if (!cmp_port(&porti, &portr)) { - fprintf(stdout, " result error, sent:\n"); - print_port(&porti); - fprintf(stdout, "got:\n"); - print_port(&portr); - } - return -1; -} - -static int ref_test(IC_Env *env) -{ - erlang_ref refi = { "node1", 3, {1, 2, 3}, 1}, - refo, refr; - - fprintf(stdout, "\n======== m_i_ref test ======\n\n"); - refr = m_i_ref_test(NULL, &refi, &refo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ref(&refi, &refo) && cmp_ref(&refi, &refr)); - if (!cmp_ref(&refi, &refo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_ref(&refi); - fprintf(stdout, "got:\n"); - print_ref(&refo); - } - if (!cmp_ref(&refi, &refr)) { - fprintf(stdout, " result error, sent:\n"); - print_ref(&refi); - fprintf(stdout, "got:\n"); - print_ref(&refr); - } - return -1; -} - -static int term_test(IC_Env *env) -{ - ETERM *ti, *to, *tr; - - ti = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"); - - fprintf(stdout, "\n======== m_i_term test ======\n\n"); - tr = m_i_term_test(NULL, ti, &to, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(erl_match(ti, to) && erl_match(ti, tr)); - if (!erl_match(ti, to)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_term(ti); - fprintf(stdout, "got:\n"); - print_term(to); - } - if (!erl_match(ti, tr)) { - fprintf(stdout, " result error, sent:\n"); - print_term(ti); - fprintf(stdout, "got:\n"); - print_term(tr); - } - erl_free_term(ti); - erl_free_term(to); - erl_free_term(tr); - return -1; -} - -static int typedef_test(IC_Env *env) -{ - m_banan mbi, mbo; /* erlang_port */ - m_apa mai; /* ETERM* */ - m_apa mao = NULL; - long tl; - - strcpy(mbi.node,"node"); - mbi.id = 15; - mbi.creation = 1; - - fprintf(stdout, "\n======== m_i_typedef test ======\n\n"); - mai = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"); - tl = m_i_typedef_test(NULL, mai, &mbi, &mao, &mbo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(erl_match(mai, mao) && cmp_port(&mbi, &mbo) && tl == 4711); - if (!erl_match(mai, mao)) { - fprintf(stdout, " out parameter error (term), sent:\n"); - print_term(mai); - fprintf(stdout, "got:\n"); - print_term(mao); - } - if (!cmp_port(&mbi, &mbo)) { - fprintf(stdout, " out parameter error (port), sent:\n"); - print_port(&mbi); - fprintf(stdout, "got:\n"); - print_port(&mbo); - } - if (tl != 4711) { - fprintf(stdout, " result error, sent: 4711, got %ld\n", tl); - } - erl_free_term(mai); - erl_free_term(mao); - return -1; -} - -static int inline_sequence_test(IC_Env *env) -{ - int i; - long al[500]; - m_s isi = {4711, {500, 10, al}}, - *iso, *isr; - - for (i = 0; i < 500; i++) - al[i]=i; - fprintf(stdout, "\n======== m_i_inline_sequence test ======\n\n"); - isr = m_i_inline_sequence_test(NULL, &isi, &iso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_s(&isi, iso) && cmp_s(&isi, isr)); - if (!cmp_s(&isi, iso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_s(&isi); - fprintf(stdout, "got:\n"); - print_s(iso); - } - if (!cmp_s(&isi, isr)) { - fprintf(stdout, " result error, sent:\n"); - print_s(&isi); - fprintf(stdout, "got:\n"); - print_s(isr); - } - CORBA_free(iso); - CORBA_free(isr); - return -1; -} - -static int term_sequence_test(IC_Env *env) -{ - ETERM* et_array[4] = { - erl_format("[{apa, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{banan, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{apelsin, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{mango, 1, 23}, \"string\", {1.23, 45}]")}; - m_etseq etsi = {4, 4, et_array}, *etso, *etsr; - - fprintf(stdout, "\n======== m_i_term_sequence test ======\n\n"); - etsr = m_i_term_sequence_test(NULL, &etsi, &etso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_etseq(&etsi, etso) && cmp_etseq(&etsi, etsr)); - if (!cmp_etseq(&etsi, etso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_etseq(&etsi); - fprintf(stdout, "got:\n"); - print_etseq(etso); - } - if (!cmp_etseq(&etsi, etsr)) { - fprintf(stdout, " result error, sent:\n"); - print_etseq(&etsi); - fprintf(stdout, "got:\n"); - print_etseq(etsr); - } - free_etseq_buf(&etsi); - free_etseq_buf(etso); - free_etseq_buf(etsr); - CORBA_free(etso); - CORBA_free(etsr); - return -1; -} - -static int term_struct_test(IC_Env *env) -{ - m_et eti = { erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"), - 121212 }; - m_et eto, etr; - - fprintf(stdout, "\n======== m_i_term_struct test ======\n\n"); - etr = m_i_term_struct_test(NULL, &eti, &eto, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_et(&eti, &eto) && cmp_et(&eti, &etr)); - if (!cmp_et(&eti, &eto)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_et(&eti); - fprintf(stdout, "got:\n"); - print_et(&eto); - } - if (!cmp_et(&eti, &etr)) { - fprintf(stdout, " result error, sent:\n"); - print_et(&eti); - fprintf(stdout, "got:\n"); - print_et(&etr); - } - free_et(&eti); - free_et(&eto); - free_et(&etr); - return -1; -} - -static int wstring1_test(IC_Env *env) -{ - CORBA_wchar wsi[] = {100, 101, 102, 103, 104, 0}, *wso, *wsr; - - fprintf(stdout, "\n======== m_i_wstring1 test ======\n\n"); - wsr = m_i_wstring1_test(NULL, wsi, &wso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_wstr(wsi, wso) && cmp_wstr(wsi, wsr)); - if (!cmp_wstr(wsi, wso)) { - fprintf(stdout, " out parameter error, sent: \n"); - print_wstr(wsi); - fprintf(stdout, "got:\n"); - print_wstr(wso); - } - if (!cmp_wstr(wsi, wsr)) { - fprintf(stdout, " result error, sent: \n"); - print_wstr(wsi); - fprintf(stdout, "got:\n"); - print_wstr(wsr); - } - CORBA_free(wso); - CORBA_free(wsr); - return -1; -} - -/* Compare functions */ -static int cmp_aseq(m_aseq *a1, m_aseq *a2) -{ - int i; - - if (a1->_length != a2->_length) - return 0; - for (i = 0; i < a1->_length; i++) - if (cmp_a(&(a1->_buffer[i]), &(a2->_buffer[i])) == 0) - return 0; - return 1; -} - -static int cmp_a(m_a *a1, m_a *a2) -{ - return a1->l == a2->l && - a1->d == a2->d && - cmp_bseq(&a1->y, &a2->y); -} - -static int cmp_bseq(m_bseq *b1, m_bseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (cmp_b(&(b1->_buffer[i]), &(b2->_buffer[i])) == 0) - return 0; - return 1; -} - -static int cmp_b(m_b *b1, m_b *b2) -{ - return b1->l == b2->l && b1->c == b2->c; -} - -static int cmp_lseq(m_lseq *b1, m_lseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (b1->_buffer[i] != b2->_buffer[i]) - return 0; - return 1; -} - -static int cmp_etseq(m_etseq *b1, m_etseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (!erl_match(b1->_buffer[i], b2->_buffer[i])) - return 0; - return 1; -} - -static int cmp_et(m_et* b1, m_et *b2) -{ - return erl_match(b1->e, b2->e) && b1->l == b2->l; -} - -static int cmp_es(m_es *b1, m_es *b2) -{ - return b1->f == b2->f && b1->l == b2->l; -} - -static int cmp_arr1(m_arr1 b1, m_arr1 b2) -{ - int i; - - for (i = 0; i < 500; i++) - if (b1[i] != b2[i]) - return 0; - return 1; -} - -static int cmp_dd(m_dd b1, m_dd b2) -{ - - int i, j; - - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) - if (b1[i][j] != b2[i][j]) - return 0; - return 1; -} - - - -static int cmp_strRec(m_strRec *b1, m_strRec *b2) -{ - int i, j; - - if (b1->bb != b2->bb) - return 0; - if (!cmp_str(b1->str4,b2->str4)) - return 0; - if (b1->str5._length != b2->str5._length) - return 0; - for (j = 0; j < b1->str5._length; j++) - if (b1->str5._buffer[j] != b2->str5._buffer[j]) - return 0; - if (!cmp_str(b1->str6,b2->str6)) - return 0; - for (i = 0; i < 3; i++) - for (j = 0; j < 2; j++) - if (b1->str7[i][j] != b2->str7[i][j]) - return 0; - for (j = 0; j < 3; j++) - if (b1->str8[j] != b2->str8[j]) - return 0; - if (!cmp_str(b1->str9,b2->str9)) - return 0; - if (b1->str10._length != b2->str10._length) - return 0; - for (j = 0; j < b1->str10._length; j++) - if (b1->str10._buffer[j] != b2->str10._buffer[j]) - return 0; - return 1; -} - - -static int cmp_sseq(m_sseq *b1, m_sseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (!cmp_str(b1->_buffer[i], b2->_buffer[i])) - return 0; - return 1; -} - - -static int cmp_pid(erlang_pid *p1, erlang_pid *p2) -{ - return cmp_str(p1->node,p2-> node) && - p1->num == p2->num && - p1->serial == p2->serial && - p1->creation == p2->creation; -} - -static int cmp_port(erlang_port *p1, erlang_port *p2) -{ - return cmp_str(p1->node,p2-> node) && p1->id == p2->id; -} - -static int cmp_ref(erlang_ref *p1, erlang_ref *p2) -{ - return cmp_str(p1->node, p2->node) && - p1->len == p2->len && - (p1->len < 1 || p1->n[0] == p2->n[0]) && - (p1->len < 2 || p1->n[1] == p2->n[1]) && - (p1->len < 3 || p1->n[2] == p2->n[2]); -} - -static int cmp_s(m_s *b1, m_s *b2) -{ - int i; - - if (b1->l != b2->l) - return 0; - if (b1->sl._length != b2->sl._length) - return 0; - for (i = 0; i < b1->sl._length; i++) - if (b1->sl._buffer[i] != b2->sl._buffer[i]) - return 0; - return 1; -} - - -static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2) -{ - int i,j; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (b1->_buffer[i]._length != b2->_buffer[i]._length) - return 0; - for (j = 0; j < b1->_buffer[i]._length; j++) - if (!cmp_str(b1->_buffer[i]._buffer[j], - b2->_buffer[i]._buffer[j])) - return 0; - } - return 1; -} - - - -static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (!cmp_sarr3(&b1->_buffer[i], &b2->_buffer[i])) - return 0; - } - return 1; -} - -static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (!cmp_arr3(b1->_buffer[i], b2->_buffer[i])) - return 0; - } - return 1; -} - -static int cmp_arr3(m_arr3 b1, m_arr3 b2) -{ - int i; - - for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) { - if (b1[i] != b2[i]) - return 0; - } - return 1; -} - -/* Print functions */ -static void print_aseq(m_aseq *a) -{ - int i; - fprintf(stdout, "\nm_aseq size: %ld --------\n", a->_length); - for (i = 0; i < a->_length; i++) - print_a(&(a->_buffer[i])); -} - -static void print_a(m_a *a) -{ - fprintf(stdout, "\nm_a --------\n l: %ld\n d:%f\n", a->l, a->d); - print_bseq(&a->y); -} - -static void print_bseq(m_bseq *b) -{ - int i; - - fprintf(stdout, "\nm_bseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - print_b(&(b->_buffer[i])); -} - -static void print_lseq(m_lseq *b) -{ - int i; - - fprintf(stdout, "\nm_lseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - fprintf(stdout, "[%d]: %ld\n", i, b->_buffer[i]); -} - -static void print_b(m_b *b) -{ - fprintf(stdout, "\nm_b --------\n l: %ld\n c: %c\n", b->l, b->c); -} - - -static void print_etseq(m_etseq *b) -{ - int i; - - for (i = 0; i < b->_length; i++) { - fprintf(stdout, "[%d]:\n", i); - erl_print_term(stdout, b->_buffer[i]); - } -} - - -static void print_et(m_et* b) -{ - fprintf(stdout, "\net struct --------\n"); - erl_print_term(stdout, b->e); - fprintf(stdout, "long: %ld\n", b->l); - fprintf(stdout, "\n--------\n"); -} - -static void print_es(m_es *b) -{ - fprintf(stdout, "\nm_es --------\n f: %d\n l: %ld\n", b->f, b->l); -} - - -static void print_arr1(long a[10]) -{ - int i; - - for (i = 0; i < 10; i++) - fprintf(stdout, "\n[%d]: %ld\n", i, a[i]); -} - -static void print_dd(long a[2][3]) -{ - int i, j; - - fprintf(stdout, "\nlong dd[2][3] --------\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) - fprintf(stdout, "\n[%d][%d]: %ld\n", i, j, a[i][j]); -} - - -static void print_strRec(m_strRec* sr) -{ - int i, j; - - fprintf(stdout, "\nboolean bb : %d\n",sr->bb); - fprintf(stdout, "string str4 : %s\n",sr->str4); - fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 3; i++) - for (j = 0; j < 2; j++) - fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); - fprintf(stdout, "str5._length : %ld\n",sr->str5._length); - for (j = 0; j < sr->str5._length; j++) - fprintf(stdout, "str5._buffer[%d]: %c\n", j, sr->str5._buffer[j]); - fprintf(stdout, "string str6 : %s\n",sr->str6); - fprintf(stdout, "str8 :\n"); - for (j = 0; j < 3; j++) - fprintf(stdout, "str8[%d]: %c\n", j, sr->str8[j]); - fprintf(stdout, "string str9 : %s\n",sr->str9); - fprintf(stdout, "str10._length : %ld\n",sr->str10._length); - for (j = 0; j < sr->str10._length; j++) - fprintf(stdout, "str10._buffer[%d]: %c\n", j, sr->str10._buffer[j]); -} - -static void print_sseq(m_sseq *b) -{ - int i; - - fprintf(stdout, "\nm_sseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - fprintf(stdout, "%s\n", b->_buffer[i]); - -} - - -static void print_pid(erlang_pid *p) -{ - fprintf(stdout, "\nerlang_pid --------\n node: %s\n num: %d\n " - "serial: %d\n creation: %d\n", - p->node, p->num, p->serial, p->creation); -} - -static void print_port(erlang_port *p) -{ - fprintf(stdout, "\nerlang_port --------\n node: %s\n id: %d\n " - "creation: %d\n", p->node, p->id, p->creation); -} - -static void print_ref(erlang_ref *p) -{ - fprintf(stdout, "\nerlang_ref --------\n node: %s\n len: %d\n " - "n[0]: %d\n n[1]: %d\n n[2]: %d\n creation: %d\n", - p->node, p->len, p->n[0], p->n[1], p->n[2], p->creation); -} - -static void print_term(ETERM *t) -{ - fprintf(stdout, "\nETERM --------\n"); - erl_print_term(stdout, t); - fprintf(stdout, "\n--------\n"); -} - -static void print_s(m_s *p) -{ - int i; - - fprintf(stdout, "\n%ld\n", p->l); - for (i = 0; i < p->sl._length; i++) - fprintf(stdout, "\n[%d]: %ld\n", i, p->sl._buffer[i]); -} - - -static void print_ssstr3(m_ssstr3 *b1) -{ - int i,j; - - fprintf(stdout, "\nSSSTR3 --------\n"); - fprintf(stdout,"b1->_length = %ld\n",b1->_length); - for (i = 0; i < b1->_length; i++) { - fprintf(stdout,"\nb1->_buffer[%d]._length %ld\n", - i, b1->_buffer[i]._length); - for (j = 0; j < b1->_buffer[i]._length; j++) - fprintf(stdout,"b1->_buffer[%d]._buffer[%d] = %s\n", - i, j, b1->_buffer[i]._buffer[j]); - } - fprintf(stdout, "\n--------\n"); -} - -static void print_wstr(CORBA_wchar *ws) -{ - int i = 0; - - fprintf(stdout, "\nwstr --------\n"); - while (ws[i]) { - fprintf(stdout, "[%d]: %ld\n", i, ws[i]); - i++; - } - fprintf(stdout, "\n--------\n"); -} - - -static void print_ssarr3(m_ssarr3 *b1) -{ - int i; - - fprintf(stdout, "\nssarr3 --------\n"); - fprintf(stdout,"length: %ld\n",b1->_length); - fprintf(stdout, "buffer:\n"); - for (i = 0; i < b1->_length; i++) - print_sarr3(&b1->_buffer[i]); - fprintf(stdout, "\n--------\n"); -} - -static void print_sarr3(m_sarr3 *b1) -{ - int i; - - fprintf(stdout, "\nsarr3 --------\n"); - fprintf(stdout,"length: %ld\n",b1->_length); - fprintf(stdout, "buffer:\n"); - for (i = 0; i < b1->_length; i++) - print_arr3(b1->_buffer[i]); - fprintf(stdout, "\n--------\n"); -} - -static void print_arr3(m_arr3 b1) -{ - int i; - - fprintf(stdout, "\narr3 --------\n"); - for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) - fprintf(stdout, "%ld ", b1[i]); - fprintf(stdout, "\n--------\n"); -} - -static void free_etseq_buf(m_etseq *b) -{ - int i; - - for (i = 0; i < b->_length; i++) - erl_free_term(b->_buffer[i]); -} - -static void free_et(m_et* b) -{ - erl_free_term(b->e); -} - -static void showtime(MyTimeval *start, MyTimeval *stop) -{ - MyTimeval elapsed; - - elapsed.tv_sec = stop->tv_sec - start->tv_sec; - elapsed.tv_usec = stop->tv_usec - start->tv_usec; - while (elapsed.tv_usec < 0) { - elapsed.tv_sec -= 1; - elapsed.tv_usec += 1000000; - } - fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec); -} - -static void my_gettimeofday(MyTimeval *tv) -#ifdef __WIN32__ -#define EPOCH_JULIAN_DIFF 11644473600i64 -{ - SYSTEMTIME t; - FILETIME ft; - LONGLONG lft; - - GetSystemTime(&t); - SystemTimeToFileTime(&t, &ft); - memcpy(&lft, &ft, sizeof(lft)); - tv->tv_usec = (long) ((lft / 10i64) % 1000000i64); - tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF); -} -#elif defined VXWORKS -{ - int rate = sysClkRateGet(); /* Ticks per second */ - unsigned long ctick = tickGet(); - tv->tv_sec = ctick / rate; /* secs since reboot */ - tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate; -} -#else -{ - gettimeofday(tv, NULL); -} -#endif diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_erl_test.idl b/lib/ic/test/c_client_erl_server_SUITE_data/c_erl_test.idl deleted file mode 100644 index 126389b01d..0000000000 --- a/lib/ic/test/c_client_erl_server_SUITE_data/c_erl_test.idl +++ /dev/null @@ -1,175 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2001-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% - -#include "erlang.idl" - - -const short TestConst = 1; - -module m { - - const short TestConst = 2; - - struct b { - long l; - char c; - }; - - struct simple { - long l; - b b_t; - }; - - enum fruit {orange, banana, apple, peach, pear}; - - typedef sequence<long> lseq; - - typedef sequence<b> bseq; - - struct a { - long l; - bseq y; - double d; - }; - - typedef sequence<a> aseq; - - typedef sequence<string> sseq; - typedef string str; - typedef long myLong; - - typedef long arr1[500], dd[2][3]; - - typedef erlang::term apa; - typedef erlang::port banan; - - typedef sequence<erlang::term> etseq; - - struct s { - long l; - sequence<long> sl; - }; - - struct es { - fruit f; - myLong l; - }; - - struct et { - erlang::term e; - long l; - }; - - - typedef sequence<char> str1; - typedef string<12> str2; - typedef char str3[3]; - - typedef sequence<string> sstr3; // sequence of string - typedef sequence<sstr3> ssstr3; // sequence of sequences of strings - - typedef long arr3[3]; // array of long - typedef sequence<arr3> sarr3; // sequence of array - typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings - - struct strRec{ - boolean bb; - string str4; - long str7[3][2]; - sequence<char> str5; - string<12> str6; - str3 str8; - str2 str9; - str1 str10; - }; - - - struct dyn { - long l; - sequence<long> sl; - }; - typedef dyn arr2[1][2]; - - - interface i { - - const short TestConst = 3; - - //arr2 suck(in arr2 x, out arr2 y ); - - ///////////////////////////////// attribute long l; - - // simple types - void void_test(); - long long_test(in long a, out long a1); - long long longlong_test(in long long a, out long long a1); - unsigned short ushort_test(in unsigned short a, out unsigned short a1); - unsigned long ulong_test(in unsigned long a, out unsigned long a1); - unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1); - double double_test(in double a, out double a1); - char char_test(in char a, out char a1); - wchar wchar_test(in wchar a, out wchar a1); - octet octet_test(in octet a, out octet a1); - boolean bool_test(in boolean a, out boolean a1); - - // Seq. and struct tests - b struct_test(in b a, out b a1); - es struct2_test(in es a, out es a1); - //simple struct3_test(in simple x, out simple y); - bseq seq1_test(in bseq a, out bseq a1); - aseq seq2_test(in aseq a, out aseq a1); - lseq seq3_test(in lseq a, out lseq a1); - ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1); - ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1); - - // Array tests - arr1 array1_test(in arr1 a, out arr1 a1); - dd array2_test(in dd a, out dd a1); - - // enum test - fruit enum_test(in fruit a, out fruit a1); - - // string tests - string string1_test(in string a, out string a1); - wstring wstring1_test(in wstring a, out wstring a1); - sseq string2_test(in sseq a, out sseq a1); - str string3_test(in str a, out str a1); - strRec string4_test(in strRec a, out strRec a1); - - // Special erlang types - erlang::pid pid_test(in erlang::pid a, out erlang::pid a1); - erlang::port port_test(in erlang::port a, out erlang::port a1); - erlang::ref ref_test(in erlang::ref a, out erlang::ref a1); - erlang::term term_test(in erlang::term a, out erlang::term a1); - - // typedef test - long typedef_test(in apa a, in banan b, out apa a1, out banan b1); - - // inlined seq. test - s inline_sequence_test(in s a, out s a1); - - // term seq. test - etseq term_sequence_test(in etseq a, out etseq a1); - // term struct test - et term_struct_test(in et a, out et a1); - - }; - -}; diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/erl_server.erl b/lib/ic/test/c_client_erl_server_SUITE_data/erl_server.erl deleted file mode 100644 index 159d3b9b89..0000000000 --- a/lib/ic/test/c_client_erl_server_SUITE_data/erl_server.erl +++ /dev/null @@ -1,29 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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% -%% -%% --module(erl_server). - --export([run/0, stop/0]). - -run() -> - m_i:oe_create(). - -stop() -> - gen_server:cast(cidl_test, stop). diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/m_i_impl.erl b/lib/ic/test/c_client_erl_server_SUITE_data/m_i_impl.erl deleted file mode 100644 index c530991058..0000000000 --- a/lib/ic/test/c_client_erl_server_SUITE_data/m_i_impl.erl +++ /dev/null @@ -1,162 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-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% -%% -%% --module(m_i_impl). --include("m.hrl"). - --export([init/1, terminate/2, void_test/1, long_test/2, ushort_test/2, - longlong_test/2, ulong_test/2, ulonglong_test/2, - double_test/2, char_test/2, wchar_test/2, octet_test/2, - bool_test/2, struct_test/2, struct2_test/2, seq1_test/2, - seq2_test/2, seq3_test/2, seq4_test/2, seq5_test/2, - array1_test/2, array2_test/2, enum_test/2, string1_test/2, - string2_test/2, string3_test/2, string4_test/2, pid_test/2, - port_test/2, ref_test/2, term_test/2, typedef_test/3, - inline_sequence_test/2, '_set_l'/2, '_get_l'/1, - term_struct_test/2, term_sequence_test/2, wstring1_test/2]). - --define(PRINTDEBUG(Case), - io:format("erl_server: case: ~p~n" - "erl_server: location: ~p~n", [Case, [?FILE, ?LINE]])). --define(PRINTDEBUG2(Case, Msg), - io:format("erl_server: case: ~p~n" - "erl_server: Msg: ~p~n" - "erl_server: location: ~p~n", [Case, Msg, [?FILE, ?LINE]])). - -init(Env) -> - {ok, []}. - -terminate(F, R) -> - ok. - -'_get_l'(State) -> - ?PRINTDEBUG("_get_l"), - {reply, State, State}. -void_test(State) -> - ?PRINTDEBUG("void_test"), - {reply, ok, State}. - -'_set_l'(State, V) -> - ?PRINTDEBUG2("_set_l", V), - {reply, ok, V}. -ushort_test(State, V) -> - ?PRINTDEBUG2("ushort_test", V), - {reply, {V, V}, State}. -long_test(State, V) -> - ?PRINTDEBUG2("long_test", V), - {reply, {V, V}, State}. -longlong_test(State, V) -> - ?PRINTDEBUG2("longlong_test", V), - {reply, {V, V}, State}. -ulong_test(State, V) -> - ?PRINTDEBUG2("ulong_test", V), - {reply, {V, V}, State}. -ulonglong_test(State, V) -> - ?PRINTDEBUG2("ulonglong_test", V), - {reply, {V, V}, State}. -double_test(State, V) -> - ?PRINTDEBUG2("double_test", V), - {reply, {V, V}, State}. -char_test(State, V) -> - ?PRINTDEBUG2("char_test", V), - {reply, {V, V}, State}. -wchar_test(State, V) -> - ?PRINTDEBUG2("wchar_test", V), - {reply, {V, V}, State}. -octet_test(State, V) -> - ?PRINTDEBUG2("octet_test", V), - {reply, {V, V}, State}. -bool_test(State, V) -> - ?PRINTDEBUG2("bool_test", V), - {reply, {V, V}, State}. - -struct_test(State, V) -> - ?PRINTDEBUG2("struct_test", V), - {reply, {V, V}, State}. -struct2_test(State, V) -> - ?PRINTDEBUG2("struct2_test", V), - {reply, {V, V}, State}. -seq1_test(State, V) -> - ?PRINTDEBUG2("seq1_test", V), - {reply, {V, V}, State}. -seq2_test(State, V) -> - ?PRINTDEBUG2("seq2_test", V), - {reply, {V, V}, State}. -seq3_test(State, V) -> - ?PRINTDEBUG2("seq3_test", V), - {reply, {V, V}, State}. -seq4_test(State, V) -> - ?PRINTDEBUG2("seq4_test", V), - {reply, {V, V}, State}. -seq5_test(State, V) -> - ?PRINTDEBUG2("seq5_test", V), - {reply, {V, V}, State}. -array1_test(State, V) -> - ?PRINTDEBUG2("array1_test", V), - {reply, {V, V}, State}. -array2_test(State, V) -> - ?PRINTDEBUG2("array2_test", V), - {reply, {V, V}, State}. -enum_test(State, V) -> - ?PRINTDEBUG2("enum_test", V), - {reply, {V, V}, State}. -string1_test(State, V) -> - ?PRINTDEBUG2("string1_test", V), - {reply, {V, V}, State}. -string2_test(State, V) -> - ?PRINTDEBUG2("string2_test", V), - {reply, {V, V}, State}. -string3_test(State, V) -> - ?PRINTDEBUG2("string3_test", V), - {reply, {V, V}, State}. -string4_test(State, V) -> - ?PRINTDEBUG2("string4_test", V), - {reply, {V, V}, State}. -pid_test(State, V) -> - ?PRINTDEBUG2("pid_test", V), - {reply, {V, V}, State}. -port_test(State, V) -> - ?PRINTDEBUG2("port_test", binary_to_list(term_to_binary(V))), - {reply, {V, V}, State}. -ref_test(State, V) -> - ?PRINTDEBUG2("ref_test", binary_to_list(term_to_binary(V))), - {reply, {V, V}, State}. -term_test(State, V) -> - ?PRINTDEBUG2("term_test", V), - {reply, {V, V}, State}. -typedef_test(State, A, B) -> - ?PRINTDEBUG2("typedef_test", [A,B]), - {reply, {4711, A, B}, State}. -inline_sequence_test(State, V) -> - ?PRINTDEBUG2("inline_sequence_test", V), - {reply, {V, V}, State}. -term_sequence_test(State, V) -> - ?PRINTDEBUG2("term_sequence_test", V), - {reply, {V, V}, State}. -term_struct_test(State, V) -> - ?PRINTDEBUG2("term_struct_test", V), - {reply, {V, V}, State}. -wstring1_test(State, V) -> - ?PRINTDEBUG2("wstring1_test", V), - {reply, {V, V}, State}. - - - - diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE.erl b/lib/ic/test/c_client_erl_server_proto_SUITE.erl deleted file mode 100644 index c15617ea3f..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_SUITE.erl +++ /dev/null @@ -1,265 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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 c-client/erl-server -%%---------------------------------------------------------------------- - --module(c_client_erl_server_proto_SUITE). --include_lib("common_test/include/ct.hrl"). - --export([init_per_testcase/2, end_per_testcase/2, - all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - void_test/1, long_test/1, long_long_test/1, - unsigned_short_test/1, unsigned_long_test/1, - unsigned_long_long_test/1, double_test/1, char_test/1, - wchar_test/1, octet_test/1, bool_test/1, struct_test/1, - struct2_test/1, seq1_test/1, seq2_test/1, seq3_test/1, - seq4_test/1, seq5_test/1, array1_test/1, array2_test/1, - enum_test/1, string1_test/1, string2_test/1, string3_test/1, - string4_test/1, pid_test/1, port_test/1, ref_test/1, term_test/1, - typedef_test/1, inline_sequence_test/1, term_sequence_test/1, - term_struct_test/1, wstring1_test/1]). - --define(DEFAULT_TIMEOUT, 20000). --define(PORT_TIMEOUT, 15000). --define(ERLANG_SERVER_NAME, idl_erlang_server). --define(C_CLIENT_NODE_NAME, c_client_idl_test). - -%% Add/remove code path and watchdog before/after each test case. -%% -init_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:add_patha(DataDir), - - %% Since other test suites use the module m_i, we have - %% to make sure we are using the right m_i module. - code:purge(m_i), - code:load_file(m_i), - - WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:del_path(DataDir), - WatchDog = proplists:get_value(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [void_test, long_test, long_long_test, - unsigned_short_test, unsigned_long_test, - unsigned_long_long_test, double_test, char_test, - wchar_test, octet_test, bool_test, struct_test, - struct2_test, seq1_test, seq2_test, seq3_test, - seq4_test, seq5_test, array1_test, array2_test, - enum_test, string1_test, string2_test, string3_test, - string4_test, pid_test, port_test, ref_test, term_test, - typedef_test, inline_sequence_test, term_sequence_test, - term_struct_test, wstring1_test]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -array1_test(Config) -> - do_test(array1_test, Config). - -array2_test(Config) -> - do_test(array2_test, Config). - -bool_test(Config) -> - do_test(bool_test, Config). - -char_test(Config) -> - do_test(char_test, Config). - -double_test(Config) -> - do_test(double_test, Config). - -enum_test(Config) -> - do_test(enum_test, Config). - -inline_sequence_test(Config) -> - do_test(inline_sequence_test, Config). - -long_long_test(Config) -> - do_test(long_long_test, Config). - -long_test(Config) -> - do_test(long_test, Config). - -octet_test(Config) -> - do_test(octet_test, Config). - -pid_test(Config) -> - do_test(pid_test, Config). - -port_test(Config) -> - do_test(port_test, Config). - -ref_test(Config) -> - do_test(ref_test, Config). - -seq1_test(Config) -> - do_test(seq1_test, Config). - -seq2_test(Config) -> - do_test(seq2_test, Config). - -seq3_test(Config) -> - do_test(seq3_test, Config). - -seq4_test(Config) -> - do_test(seq4_test, Config). - -seq5_test(Config) -> - do_test(seq5_test, Config). - -string1_test(Config) -> - do_test(string1_test, Config). - -string2_test(Config) -> - do_test(string2_test, Config). - -string3_test(Config) -> - do_test(string3_test, Config). - -string4_test(Config) -> - do_test(string4_test, Config). - -struct2_test(Config) -> - do_test(struct2_test, Config). - -struct_test(Config) -> - do_test(struct_test, Config). - -term_sequence_test(Config) -> - do_test(term_sequence_test, Config). - -term_struct_test(Config) -> - do_test(term_struct_test, Config). - -term_test(Config) -> - do_test(term_test, Config). - -typedef_test(Config) -> - do_test(typedef_test, Config). - -unsigned_long_long_test(Config) -> - do_test(unsigned_long_long_test, Config). - -unsigned_long_test(Config) -> - do_test(unsigned_long_test, Config). - -unsigned_short_test(Config) -> - do_test(unsigned_short_test, Config). - -void_test(Config) -> - do_test(void_test, Config). - -wchar_test(Config) -> - do_test(wchar_test, Config). - -wstring1_test(Config) -> - do_test(wstring1_test, Config). - - -%% It is here that all tests really are done. -%% - -do_test(Case, Config) -> - %% Trap exits - process_flag(trap_exit, true), - %% Start the server - {ok, _Pid} = m_i:oe_create_link([], {local, ?ERLANG_SERVER_NAME}), - Node = atom_to_list(node()), - %% [NodeName, HostName] = string:tokens(Node, "@"), - DataDir = proplists:get_value(data_dir, Config), - %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]), - Cookie = atom_to_list(erlang:get_cookie()), - %% Start C-client node as a port program. - Cmd = filename:join([DataDir, "c_client"]) ++ - " -this-node-name " ++ atom_to_list(?C_CLIENT_NODE_NAME) ++ - " -peer-node " ++ Node ++ - " -peer-process-name " ++ atom_to_list(?ERLANG_SERVER_NAME) ++ - " -cookie " ++ Cookie ++ - " -test-case " ++ atom_to_list(Case), - Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]), - Res = wait_for_completion(Port), - %% Kill off node if there was timeout - case Res of - {error, timeout} -> - catch rpc:cast(?C_CLIENT_NODE_NAME, erlang, halt, [1]); - _ -> - ok - end, - process_flag(trap_exit, false), - catch m_i:stop(?ERLANG_SERVER_NAME), - ok = Res. - - -%% Wait for eof *and* exit status, but return if exit status indicates -%% an error, or we have been waiting more than PORT_TIMEOUT seconds. -%% -wait_for_completion(Port) -> - wait_for_completion(Port, 0). - -wait_for_completion(Port, N) when N < 2 -> - receive - {Port, {data, Bytes}} -> - %% Relay output - io:format("~s", [Bytes]), - wait_for_completion(Port, N); - {Port, {exit_status, 0}} -> - wait_for_completion(Port, N + 1); - {Port, {exit_status, Status}} -> - {error, Status}; - {Port, eof} -> - wait_for_completion(Port, N + 1); - {'EXIT', Port, Reason} -> - io:format("Port exited with reason: ~w~n", [Reason]), - wait_for_completion(Port, N); - {'EXIT', From, Reason} -> - io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]), - wait_for_completion(Port, N) - after ?PORT_TIMEOUT -> - {error, timeout} - end; -wait_for_completion(_, _) -> - ok. - - - diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/Makefile.src b/lib/ic/test/c_client_erl_server_proto_SUITE_data/Makefile.src deleted file mode 100644 index fc6d416316..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/Makefile.src +++ /dev/null @@ -1,156 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2003-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% -# -# -# Makefile.src for c_client_erl_server test -# Note: This file *must* work for both Unix and Windows -# -# We use both `rm' (Unix) and `del' (Windows) for removing files, but -# with a `-' in front so that the error in not finding `rm' (`del') on -# Windows (Unix) is ignored. -# -# VxWorks? XXX -# - -.SUFFIXES: -.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@ - - -# Variables from ts: -# - -ERL_INCLUDE = @erl_include@ - -IC_INCLUDE_PATH = @ic_include_path@ -IC_LIB = @ic_lib@ - -ERL_INTERFACE_INCLUDE = @erl_interface_include@ -ERL_INTERFACE_LIB = @erl_interface_lib@ -ERL_INTERFACE_EILIB = @erl_interface_eilib@ -ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@ -ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@ - -CC = @CC@ -## XXX Should set warning flag with a DEBUG_FLAG -CFLAGS = @CFLAGS@ @DEFS@ -I@erl_include@ \ - -I@ic_include_path@ -I@erl_interface_include@ - -LD = @LD@ -LDFLAGS = @CROSSLDFLAGS@ -LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \ - $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS) -ERLC = erlc - -# Generated C header files -GEN_H_FILES = \ - m.h \ - m_i.h \ - oe_c_erl_test.h - -# Generated C files -GEN_C_FILES = \ - m.c \ - m_i.c \ - oe_c_erl_test.c \ - oe_code_m_a.c \ - oe_code_m_arr1.c \ - oe_code_m_arr2.c \ - oe_code_m_arr3.c \ - oe_code_m_aseq.c \ - oe_code_m_b.c \ - oe_code_m_bseq.c \ - oe_code_m_dd.c \ - oe_code_m_dyn.c \ - oe_code_m_dyn_sl.c \ - oe_code_m_es.c \ - oe_code_m_et.c \ - oe_code_m_etseq.c \ - oe_code_m_fruit.c \ - oe_code_m_lseq.c \ - oe_code_m_s.c \ - oe_code_m_s_sl.c \ - oe_code_m_sarr3.c \ - oe_code_m_simple.c \ - oe_code_m_ssarr3.c \ - oe_code_m_sseq.c \ - oe_code_m_ssstr3.c \ - oe_code_m_sstr3.c \ - oe_code_m_str1.c \ - oe_code_m_str3.c \ - oe_code_m_strRec.c \ - oe_code_m_strRec_str5.c \ - oe_code_m_strRec_str7.c - -GEN_HRL_FILES = \ - m.hrl \ - m_i.hrl \ - oe_c_erl_test.hrl - -GEN_ERL_FILES = \ - m.erl \ - m_arr2.erl \ - m_arr3.erl \ - m_i.erl \ - m_str3.erl \ - oe_c_erl_test.erl - -C_FILES = $(GEN_C_FILES) c_client.c my.c - -OBJS = $(C_FILES:.c=@obj@) - -PGMS = c_client@exe@ - -ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl - -EBINS = $(ERL_FILES:.erl=.@EMULATOR@) - - -all: $(PGMS) $(EBINS) - -$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl -$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c -$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES) -$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES) - -clean: - -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -$(PGMS): $(OBJS) - $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS) - -c_erl_test.built_c: c_erl_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_client}" \ - "+{user_protocol,my}" c_erl_test.idl - echo done > c_erl_test.built_c - -c_erl_test.built_erl: c_erl_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" c_erl_test.idl - echo done > c_erl_test.built_erl - -.c@obj@: - $(CC) -c -o $*@obj@ $(CFLAGS) $< - -.erl.@EMULATOR@: - $(ERLC) -I $(IC_INCLUDE_PATH) $< - diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c deleted file mode 100644 index d6a78d2481..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c +++ /dev/null @@ -1,1764 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2003-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% - * - */ -/* C-client for test of IC. - * - * TODO: - * - * 1. XXX #includes for VxWorks, Windows - */ - -#include <stdio.h> -#include <stdlib.h> - -#ifndef __WIN32__ -# include <unistd.h> -#endif - -#include <string.h> - -#ifdef __WIN32__ -# include <time.h> -# include <sys/timeb.h> -#elif defined VXWORKS -#include <time.h> -#include <sys/times.h> -#else -#include <sys/time.h> -#endif - -#include <ctype.h> - -#ifdef __WIN32__ -# include <winsock2.h> -# include <windows.h> -#else -# include <sys/types.h> -# include <sys/socket.h> -# include <netinet/in.h> -# include <arpa/inet.h> -# include <netdb.h> -#endif - -#include "ei.h" -#include "erl_interface.h" -#include "m_i.h" - -#define HOSTNAMESZ 255 -#define NODENAMESZ 512 - -#define INBUFSZ 10 -#define OUTBUFSZ 0 - -#define MAXTRIES 5 - -#define CHECK_EXCEPTION(x) \ - if ((x)->_major != CORBA_NO_EXCEPTION) { \ - fprintf(stderr,"\n\nException: %s\n\n", \ - (char *)CORBA_exception_value((x))); \ - CORBA_exception_free((x)); \ - return -1; \ - } \ - -/* XXX Should free things here too! */ -#define RETURN_IF_OK(x) \ - if ((x)) {\ - fprintf(stdout, "ok\n");\ - return 0;\ - }\ - -#define cmp_str(x,y) (!strcmp((x),(y))) -#define cmp_wstr(x,y) (!ic_wstrcmp((x),(y))) - -typedef CORBA_Environment IC_Env; - -typedef int (*TestFunc)(IC_Env *); -typedef struct { - char *name; - TestFunc func; -} TestCase; - -static char longtext[] = -"Introduction The IC application is an IDL compiler implemented in Erlang." -" The IDL compiler generates client stubs and server skeletons." -" Several back-ends are supported, and they fall into three main groups." -" For more details on IC compiler options consult the ic(3) manual page." -" Argument passing cases 1 Caller allocates all necessary storage," -" except that which may be encapsulated and managed within the parameter itself." -" 2 The caller allocates a pointer and passes it by reference to the callee." -" The callee sets the pointer to point to a valid instance of the parameter's type." -" The caller is responsible for releasing the returned storage." -" Following completion of a request, the caller is not allowed to modify any values" -" in the returned storage. To do so the caller must first copy the returned instance" -" into a new instance, then modify the new instance. 3 The caller allocates a" -" pointer to an array slice which has all the same dimensions of the original" -" array except the first, and passes it by reference to the callee. The callee sets" -" the pointer to point to a valid instance of the array. The caller is responsible for" -" releasing the returned storage. Following completion of a request, the caller is not" -" allowed to modify any values in the returned storage. To do so the caller must first" -" copy the returned instance into a new instance, then modify the new instance." -" Generated Files Two files will be generated for each scope. One set of files will be" -" generated for each module and each interface scope. An extra set is generated for" -" those definitions at top level scope. One of the files is a header file(.h), and the" -" other file is a C source code file (.c). In addition to these files a number of C" -" source files will be generated for type encodings, they are named according to the " -"following template: oe_code_<type>.c."; -static char this_node[NODENAMESZ + 1]; -static char *progname; - -/* Test function prototypes */ - -static int void_test(IC_Env *env); -static int long_test(IC_Env *env); -static int long_long_test(IC_Env *env); -static int unsigned_short_test(IC_Env *env); -static int unsigned_long_test(IC_Env *env); -static int unsigned_long_long_test(IC_Env *env); -static int double_test(IC_Env *env); -static int char_test(IC_Env *env); -static int wchar_test(IC_Env *env); -static int octet_test(IC_Env *env); -static int bool_test(IC_Env *env); -static int struct_test(IC_Env *env); -static int struct2_test(IC_Env *env); -static int seq1_test(IC_Env *env); -static int seq2_test(IC_Env *env); -static int seq3_test(IC_Env *env); -static int seq4_test(IC_Env *env); -static int seq5_test(IC_Env *env); -static int array1_test(IC_Env *env); -static int array2_test(IC_Env *env); -static int enum_test(IC_Env *env); -static int string1_test(IC_Env *env); -static int string2_test(IC_Env *env); -static int string3_test(IC_Env *env); -static int string4_test(IC_Env *env); -static int pid_test(IC_Env *env); -static int port_test(IC_Env *env); -static int ref_test(IC_Env *env); -static int term_test(IC_Env *env); -static int typedef_test(IC_Env *env); -static int inline_sequence_test(IC_Env *env); -static int term_sequence_test(IC_Env *env); -static int term_struct_test(IC_Env *env); -static int wstring1_test(IC_Env *env); - -static TestCase test_cases[] = { - {"void_test", void_test}, - {"long_test", long_test}, - {"long_long_test", long_long_test}, - {"unsigned_short_test", unsigned_short_test}, - {"unsigned_long_test", unsigned_long_test}, - {"unsigned_long_long_test", unsigned_long_long_test}, - {"double_test", double_test}, - {"char_test", char_test}, - {"wchar_test", wchar_test}, - {"octet_test", octet_test}, - {"bool_test", bool_test}, - {"struct_test", struct_test}, - {"struct2_test", struct2_test}, - {"seq1_test", seq1_test}, - {"seq2_test", seq2_test}, - {"seq3_test", seq3_test}, - {"seq4_test", seq4_test}, - {"seq5_test", seq5_test}, - {"array1_test", array1_test}, - {"array2_test", array2_test}, - {"enum_test", enum_test}, - {"string1_test", string1_test}, - {"string2_test", string2_test}, - {"string3_test", string3_test}, - {"string4_test", string4_test}, - {"pid_test", pid_test}, - {"port_test", port_test}, - {"ref_test", ref_test}, - {"term_test", term_test}, - {"typedef_test", typedef_test}, - {"inline_sequence_test", inline_sequence_test}, - {"term_sequence_test", term_sequence_test}, - {"term_struct_test", term_struct_test}, - {"wstring1_test", wstring1_test}, - {"", NULL} -}; - -/* Other prototypes */ -static int cmp_aseq(m_aseq *a1, m_aseq *a2); -static int cmp_a(m_a *a1, m_a *a2); -static int cmp_bseq(m_bseq *b1, m_bseq *b2); -static int cmp_b(m_b *b1, m_b *b2); -static int cmp_lseq(m_lseq *b1, m_lseq *b2); -static int cmp_etseq(m_etseq *b1, m_etseq *b2); -static int cmp_et(m_et* b1, m_et *b2); -static int cmp_es(m_es *b1, m_es *b2); -static int cmp_arr1(m_arr1 b1, m_arr1 b2); -static int cmp_dd(m_dd b1, m_dd b2); -static int cmp_strRec(m_strRec *b1, m_strRec *b2); -static int cmp_sseq(m_sseq *b1, m_sseq *b2); -static int cmp_pid(erlang_pid *p1, erlang_pid *p2); -static int cmp_port(erlang_port *p1, erlang_port *p2); -static int cmp_ref(erlang_ref *p1, erlang_ref *p2); -static int cmp_s(m_s *b1, m_s *b2); -static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2); -static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2); -static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2); -static int cmp_arr3(m_arr3 b1, m_arr3 b2); - -static void print_aseq(m_aseq *a); -static void print_a(m_a *a); -static void print_bseq(m_bseq *b); -static void print_lseq(m_lseq *b); -static void print_b(m_b *b); -static void print_etseq(m_etseq *b); -static void print_et(m_et* b); -static void print_es(m_es *b); -static void print_arr1(long a[500]); -static void print_dd(long a[2][3]); -static void print_strRec(m_strRec* sr); -static void print_sseq(m_sseq *b); -static void print_pid(erlang_pid *p); -static void print_port(erlang_port *p); -static void print_ref(erlang_ref *p); -static void print_term(ETERM *t); -static void print_s(m_s *p); -static void print_ssstr3(m_ssstr3 *b1); -static void print_ssarr3(m_ssarr3 *b1); -static void print_sarr3(m_sarr3 *b1); -static void print_arr3(m_arr3 b1); -static void print_wstr(CORBA_wchar *ws); - -static void free_etseq_buf(m_etseq *b); -static void free_et(m_et* b); - -#ifdef __WIN32__ -typedef struct { - long tv_sec; - long tv_usec; -} MyTimeval; -#else -typedef struct timeval MyTimeval; -#endif -static void my_gettimeofday(MyTimeval *tv); -static void showtime(MyTimeval *start, MyTimeval *stop); -static void usage(void); -static void done(int r); - - - -/* main */ - -#ifdef VXWORKS -int client(int argc, char **argv) -#else -int main(int argc, char **argv) -#endif -{ - struct hostent *hp; - erlang_pid pid; - MyTimeval start, stop; - int i, fd, ires, tres; - IC_Env *env; - int tries = 0; - char *this_node_name = NULL; - char *peer_node = NULL; - char *peer_process_name = NULL; - char *cookie = NULL; - char host[HOSTNAMESZ + 1]; - TestFunc test_func = NULL; - TestCase *test_case; - char *test_case_name = NULL; - -#ifdef __WIN32__ - WORD wVersionRequested; - WSADATA wsaData; - - wVersionRequested = MAKEWORD(2, 0); - - if (WSAStartup(wVersionRequested, &wsaData) != 0) { - fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL"); - exit(1); - } -#endif - - progname = argv[0]; - host[HOSTNAMESZ] = '\0'; - if (gethostname(host, HOSTNAMESZ + 1) < 0) { - fprintf(stderr, "Can't find own hostname\n"); - done(1); - } - if ((hp = gethostbyname(host)) == 0) { - fprintf(stderr, "Can't get ip address for host %s\n", host); - done(1); - } - for (i = 1; i < argc; i++) { - if (cmp_str(argv[i], "-help")) { - usage(); - done(0); - } else if (cmp_str(argv[i], "-this-node-name")) { - i++; - this_node_name = argv[i]; - } else if (cmp_str(argv[i], "-peer-node")) { - i++; - peer_node = argv[i]; - } else if (cmp_str(argv[i], "-peer-process-name")) { - i++; - peer_process_name = argv[i]; - } else if (cmp_str(argv[i], "-cookie")) { - i++; - cookie = argv[i]; - } else if (cmp_str(argv[i], "-test-case")) { - i++; - test_case_name = argv[i]; - } else { - fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]); - usage(); - done(1); - } - } - - if (this_node_name == NULL || peer_node == NULL || test_case_name == NULL - || peer_process_name == NULL || cookie == NULL) { - fprintf(stderr, "Error: missing option\n"); - usage(); - done(1); - } - - test_case = test_cases; - while (test_case->func) { - if (cmp_str(test_case->name, test_case_name)) { - test_func = test_case->func; - break; - } - test_case++; - } - if (test_func == NULL) { - fprintf(stderr, "Error: illegal test case: \"%s\"\n", test_case_name); - done(1); - } - - /* Behead hostname at first dot */ - for (i=0; host[i] != '\0'; i++) { - if (host[i] == '.') { host[i] = '\0'; break; } - } - sprintf(this_node, "%s@%s", this_node_name, host); - fprintf(stderr, "c_client: this node: \"%s\"\n", this_node); - fprintf(stderr, "c_client: peer node: \"%s\"\n", peer_node); - fprintf(stderr, "c_client: test case: \"%s\"\n", test_case_name); - - fprintf(stderr, "c_client: starting\n"); - - /* initialize erl_interface */ - erl_init(NULL, 0); - - for (tries = 0; tries < MAXTRIES; tries++) { - - /* connect to erlang node */ - - ires = erl_connect_xinit(host, this_node_name, this_node, - (struct in_addr *)*hp->h_addr_list, - cookie, 0); - - fprintf(stderr, "c_client: erl_connect_xinit(): %d\n", ires); - - fd = erl_connect(peer_node); - fprintf(stderr, "c_client: erl_connect(): %d\n", fd); - - if (fd >= 0) - break; - fprintf(stderr, "c_client: cannot connect, retrying\n"); - } - if (fd < 0) { - fprintf(stderr, "c_client: cannot connect, exiting\n"); - done(1); - } - env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ); - env->_fd = fd; - strcpy(env->_regname, peer_process_name); - env->_to_pid = NULL; - env->_from_pid = &pid; - - strcpy(pid.node, this_node); - pid.num = fd; - pid.serial = 0; - pid.creation = 0; - - my_gettimeofday(&start); - tres = test_func(env); /* Call test case */ - my_gettimeofday(&stop); - showtime(&start, &stop); - erl_close_connection(fd); - - printf("c_client: env->_inbuf before : %d\n", INBUFSZ); - printf("c_client: env->_outbuf before : %d\n", OUTBUFSZ); - printf("c_client: env->_inbuf after : %d\n", env->_inbufsz); - printf("c_client: env->_outbuf after : %d\n", env->_outbufsz); - - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - done(tres); -} - -static void usage() -{ - fprintf(stderr, "Usage: %s [-help] -this-node-name <name> " - "-peer-node <nodename> -peer-process-name <name> " - "-cookie <cookie> -test-case <test case name>\n", progname); - fprintf(stderr, "Example:\n %s -this-node-name kalle " - "-peer-node olle@home -peer-process-name idltest " - "-cookie oa678er -test-case octet_test\n", progname); -} - -static void done(int r) -{ -#ifdef __WIN32__ - WSACleanup(); -#endif - exit(r); -} - - -/* TESTS */ - -static int void_test(IC_Env *env) -{ - fprintf(stdout, "\n======== m_i_void test ======\n\n"); - m_i_void_test(NULL,env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(1); -} - -static int long_test(IC_Env *env) -{ - long l = 4711, lo, lr; - - fprintf(stdout, "\n======== m_i_long test ======\n\n"); - lr = m_i_long_test(NULL, l, &lo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(l == lo && l == lr); - if (l != lo) - fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", l, lo); - if (l != lr) - fprintf(stdout, " result error, sent: %ld, got: %ld\n", l, lr); - return -1; -} - -static int long_long_test(IC_Env *env) -{ - CORBA_long_long ll = 4711, llo, llr; - - fprintf(stdout, "\n======== m_i_longlong test ======\n\n"); - llr = m_i_longlong_test(NULL, ll, &llo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ll == llo && ll == llr); - if (ll != llo) - fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", - ll, llo); - if (ll != llr) - fprintf(stdout, " result error, sent: %ld, got: %ld\n", ll, llr); - return -1; -} - -static int unsigned_short_test(IC_Env *env) -{ - unsigned short x, y = 2, z; - - fprintf(stdout, "\n======== m_i_ushort test ======\n\n"); - x = m_i_ushort_test(NULL, y, &z, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(y == z && y == x); - if (y != z) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", y, z); - if (y != x) - fprintf(stdout, " result error, sent: %d, got: %d\n", y, x); - return -1; -} - - -static int unsigned_long_test(IC_Env *env) -{ - unsigned long ul = 5050, ulo, ulr; - - fprintf(stdout, "\n======== m_i_ulong test ======\n\n"); - ulr = m_i_ulong_test(NULL, ul, &ulo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ul == ulo && ul == ulr); - if (ul != ulo) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - ul, ulo); - if (ul != ulr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", ul, ulr); - return -1; -} - -/* - * Note: CORBA_unsigned_long_long is in fact a plain long. - */ -static int unsigned_long_long_test(IC_Env *env) -{ - CORBA_unsigned_long_long ull = 5050, ullo, ullr; - - fprintf(stdout, "\n======== m_i_ulonglong test ======\n\n"); - ullr = m_i_ulonglong_test(NULL, ull, &ullo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ull == ullo && ull == ullr); - if (ull != ullo) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - ull, ullo); - if (ull != ullr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", - ull, ullr); - return -1; -} - -static int double_test(IC_Env *env) -{ - double d = 12.1212, db, dr; - - fprintf(stdout, "\n======== m_i_double test ======\n\n"); - dr = m_i_double_test(NULL, d, &db, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(d == db && d == dr); - if (d != db) - fprintf(stdout, " out parameter error, sent: %f, got: %f\n", d, db); - if (d != dr) - fprintf(stdout, " result error, sent: %f, got: %f\n", d, dr); - return -1; -} - -static int char_test(IC_Env *env) -{ - char c = 'g', co, cr; - - /* char test */ - fprintf(stdout, "\n======== m_i_char test ======\n\n"); - cr = m_i_char_test(NULL, c, &co, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(c == co && c == cr); - if (c !=co) - fprintf(stdout, " out parameter error, sent: %c, got: %c\n", c, co); - if (c != cr) - fprintf(stdout, " result error, sent: %c, got: %c\n", c, cr); - return -1; -} - -static int wchar_test(IC_Env *env) -{ - CORBA_wchar wc = 103, wco, wcr; - - fprintf(stdout, "\n======== m_i_wchar test ======\n\n"); - wcr = m_i_wchar_test(NULL, wc, &wco, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(wc == wco && wc == wcr); - if (wc != wco) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - wc, wco); - if (wc != wcr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", - wc, wcr); - return -1; -} - -static int octet_test(IC_Env *env) -{ - char o ='r', oo, or; - - fprintf(stdout, "\n======== m_i_octet test ======\n\n"); - or = m_i_octet_test(NULL, o, &oo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(o == oo && o == or); - if (o != oo) - fprintf(stdout, " out parameter error, sent: %c, got: %c\n", o, oo); - if (o != or) - fprintf(stdout, " result error, sent: %c, got: %c\n", o, or); - return -1; -} - -static int bool_test(IC_Env *env) -{ - unsigned char i = 0, io, ir; - - fprintf(stdout, "\n======== m_i_bool test ======\n\n"); - ir = m_i_bool_test(NULL, i, &io, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(i == io && i == ir); - if (i != io) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", i, io); - if (i != ir) - fprintf(stdout, " result error, sent: %d, got: %d\n", i, ir); - return -1; -} - -static int struct_test(IC_Env *env) -{ - m_b b = {4711, 'a'}, bo, br; - - fprintf(stdout, "\n======== m_i_struct test ======\n\n"); - br = m_i_struct_test(NULL, &b, &bo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_b(&b, &bo) && cmp_b(&b, &br)); - if (!cmp_b(&b, &bo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_b(&b); - fprintf(stdout, " got:\n"); - print_b(&bo); - fprintf(stdout, "\n"); - } - if (!cmp_b(&b, &br)) { - fprintf(stdout, " result error, sent:\n"); - print_b(&b); - fprintf(stdout, " got:\n"); - print_b(&br); - fprintf(stdout, "\n"); - } - return -1; -} - -static int struct2_test(IC_Env *env) -{ - m_es esi = {m_peach, 5050}, eso, esr; - - fprintf(stdout, "\n======== m_i_struct2 test ======\n\n"); - esr = m_i_struct2_test(NULL, &esi, &eso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_es(&esi, &eso) && cmp_es(&esi, &esr)); - if (!cmp_es(&esi, &eso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_es(&esi); - fprintf(stdout, " got:\n"); - print_es(&eso); - fprintf(stdout, "\n"); - } - if (!cmp_es(&esi, &esr)) { - fprintf(stdout, " result error, sent:\n"); - print_es(&esi); - fprintf(stdout, " got:\n"); - print_es(&esr); - fprintf(stdout, "\n"); - } - return -1; -} - - -static int seq1_test(IC_Env *env) -{ - m_bseq bs, *bso, *bsr; - - m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}}; - bs._length = 3; - bs._buffer = ba; - - fprintf(stdout, "\n======== m_i_seq1 test ======\n\n"); - bsr = m_i_seq1_test(NULL, &bs, &bso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_bseq(&bs, bso) && cmp_bseq(&bs, bsr)); - if (!cmp_bseq(&bs, bso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_bseq(&bs); - fprintf(stdout, " got:\n"); - print_bseq(bso); - fprintf(stdout, "\n"); - } - if (!cmp_bseq(&bs, bsr)) { - fprintf(stdout, " result error, sent:\n"); - print_bseq(&bs); - fprintf(stdout, " got:\n"); - print_bseq(bsr); - fprintf(stdout, "\n"); - } - CORBA_free(bso); - CORBA_free(bsr); - return -1; -} - -static int seq2_test(IC_Env *env) -{ - m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}}; - m_a a; - m_a aa[2]; - m_aseq as, *aso, *asr; - - a.l = 9999; - a.y._length = 3; - a.y._buffer = ba; - a.d = 66.89898989; - - aa[0] = a; - aa[1] = a; - as._length = 2; - as._buffer = aa; - - fprintf(stdout, "\n======== m_i_seq2 test ======\n\n"); - asr = m_i_seq2_test(NULL, &as, &aso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_aseq(&as, aso) && cmp_aseq(&as, asr)); - if (!cmp_aseq(&as, aso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_aseq(&as); - fprintf(stdout, " got:\n"); - print_aseq(aso); - fprintf(stdout, "\n"); - } - if (!cmp_aseq(&as, asr)) { - fprintf(stdout, " result error, sent:\n"); - print_aseq(&as); - fprintf(stdout, " got:\n"); - print_aseq(asr); - fprintf(stdout, "\n"); - } - CORBA_free(aso); - CORBA_free(asr); - return -1; -} - -static int seq3_test(IC_Env *env) -{ - m_lseq lsi, *lso, *lsr; - long al[500]; - int i=0; - - for (i = 0; i < 500; i++) - al[i]=i; - lsi._length = 500; - lsi._buffer = al; - - fprintf(stdout, "\n======== m_i_seq3 test ======\n\n"); - lsr = m_i_seq3_test(NULL, &lsi, &lso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_lseq(&lsi, lso) && cmp_lseq(&lsi, lsr)); - if (!cmp_lseq(&lsi, lso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_lseq(&lsi); - fprintf(stdout, " got:\n"); - print_lseq(lso); - fprintf(stdout, "\n"); - } - if (!cmp_lseq(&lsi, lsr)) { - fprintf(stdout, " result error, sent:\n"); - print_lseq(&lsi); - fprintf(stdout, " got:\n"); - print_lseq(lsr); - fprintf(stdout, "\n"); - } - CORBA_free(lso); - CORBA_free(lsr); - return -1; -} - -static int seq4_test(IC_Env *env) -{ - char *stra0[3] = {"a", "long", "time"}; - char *stra1[3] = {"ago", "there", "was"}; - char *stra2[3] = {"a", "buggy", "compiler"}; - m_sstr3 str3s[3] = {{3, 3, stra0}, {3, 3, stra1}, {3, 3, stra2}}; - m_ssstr3 str3ssi = {3, 3, str3s}; - m_ssstr3 *str3sso, *str3ssr; - - fprintf(stdout, "\n======== m_i_seq4 test ======\n\n"); - str3ssr = m_i_seq4_test(NULL, &str3ssi, &str3sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ssstr3(&str3ssi, str3sso) && - cmp_ssstr3(&str3ssi, str3ssr)); - if (!cmp_ssstr3(&str3ssi, str3sso)){ - fprintf(stdout, " out parameter error, sent:\n"); - print_ssstr3(&str3ssi); - fprintf(stdout, " got:\n"); - print_ssstr3(str3sso); - fprintf(stdout, "\n"); - } - if (!cmp_ssstr3(&str3ssi, str3ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_ssstr3(&str3ssi); - fprintf(stdout, " got:\n"); - print_ssstr3(str3ssr); - fprintf(stdout, "\n"); - } - CORBA_free(str3sso); - CORBA_free(str3ssr); - return -1; -} - -static int seq5_test(IC_Env *env) -{ - m_arr3 arr3a[3] = { - {4711, 18931947, 3}, - {4711, 18931947, 3}, - {4711, 18931947, 3}}; - m_sarr3 arr3sa[3] = {{3, 3, arr3a}, {3, 3, arr3a}, {3, 3, arr3a}}; - m_ssarr3 arr3ssi = {3, 3, arr3sa}; - m_ssarr3 *arr3sso; - m_ssarr3 *arr3ssr; - - fprintf(stdout, "\n======== m_i_seq5 test ======\n\n"); - arr3ssr = m_i_seq5_test(NULL, &arr3ssi, &arr3sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ssarr3(&arr3ssi, arr3sso) && - cmp_ssarr3(&arr3ssi, arr3ssr)); - if (!cmp_ssarr3(&arr3ssi, arr3sso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_ssarr3(&arr3ssi); - fprintf(stdout, " got:\n"); - print_ssarr3(arr3sso); - fprintf(stdout, "\n"); - } - if (!cmp_ssarr3(&arr3ssi, arr3ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_ssarr3(&arr3ssi); - fprintf(stdout, " got:\n"); - print_ssarr3(arr3ssr); - fprintf(stdout, "\n"); - } - CORBA_free(arr3sso); - CORBA_free(arr3ssr); - return -1; -} - -static int array1_test(IC_Env *env) -{ - int i; - long al[500]; - m_arr1 alo; - m_arr1_slice* alr; - - for (i = 0; i < 500; i++) - al[i]=i; - - fprintf(stdout, "\n======== m_i_array1 test ======\n\n"); - alr = m_i_array1_test(NULL, al, alo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_arr1(al, alo) && cmp_arr1(al, alr)); - if (!cmp_arr1(al, alo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_arr1(al); - fprintf(stdout, " got:\n"); - print_arr1(alo); - fprintf(stdout, "\n"); - } - if (!cmp_arr1(al,alr)) { - fprintf(stdout, " result error, sent:\n"); - print_arr1(al); - fprintf(stdout, " got:\n"); - print_arr1(alr); - fprintf(stdout, "\n"); - } - free(alo); - free(alr); - return -1; -} - -static int array2_test(IC_Env *env) -{ - long dl[2][3] = {{11, 2, 7}, {22, 8 ,13}}; - m_dd dlo; - m_dd_slice* dlr; - - fprintf(stdout, "\n======== m_i_array2 test ======\n\n"); - dlr = m_i_array2_test(NULL, dl, dlo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_dd(dl,dlo) && cmp_dd(dl,dlr)); - if (!cmp_dd(dl,dlo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_dd(dl); - fprintf(stdout, " got:\n"); - print_dd(dlo); - fprintf(stdout, "\n"); - } - if (!cmp_dd(dl,dlr)) { - fprintf(stdout, " result error, sent:\n"); - print_dd(dl); - fprintf(stdout, " got:\n"); - print_dd(dlr); - fprintf(stdout, "\n"); - } - free(*dlr); - return -1; -} - -static int enum_test(IC_Env *env) -{ - m_fruit ei = m_banana, eo, er; - - fprintf(stdout, "\n======== m_i_enum test ======\n\n"); - er = m_i_enum_test(NULL, ei, &eo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ei == eo && ei == er); - if (ei != eo) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", ei, eo); - if (ei != er) - fprintf(stdout, " result error, sent: %d, got: %d\n", ei, er); - return -1; -} - -static int string1_test(IC_Env *env) -{ - char* si = longtext; - char* so; - char* sr; - - fprintf(stdout, "\n======== m_i_string1 test ======\n\n"); - sr = m_i_string1_test(NULL, si, &so, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, sr)); - if (!cmp_str(si, so)) - fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so); - if (!cmp_str(si, sr)) - fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr); - CORBA_free(so); - CORBA_free(sr); - return -1; -} - -static int string2_test(IC_Env *env) -{ - char* sa[3] = {"hello", "foo", "bar"}; - m_sseq ssi = {3, 3, sa}; - m_sseq *sso, *ssr; - - fprintf(stdout, "\n======== m_i_string2 test ======\n\n"); - ssr = m_i_string2_test(NULL, &ssi, &sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_sseq(&ssi, sso) && cmp_sseq(&ssi, sso)); - if (!cmp_sseq(&ssi, sso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_sseq(&ssi); - fprintf(stdout, "got:\n"); - print_sseq(sso); - } - if (!cmp_sseq(&ssi, ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_sseq(&ssi); - fprintf(stdout, "got:\n"); - print_sseq(ssr); - } - CORBA_free(sso); - CORBA_free(ssr); - return -1; -} - -static int string3_test(IC_Env *env) -{ - char* si = longtext; - char* so; - char* sr; - - fprintf(stdout, "\n======== m_i_string3 test ======\n\n"); - sr = m_i_string3_test(NULL, si, &so, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, so)); - if (!cmp_str(si, so)) - fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so); - if (!cmp_str(si, sr)) - fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr); - CORBA_free(so); - CORBA_free(sr); - return -1; -} - -static int string4_test(IC_Env *env) -{ - char as1[100] = "a string", as2[200] = "help", as3[200] = "hello there"; - m_strRec stri = { 1, /* dd */ - as1, /* str4 */ - {{'a', 'k'}, {'z', 'g'}, {'n', 'q'}}, /* str7 */ - {3, 3, "buf"}, /* str5 */ - as2, /* str6 */ - {'m', 'f', 'o'}, /* str8 */ - as3, /* str9 */ - {3, 3, "stu"} /* str10 */ - }; - m_strRec *stro, *strr; - - fprintf(stdout, "\n======== m_i_string4 test ======\n\n"); - strr = m_i_string4_test(NULL, &stri, &stro, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_strRec(&stri,stro) && cmp_strRec(&stri,strr)); - if (!cmp_strRec(&stri,stro)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_strRec(&stri); - fprintf(stdout, " got:\n"); - print_strRec(stro); - fprintf(stdout, "\n"); - } - if (!cmp_strRec(&stri,strr)) { - fprintf(stdout, " result error, sent:\n"); - print_strRec(&stri); - fprintf(stdout, " got:\n"); - print_strRec(strr); - fprintf(stdout, "\n"); - } - CORBA_free(stro); - CORBA_free(strr); - return -1; -} - - -static int pid_test(IC_Env *env) -{ - erlang_pid pid = {"", 7, 0, 0}, pido, pidr; - - strcpy(pid.node, this_node), /* this currently running node */ - fprintf(stdout, "\n======== m_i_pid test ======\n\n"); - pidr = m_i_pid_test(NULL, &pid, &pido, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_pid(&pid, &pido) && cmp_pid(&pid, &pidr)); - if (!cmp_pid(&pid, &pido)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_pid(&pid); - fprintf(stdout, "got:\n"); - print_pid(&pido); - } - if (!cmp_pid(&pid, &pidr)) { - fprintf(stdout, " result error, sent:\n"); - print_pid(&pid); - fprintf(stdout, "got:\n"); - print_pid(&pidr); - } - return -1; -} - -static int port_test(IC_Env *env) -{ - erlang_port porti = {"node", 5, 1}, porto, portr; - - fprintf(stdout, "\n======== m_i_port test ======\n\n"); - portr = m_i_port_test(NULL, &porti, &porto, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_port(&porti, &porto) && cmp_port(&porti, &portr)); - if (!cmp_port(&porti, &porto)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_port(&porti); - fprintf(stdout, "got:\n"); - print_port(&porto); - } - if (!cmp_port(&porti, &portr)) { - fprintf(stdout, " result error, sent:\n"); - print_port(&porti); - fprintf(stdout, "got:\n"); - print_port(&portr); - } - return -1; -} - -static int ref_test(IC_Env *env) -{ - erlang_ref refi = { "node1", 3, {1, 2, 3}, 1}, - refo, refr; - - fprintf(stdout, "\n======== m_i_ref test ======\n\n"); - refr = m_i_ref_test(NULL, &refi, &refo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ref(&refi, &refo) && cmp_ref(&refi, &refr)); - if (!cmp_ref(&refi, &refo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_ref(&refi); - fprintf(stdout, "got:\n"); - print_ref(&refo); - } - if (!cmp_ref(&refi, &refr)) { - fprintf(stdout, " result error, sent:\n"); - print_ref(&refi); - fprintf(stdout, "got:\n"); - print_ref(&refr); - } - return -1; -} - -static int term_test(IC_Env *env) -{ - ETERM *ti, *to, *tr; - - ti = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"); - - fprintf(stdout, "\n======== m_i_term test ======\n\n"); - tr = m_i_term_test(NULL, ti, &to, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(erl_match(ti, to) && erl_match(ti, tr)); - if (!erl_match(ti, to)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_term(ti); - fprintf(stdout, "got:\n"); - print_term(to); - } - if (!erl_match(ti, tr)) { - fprintf(stdout, " result error, sent:\n"); - print_term(ti); - fprintf(stdout, "got:\n"); - print_term(tr); - } - erl_free_term(ti); - erl_free_term(to); - erl_free_term(tr); - return -1; -} - -static int typedef_test(IC_Env *env) -{ - m_banan mbi, mbo; /* erlang_port */ - m_apa mai; /* ETERM* */ - m_apa mao = NULL; - long tl; - - strcpy(mbi.node,"node"); - mbi.id = 15; - mbi.creation = 1; - - fprintf(stdout, "\n======== m_i_typedef test ======\n\n"); - mai = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"); - tl = m_i_typedef_test(NULL, mai, &mbi, &mao, &mbo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(erl_match(mai, mao) && cmp_port(&mbi, &mbo) && tl == 4711); - if (!erl_match(mai, mao)) { - fprintf(stdout, " out parameter error (term), sent:\n"); - print_term(mai); - fprintf(stdout, "got:\n"); - print_term(mao); - } - if (!cmp_port(&mbi, &mbo)) { - fprintf(stdout, " out parameter error (port), sent:\n"); - print_port(&mbi); - fprintf(stdout, "got:\n"); - print_port(&mbo); - } - if (tl != 4711) { - fprintf(stdout, " result error, sent: 4711, got %ld\n", tl); - } - erl_free_term(mai); - erl_free_term(mao); - return -1; -} - -static int inline_sequence_test(IC_Env *env) -{ - int i; - long al[500]; - m_s isi = {4711, {500, 10, al}}, - *iso, *isr; - - for (i = 0; i < 500; i++) - al[i]=i; - fprintf(stdout, "\n======== m_i_inline_sequence test ======\n\n"); - isr = m_i_inline_sequence_test(NULL, &isi, &iso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_s(&isi, iso) && cmp_s(&isi, isr)); - if (!cmp_s(&isi, iso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_s(&isi); - fprintf(stdout, "got:\n"); - print_s(iso); - } - if (!cmp_s(&isi, isr)) { - fprintf(stdout, " result error, sent:\n"); - print_s(&isi); - fprintf(stdout, "got:\n"); - print_s(isr); - } - CORBA_free(iso); - CORBA_free(isr); - return -1; -} - -static int term_sequence_test(IC_Env *env) -{ - ETERM* et_array[4] = { - erl_format("[{apa, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{banan, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{apelsin, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{mango, 1, 23}, \"string\", {1.23, 45}]")}; - m_etseq etsi = {4, 4, et_array}, *etso, *etsr; - - fprintf(stdout, "\n======== m_i_term_sequence test ======\n\n"); - etsr = m_i_term_sequence_test(NULL, &etsi, &etso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_etseq(&etsi, etso) && cmp_etseq(&etsi, etsr)); - if (!cmp_etseq(&etsi, etso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_etseq(&etsi); - fprintf(stdout, "got:\n"); - print_etseq(etso); - } - if (!cmp_etseq(&etsi, etsr)) { - fprintf(stdout, " result error, sent:\n"); - print_etseq(&etsi); - fprintf(stdout, "got:\n"); - print_etseq(etsr); - } - free_etseq_buf(&etsi); - free_etseq_buf(etso); - free_etseq_buf(etsr); - CORBA_free(etso); - CORBA_free(etsr); - return -1; -} - -static int term_struct_test(IC_Env *env) -{ - m_et eti = { erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"), - 121212 }; - m_et eto, etr; - - fprintf(stdout, "\n======== m_i_term_struct test ======\n\n"); - etr = m_i_term_struct_test(NULL, &eti, &eto, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_et(&eti, &eto) && cmp_et(&eti, &etr)); - if (!cmp_et(&eti, &eto)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_et(&eti); - fprintf(stdout, "got:\n"); - print_et(&eto); - } - if (!cmp_et(&eti, &etr)) { - fprintf(stdout, " result error, sent:\n"); - print_et(&eti); - fprintf(stdout, "got:\n"); - print_et(&etr); - } - free_et(&eti); - free_et(&eto); - free_et(&etr); - return -1; -} - -static int wstring1_test(IC_Env *env) -{ - CORBA_wchar wsi[] = {100, 101, 102, 103, 104, 0}, *wso, *wsr; - - fprintf(stdout, "\n======== m_i_wstring1 test ======\n\n"); - wsr = m_i_wstring1_test(NULL, wsi, &wso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_wstr(wsi, wso) && cmp_wstr(wsi, wsr)); - if (!cmp_wstr(wsi, wso)) { - fprintf(stdout, " out parameter error, sent: \n"); - print_wstr(wsi); - fprintf(stdout, "got:\n"); - print_wstr(wso); - } - if (!cmp_wstr(wsi, wsr)) { - fprintf(stdout, " result error, sent: \n"); - print_wstr(wsi); - fprintf(stdout, "got:\n"); - print_wstr(wsr); - } - CORBA_free(wso); - CORBA_free(wsr); - return -1; -} - -/* Compare functions */ -static int cmp_aseq(m_aseq *a1, m_aseq *a2) -{ - int i; - - if (a1->_length != a2->_length) - return 0; - for (i = 0; i < a1->_length; i++) - if (cmp_a(&(a1->_buffer[i]), &(a2->_buffer[i])) == 0) - return 0; - return 1; -} - -static int cmp_a(m_a *a1, m_a *a2) -{ - return a1->l == a2->l && - a1->d == a2->d && - cmp_bseq(&a1->y, &a2->y); -} - -static int cmp_bseq(m_bseq *b1, m_bseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (cmp_b(&(b1->_buffer[i]), &(b2->_buffer[i])) == 0) - return 0; - return 1; -} - -static int cmp_b(m_b *b1, m_b *b2) -{ - return b1->l == b2->l && b1->c == b2->c; -} - -static int cmp_lseq(m_lseq *b1, m_lseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (b1->_buffer[i] != b2->_buffer[i]) - return 0; - return 1; -} - -static int cmp_etseq(m_etseq *b1, m_etseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (!erl_match(b1->_buffer[i], b2->_buffer[i])) - return 0; - return 1; -} - -static int cmp_et(m_et* b1, m_et *b2) -{ - return erl_match(b1->e, b2->e) && b1->l == b2->l; -} - -static int cmp_es(m_es *b1, m_es *b2) -{ - return b1->f == b2->f && b1->l == b2->l; -} - -static int cmp_arr1(m_arr1 b1, m_arr1 b2) -{ - int i; - - for (i = 0; i < 500; i++) - if (b1[i] != b2[i]) - return 0; - return 1; -} - -static int cmp_dd(m_dd b1, m_dd b2) -{ - - int i, j; - - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) - if (b1[i][j] != b2[i][j]) - return 0; - return 1; -} - - - -static int cmp_strRec(m_strRec *b1, m_strRec *b2) -{ - int i, j; - - if (b1->bb != b2->bb) - return 0; - if (!cmp_str(b1->str4,b2->str4)) - return 0; - if (b1->str5._length != b2->str5._length) - return 0; - for (j = 0; j < b1->str5._length; j++) - if (b1->str5._buffer[j] != b2->str5._buffer[j]) - return 0; - if (!cmp_str(b1->str6,b2->str6)) - return 0; - for (i = 0; i < 3; i++) - for (j = 0; j < 2; j++) - if (b1->str7[i][j] != b2->str7[i][j]) - return 0; - for (j = 0; j < 3; j++) - if (b1->str8[j] != b2->str8[j]) - return 0; - if (!cmp_str(b1->str9,b2->str9)) - return 0; - if (b1->str10._length != b2->str10._length) - return 0; - for (j = 0; j < b1->str10._length; j++) - if (b1->str10._buffer[j] != b2->str10._buffer[j]) - return 0; - return 1; -} - - -static int cmp_sseq(m_sseq *b1, m_sseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (!cmp_str(b1->_buffer[i], b2->_buffer[i])) - return 0; - return 1; -} - - -static int cmp_pid(erlang_pid *p1, erlang_pid *p2) -{ - return cmp_str(p1->node,p2-> node) && - p1->num == p2->num && - p1->serial == p2->serial && - p1->creation == p2->creation; -} - -static int cmp_port(erlang_port *p1, erlang_port *p2) -{ - return cmp_str(p1->node,p2-> node) && p1->id == p2->id; -} - -static int cmp_ref(erlang_ref *p1, erlang_ref *p2) -{ - return cmp_str(p1->node, p2->node) && - p1->len == p2->len && - (p1->len < 1 || p1->n[0] == p2->n[0]) && - (p1->len < 2 || p1->n[1] == p2->n[1]) && - (p1->len < 3 || p1->n[2] == p2->n[2]); -} - -static int cmp_s(m_s *b1, m_s *b2) -{ - int i; - - if (b1->l != b2->l) - return 0; - if (b1->sl._length != b2->sl._length) - return 0; - for (i = 0; i < b1->sl._length; i++) - if (b1->sl._buffer[i] != b2->sl._buffer[i]) - return 0; - return 1; -} - - -static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2) -{ - int i,j; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (b1->_buffer[i]._length != b2->_buffer[i]._length) - return 0; - for (j = 0; j < b1->_buffer[i]._length; j++) - if (!cmp_str(b1->_buffer[i]._buffer[j], - b2->_buffer[i]._buffer[j])) - return 0; - } - return 1; -} - - - -static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (!cmp_sarr3(&b1->_buffer[i], &b2->_buffer[i])) - return 0; - } - return 1; -} - -static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (!cmp_arr3(b1->_buffer[i], b2->_buffer[i])) - return 0; - } - return 1; -} - -static int cmp_arr3(m_arr3 b1, m_arr3 b2) -{ - int i; - - for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) { - if (b1[i] != b2[i]) - return 0; - } - return 1; -} - -/* Print functions */ -static void print_aseq(m_aseq *a) -{ - int i; - fprintf(stdout, "\nm_aseq size: %ld --------\n", a->_length); - for (i = 0; i < a->_length; i++) - print_a(&(a->_buffer[i])); -} - -static void print_a(m_a *a) -{ - fprintf(stdout, "\nm_a --------\n l: %ld\n d:%f\n", a->l, a->d); - print_bseq(&a->y); -} - -static void print_bseq(m_bseq *b) -{ - int i; - - fprintf(stdout, "\nm_bseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - print_b(&(b->_buffer[i])); -} - -static void print_lseq(m_lseq *b) -{ - int i; - - fprintf(stdout, "\nm_lseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - fprintf(stdout, "[%d]: %ld\n", i, b->_buffer[i]); -} - -static void print_b(m_b *b) -{ - fprintf(stdout, "\nm_b --------\n l: %ld\n c: %c\n", b->l, b->c); -} - - -static void print_etseq(m_etseq *b) -{ - int i; - - for (i = 0; i < b->_length; i++) { - fprintf(stdout, "[%d]:\n", i); - erl_print_term(stdout, b->_buffer[i]); - } -} - - -static void print_et(m_et* b) -{ - fprintf(stdout, "\net struct --------\n"); - erl_print_term(stdout, b->e); - fprintf(stdout, "long: %ld\n", b->l); - fprintf(stdout, "\n--------\n"); -} - -static void print_es(m_es *b) -{ - fprintf(stdout, "\nm_es --------\n f: %d\n l: %ld\n", b->f, b->l); -} - - -static void print_arr1(long a[10]) -{ - int i; - - for (i = 0; i < 10; i++) - fprintf(stdout, "\n[%d]: %ld\n", i, a[i]); -} - -static void print_dd(long a[2][3]) -{ - int i, j; - - fprintf(stdout, "\nlong dd[2][3] --------\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) - fprintf(stdout, "\n[%d][%d]: %ld\n", i, j, a[i][j]); -} - - -static void print_strRec(m_strRec* sr) -{ - int i, j; - - fprintf(stdout, "\nboolean bb : %d\n",sr->bb); - fprintf(stdout, "string str4 : %s\n",sr->str4); - fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 3; i++) - for (j = 0; j < 2; j++) - fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); - fprintf(stdout, "str5._length : %ld\n",sr->str5._length); - for (j = 0; j < sr->str5._length; j++) - fprintf(stdout, "str5._buffer[%d]: %c\n", j, sr->str5._buffer[j]); - fprintf(stdout, "string str6 : %s\n",sr->str6); - fprintf(stdout, "str8 :\n"); - for (j = 0; j < 3; j++) - fprintf(stdout, "str8[%d]: %c\n", j, sr->str8[j]); - fprintf(stdout, "string str9 : %s\n",sr->str9); - fprintf(stdout, "str10._length : %ld\n",sr->str10._length); - for (j = 0; j < sr->str10._length; j++) - fprintf(stdout, "str10._buffer[%d]: %c\n", j, sr->str10._buffer[j]); -} - -static void print_sseq(m_sseq *b) -{ - int i; - - fprintf(stdout, "\nm_sseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - fprintf(stdout, "%s\n", b->_buffer[i]); - -} - - -static void print_pid(erlang_pid *p) -{ - fprintf(stdout, "\nerlang_pid --------\n node: %s\n num: %d\n " - "serial: %d\n creation: %d\n", - p->node, p->num, p->serial, p->creation); -} - -static void print_port(erlang_port *p) -{ - fprintf(stdout, "\nerlang_port --------\n node: %s\n id: %d\n " - "creation: %d\n", p->node, p->id, p->creation); -} - -static void print_ref(erlang_ref *p) -{ - fprintf(stdout, "\nerlang_ref --------\n node: %s\n len: %d\n " - "n[0]: %d\n n[1]: %d\n n[2]: %d\n creation: %d\n", - p->node, p->len, p->n[0], p->n[1], p->n[2], p->creation); -} - -static void print_term(ETERM *t) -{ - fprintf(stdout, "\nETERM --------\n"); - erl_print_term(stdout, t); - fprintf(stdout, "\n--------\n"); -} - -static void print_s(m_s *p) -{ - int i; - - fprintf(stdout, "\n%ld\n", p->l); - for (i = 0; i < p->sl._length; i++) - fprintf(stdout, "\n[%d]: %ld\n", i, p->sl._buffer[i]); -} - - -static void print_ssstr3(m_ssstr3 *b1) -{ - int i,j; - - fprintf(stdout, "\nSSSTR3 --------\n"); - fprintf(stdout,"b1->_length = %ld\n",b1->_length); - for (i = 0; i < b1->_length; i++) { - fprintf(stdout,"\nb1->_buffer[%d]._length %ld\n", - i, b1->_buffer[i]._length); - for (j = 0; j < b1->_buffer[i]._length; j++) - fprintf(stdout,"b1->_buffer[%d]._buffer[%d] = %s\n", - i, j, b1->_buffer[i]._buffer[j]); - } - fprintf(stdout, "\n--------\n"); -} - -static void print_wstr(CORBA_wchar *ws) -{ - int i = 0; - - fprintf(stdout, "\nwstr --------\n"); - while (ws[i]) { - fprintf(stdout, "[%d]: %ld\n", i, ws[i]); - i++; - } - fprintf(stdout, "\n--------\n"); -} - - -static void print_ssarr3(m_ssarr3 *b1) -{ - int i; - - fprintf(stdout, "\nssarr3 --------\n"); - fprintf(stdout,"length: %ld\n",b1->_length); - fprintf(stdout, "buffer:\n"); - for (i = 0; i < b1->_length; i++) - print_sarr3(&b1->_buffer[i]); - fprintf(stdout, "\n--------\n"); -} - -static void print_sarr3(m_sarr3 *b1) -{ - int i; - - fprintf(stdout, "\nsarr3 --------\n"); - fprintf(stdout,"length: %ld\n",b1->_length); - fprintf(stdout, "buffer:\n"); - for (i = 0; i < b1->_length; i++) - print_arr3(b1->_buffer[i]); - fprintf(stdout, "\n--------\n"); -} - -static void print_arr3(m_arr3 b1) -{ - int i; - - fprintf(stdout, "\narr3 --------\n"); - for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) - fprintf(stdout, "%ld ", b1[i]); - fprintf(stdout, "\n--------\n"); -} - -static void free_etseq_buf(m_etseq *b) -{ - int i; - - for (i = 0; i < b->_length; i++) - erl_free_term(b->_buffer[i]); -} - -static void free_et(m_et* b) -{ - erl_free_term(b->e); -} - -static void showtime(MyTimeval *start, MyTimeval *stop) -{ - MyTimeval elapsed; - - elapsed.tv_sec = stop->tv_sec - start->tv_sec; - elapsed.tv_usec = stop->tv_usec - start->tv_usec; - while (elapsed.tv_usec < 0) { - elapsed.tv_sec -= 1; - elapsed.tv_usec += 1000000; - } - fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec); -} - -static void my_gettimeofday(MyTimeval *tv) -#ifdef __WIN32__ -#define EPOCH_JULIAN_DIFF 11644473600i64 -{ - SYSTEMTIME t; - FILETIME ft; - LONGLONG lft; - - GetSystemTime(&t); - SystemTimeToFileTime(&t, &ft); - memcpy(&lft, &ft, sizeof(lft)); - tv->tv_usec = (long) ((lft / 10i64) % 1000000i64); - tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF); -} -#elif defined VXWORKS -{ - int rate = sysClkRateGet(); /* Ticks per second */ - unsigned long ctick = tickGet(); - tv->tv_sec = ctick / rate; /* secs since reboot */ - tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate; -} -#else -{ - gettimeofday(tv, NULL); -} -#endif diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_erl_test.idl b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_erl_test.idl deleted file mode 100644 index b6ba1583f3..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_erl_test.idl +++ /dev/null @@ -1,174 +0,0 @@ - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2003-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% - -#include "erlang.idl" - - -const short TestConst = 1; - -module m { - - const short TestConst = 2; - - struct b { - long l; - char c; - }; - - struct simple { - long l; - b b_t; - }; - - enum fruit {orange, banana, apple, peach, pear}; - - typedef sequence<long> lseq; - - typedef sequence<b> bseq; - - struct a { - long l; - bseq y; - double d; - }; - - typedef sequence<a> aseq; - - typedef sequence<string> sseq; - typedef string str; - typedef long myLong; - - typedef long arr1[500], dd[2][3]; - - typedef erlang::term apa; - typedef erlang::port banan; - - typedef sequence<erlang::term> etseq; - - struct s { - long l; - sequence<long> sl; - }; - - struct es { - fruit f; - myLong l; - }; - - struct et { - erlang::term e; - long l; - }; - - - typedef sequence<char> str1; - typedef string<12> str2; - typedef char str3[3]; - - typedef sequence<string> sstr3; // sequence of string - typedef sequence<sstr3> ssstr3; // sequence of sequences of strings - - typedef long arr3[3]; // array of long - typedef sequence<arr3> sarr3; // sequence of array - typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings - - struct strRec{ - boolean bb; - string str4; - long str7[3][2]; - sequence<char> str5; - string<12> str6; - str3 str8; - str2 str9; - str1 str10; - }; - - - struct dyn { - long l; - sequence<long> sl; - }; - typedef dyn arr2[1][2]; - - - interface i { - - const short TestConst = 3; - - //arr2 suck(in arr2 x, out arr2 y ); - - ///////////////////////////////// attribute long l; - - // simple types - void void_test(); - long long_test(in long a, out long a1); - long long longlong_test(in long long a, out long long a1); - unsigned short ushort_test(in unsigned short a, out unsigned short a1); - unsigned long ulong_test(in unsigned long a, out unsigned long a1); - unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1); - double double_test(in double a, out double a1); - char char_test(in char a, out char a1); - wchar wchar_test(in wchar a, out wchar a1); - octet octet_test(in octet a, out octet a1); - boolean bool_test(in boolean a, out boolean a1); - - // Seq. and struct tests - b struct_test(in b a, out b a1); - es struct2_test(in es a, out es a1); - //simple struct3_test(in simple x, out simple y); - bseq seq1_test(in bseq a, out bseq a1); - aseq seq2_test(in aseq a, out aseq a1); - lseq seq3_test(in lseq a, out lseq a1); - ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1); - ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1); - - // Array tests - arr1 array1_test(in arr1 a, out arr1 a1); - dd array2_test(in dd a, out dd a1); - - // enum test - fruit enum_test(in fruit a, out fruit a1); - - // string tests - string string1_test(in string a, out string a1); - wstring wstring1_test(in wstring a, out wstring a1); - sseq string2_test(in sseq a, out sseq a1); - str string3_test(in str a, out str a1); - strRec string4_test(in strRec a, out strRec a1); - - // Special erlang types - erlang::pid pid_test(in erlang::pid a, out erlang::pid a1); - erlang::port port_test(in erlang::port a, out erlang::port a1); - erlang::ref ref_test(in erlang::ref a, out erlang::ref a1); - erlang::term term_test(in erlang::term a, out erlang::term a1); - - // typedef test - long typedef_test(in apa a, in banan b, out apa a1, out banan b1); - - // inlined seq. test - s inline_sequence_test(in s a, out s a1); - - // term seq. test - etseq term_sequence_test(in etseq a, out etseq a1); - // term struct test - et term_struct_test(in et a, out et a1); - - }; - -}; diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/erl_server.erl b/lib/ic/test/c_client_erl_server_proto_SUITE_data/erl_server.erl deleted file mode 100644 index 2fe1dc2f79..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/erl_server.erl +++ /dev/null @@ -1,29 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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% -%% -%% --module(erl_server). - --export([run/0, stop/0]). - -run() -> - m_i:oe_create(). - -stop() -> - gen_server:cast(cidl_test, stop). diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/m_i_impl.erl b/lib/ic/test/c_client_erl_server_proto_SUITE_data/m_i_impl.erl deleted file mode 100644 index 92420eaeb4..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/m_i_impl.erl +++ /dev/null @@ -1,162 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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% -%% -%% --module(m_i_impl). --include("m.hrl"). - --export([init/1, terminate/2, void_test/1, long_test/2, ushort_test/2, - longlong_test/2, ulong_test/2, ulonglong_test/2, - double_test/2, char_test/2, wchar_test/2, octet_test/2, - bool_test/2, struct_test/2, struct2_test/2, seq1_test/2, - seq2_test/2, seq3_test/2, seq4_test/2, seq5_test/2, - array1_test/2, array2_test/2, enum_test/2, string1_test/2, - string2_test/2, string3_test/2, string4_test/2, pid_test/2, - port_test/2, ref_test/2, term_test/2, typedef_test/3, - inline_sequence_test/2, '_set_l'/2, '_get_l'/1, - term_struct_test/2, term_sequence_test/2, wstring1_test/2]). - --define(PRINTDEBUG(Case), - io:format("erl_server: case: ~p~n" - "erl_server: location: ~p~n", [Case, [?FILE, ?LINE]])). --define(PRINTDEBUG2(Case, Msg), - io:format("erl_server: case: ~p~n" - "erl_server: Msg: ~p~n" - "erl_server: location: ~p~n", [Case, Msg, [?FILE, ?LINE]])). - -init(Env) -> - {ok, []}. - -terminate(F, R) -> - ok. - -'_get_l'(State) -> - ?PRINTDEBUG("_get_l"), - {reply, State, State}. -void_test(State) -> - ?PRINTDEBUG("void_test"), - {reply, ok, State}. - -'_set_l'(State, V) -> - ?PRINTDEBUG2("_set_l", V), - {reply, ok, V}. -ushort_test(State, V) -> - ?PRINTDEBUG2("ushort_test", V), - {reply, {V, V}, State}. -long_test(State, V) -> - ?PRINTDEBUG2("long_test", V), - {reply, {V, V}, State}. -longlong_test(State, V) -> - ?PRINTDEBUG2("longlong_test", V), - {reply, {V, V}, State}. -ulong_test(State, V) -> - ?PRINTDEBUG2("ulong_test", V), - {reply, {V, V}, State}. -ulonglong_test(State, V) -> - ?PRINTDEBUG2("ulonglong_test", V), - {reply, {V, V}, State}. -double_test(State, V) -> - ?PRINTDEBUG2("double_test", V), - {reply, {V, V}, State}. -char_test(State, V) -> - ?PRINTDEBUG2("char_test", V), - {reply, {V, V}, State}. -wchar_test(State, V) -> - ?PRINTDEBUG2("wchar_test", V), - {reply, {V, V}, State}. -octet_test(State, V) -> - ?PRINTDEBUG2("octet_test", V), - {reply, {V, V}, State}. -bool_test(State, V) -> - ?PRINTDEBUG2("bool_test", V), - {reply, {V, V}, State}. - -struct_test(State, V) -> - ?PRINTDEBUG2("struct_test", V), - {reply, {V, V}, State}. -struct2_test(State, V) -> - ?PRINTDEBUG2("struct2_test", V), - {reply, {V, V}, State}. -seq1_test(State, V) -> - ?PRINTDEBUG2("seq1_test", V), - {reply, {V, V}, State}. -seq2_test(State, V) -> - ?PRINTDEBUG2("seq2_test", V), - {reply, {V, V}, State}. -seq3_test(State, V) -> - ?PRINTDEBUG2("seq3_test", V), - {reply, {V, V}, State}. -seq4_test(State, V) -> - ?PRINTDEBUG2("seq4_test", V), - {reply, {V, V}, State}. -seq5_test(State, V) -> - ?PRINTDEBUG2("seq5_test", V), - {reply, {V, V}, State}. -array1_test(State, V) -> - ?PRINTDEBUG2("array1_test", V), - {reply, {V, V}, State}. -array2_test(State, V) -> - ?PRINTDEBUG2("array2_test", V), - {reply, {V, V}, State}. -enum_test(State, V) -> - ?PRINTDEBUG2("enum_test", V), - {reply, {V, V}, State}. -string1_test(State, V) -> - ?PRINTDEBUG2("string1_test", V), - {reply, {V, V}, State}. -string2_test(State, V) -> - ?PRINTDEBUG2("string2_test", V), - {reply, {V, V}, State}. -string3_test(State, V) -> - ?PRINTDEBUG2("string3_test", V), - {reply, {V, V}, State}. -string4_test(State, V) -> - ?PRINTDEBUG2("string4_test", V), - {reply, {V, V}, State}. -pid_test(State, V) -> - ?PRINTDEBUG2("pid_test", V), - {reply, {V, V}, State}. -port_test(State, V) -> - ?PRINTDEBUG2("port_test", binary_to_list(term_to_binary(V))), - {reply, {V, V}, State}. -ref_test(State, V) -> - ?PRINTDEBUG2("ref_test", binary_to_list(term_to_binary(V))), - {reply, {V, V}, State}. -term_test(State, V) -> - ?PRINTDEBUG2("term_test", V), - {reply, {V, V}, State}. -typedef_test(State, A, B) -> - ?PRINTDEBUG2("typedef_test", [A,B]), - {reply, {4711, A, B}, State}. -inline_sequence_test(State, V) -> - ?PRINTDEBUG2("inline_sequence_test", V), - {reply, {V, V}, State}. -term_sequence_test(State, V) -> - ?PRINTDEBUG2("term_sequence_test", V), - {reply, {V, V}, State}. -term_struct_test(State, V) -> - ?PRINTDEBUG2("term_struct_test", V), - {reply, {V, V}, State}. -wstring1_test(State, V) -> - ?PRINTDEBUG2("wstring1_test", V), - {reply, {V, V}, State}. - - - - diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/my.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/my.c deleted file mode 100644 index 46920ce05f..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/my.c +++ /dev/null @@ -1,51 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-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% - * - */ - -#include "ic.h" -#include "m_i.h" - -int my_prepare_notification_encoding(CORBA_Environment *env) -{ - return oe_prepare_notification_encoding(env); -} - -int my_send_notification(CORBA_Environment *env) -{ - return oe_send_notification(env); -} - -int my_prepare_request_encoding(CORBA_Environment *env) -{ - return oe_prepare_request_encoding(env); -} - -int my_send_request_and_receive_reply(CORBA_Environment *env) -{ - return oe_send_request_and_receive_reply(env); -} - -int my_prepare_reply_decoding(CORBA_Environment *env) -{ - return oe_prepare_reply_decoding(env); -} - - - diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE.erl b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE.erl deleted file mode 100644 index 334db7c1da..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE.erl +++ /dev/null @@ -1,265 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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 c-client/erl-server -%%---------------------------------------------------------------------- - --module(c_client_erl_server_proto_tmo_SUITE). --include_lib("common_test/include/ct.hrl"). - --export([init_per_testcase/2, end_per_testcase/2, - all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - void_test/1, long_test/1, long_long_test/1, - unsigned_short_test/1, unsigned_long_test/1, - unsigned_long_long_test/1, double_test/1, char_test/1, - wchar_test/1, octet_test/1, bool_test/1, struct_test/1, - struct2_test/1, seq1_test/1, seq2_test/1, seq3_test/1, - seq4_test/1, seq5_test/1, array1_test/1, array2_test/1, - enum_test/1, string1_test/1, string2_test/1, string3_test/1, - string4_test/1, pid_test/1, port_test/1, ref_test/1, term_test/1, - typedef_test/1, inline_sequence_test/1, term_sequence_test/1, - term_struct_test/1, wstring1_test/1]). - --define(DEFAULT_TIMEOUT, 20000). --define(PORT_TIMEOUT, 15000). --define(ERLANG_SERVER_NAME, idl_erlang_server). --define(C_CLIENT_NODE_NAME, c_client_idl_test). - -%% Add/remove code path and watchdog before/after each test case. -%% -init_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:add_patha(DataDir), - - %% Since other test suites use the module m_i, we have - %% to make sure we are using the right m_i module. - code:purge(m_i), - code:load_file(m_i), - - WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:del_path(DataDir), - WatchDog = proplists:get_value(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [void_test, long_test, long_long_test, - unsigned_short_test, unsigned_long_test, - unsigned_long_long_test, double_test, char_test, - wchar_test, octet_test, bool_test, struct_test, - struct2_test, seq1_test, seq2_test, seq3_test, - seq4_test, seq5_test, array1_test, array2_test, - enum_test, string1_test, string2_test, string3_test, - string4_test, pid_test, port_test, ref_test, term_test, - typedef_test, inline_sequence_test, term_sequence_test, - term_struct_test, wstring1_test]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -array1_test(Config) -> - do_test(array1_test, Config). - -array2_test(Config) -> - do_test(array2_test, Config). - -bool_test(Config) -> - do_test(bool_test, Config). - -char_test(Config) -> - do_test(char_test, Config). - -double_test(Config) -> - do_test(double_test, Config). - -enum_test(Config) -> - do_test(enum_test, Config). - -inline_sequence_test(Config) -> - do_test(inline_sequence_test, Config). - -long_long_test(Config) -> - do_test(long_long_test, Config). - -long_test(Config) -> - do_test(long_test, Config). - -octet_test(Config) -> - do_test(octet_test, Config). - -pid_test(Config) -> - do_test(pid_test, Config). - -port_test(Config) -> - do_test(port_test, Config). - -ref_test(Config) -> - do_test(ref_test, Config). - -seq1_test(Config) -> - do_test(seq1_test, Config). - -seq2_test(Config) -> - do_test(seq2_test, Config). - -seq3_test(Config) -> - do_test(seq3_test, Config). - -seq4_test(Config) -> - do_test(seq4_test, Config). - -seq5_test(Config) -> - do_test(seq5_test, Config). - -string1_test(Config) -> - do_test(string1_test, Config). - -string2_test(Config) -> - do_test(string2_test, Config). - -string3_test(Config) -> - do_test(string3_test, Config). - -string4_test(Config) -> - do_test(string4_test, Config). - -struct2_test(Config) -> - do_test(struct2_test, Config). - -struct_test(Config) -> - do_test(struct_test, Config). - -term_sequence_test(Config) -> - do_test(term_sequence_test, Config). - -term_struct_test(Config) -> - do_test(term_struct_test, Config). - -term_test(Config) -> - do_test(term_test, Config). - -typedef_test(Config) -> - do_test(typedef_test, Config). - -unsigned_long_long_test(Config) -> - do_test(unsigned_long_long_test, Config). - -unsigned_long_test(Config) -> - do_test(unsigned_long_test, Config). - -unsigned_short_test(Config) -> - do_test(unsigned_short_test, Config). - -void_test(Config) -> - do_test(void_test, Config). - -wchar_test(Config) -> - do_test(wchar_test, Config). - -wstring1_test(Config) -> - do_test(wstring1_test, Config). - - -%% It is here that all tests really are done. -%% - -do_test(Case, Config) -> - %% Trap exits - process_flag(trap_exit, true), - %% Start the server - {ok, _Pid} = m_i:oe_create_link([], {local, ?ERLANG_SERVER_NAME}), - Node = atom_to_list(node()), - %% [NodeName, HostName] = string:tokens(Node, "@"), - DataDir = proplists:get_value(data_dir, Config), - %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]), - Cookie = atom_to_list(erlang:get_cookie()), - %% Start C-client node as a port program. - Cmd = filename:join([DataDir, "c_client"]) ++ - " -this-node-name " ++ atom_to_list(?C_CLIENT_NODE_NAME) ++ - " -peer-node " ++ Node ++ - " -peer-process-name " ++ atom_to_list(?ERLANG_SERVER_NAME) ++ - " -cookie " ++ Cookie ++ - " -test-case " ++ atom_to_list(Case), - Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]), - Res = wait_for_completion(Port), - %% Kill off node if there was timeout - case Res of - {error, timeout} -> - catch rpc:cast(?C_CLIENT_NODE_NAME, erlang, halt, [1]); - _ -> - ok - end, - process_flag(trap_exit, false), - catch m_i:stop(?ERLANG_SERVER_NAME), - ok = Res. - - -%% Wait for eof *and* exit status, but return if exit status indicates -%% an error, or we have been waiting more than PORT_TIMEOUT seconds. -%% -wait_for_completion(Port) -> - wait_for_completion(Port, 0). - -wait_for_completion(Port, N) when N < 2 -> - receive - {Port, {data, Bytes}} -> - %% Relay output - io:format("~s", [Bytes]), - wait_for_completion(Port, N); - {Port, {exit_status, 0}} -> - wait_for_completion(Port, N + 1); - {Port, {exit_status, Status}} -> - {error, Status}; - {Port, eof} -> - wait_for_completion(Port, N + 1); - {'EXIT', Port, Reason} -> - io:format("Port exited with reason: ~w~n", [Reason]), - wait_for_completion(Port, N); - {'EXIT', From, Reason} -> - io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]), - wait_for_completion(Port, N) - after ?PORT_TIMEOUT -> - {error, timeout} - end; -wait_for_completion(_, _) -> - ok. - - - diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/Makefile.src b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/Makefile.src deleted file mode 100644 index 6d6bd9baab..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/Makefile.src +++ /dev/null @@ -1,155 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2004-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% -# -# -# Makefile.src for c_client_erl_server test -# Note: This file *must* work for both Unix and Windows -# -# We use both `rm' (Unix) and `del' (Windows) for removing files, but -# with a `-' in front so that the error in not finding `rm' (`del') on -# Windows (Unix) is ignored. -# -# VxWorks? XXX -# - -.SUFFIXES: -.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@ - - -# Variables from ts: -# - -ERL_INCLUDE = @erl_include@ - -IC_INCLUDE_PATH = @ic_include_path@ -IC_LIB = @ic_lib@ - -ERL_INTERFACE_INCLUDE = @erl_interface_include@ -ERL_INTERFACE_LIB = @erl_interface_lib@ -ERL_INTERFACE_EILIB = @erl_interface_eilib@ -ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@ -ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@ - -CC = @CC@ -## XXX Should set warning flag with a DEBUG_FLAG -CFLAGS = @CFLAGS@ @DEFS@ -I@erl_include@ \ - -I@ic_include_path@ -I@erl_interface_include@ - -LD = @LD@ -LDFLAGS = @CROSSLDFLAGS@ -LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \ - $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS) -ERLC = erlc - -# Generated C header files -GEN_H_FILES = \ - m.h \ - m_i.h \ - oe_c_erl_test.h - -# Generated C files -GEN_C_FILES = \ - m.c \ - m_i.c \ - oe_c_erl_test.c \ - oe_code_m_a.c \ - oe_code_m_arr1.c \ - oe_code_m_arr2.c \ - oe_code_m_arr3.c \ - oe_code_m_aseq.c \ - oe_code_m_b.c \ - oe_code_m_bseq.c \ - oe_code_m_dd.c \ - oe_code_m_dyn.c \ - oe_code_m_dyn_sl.c \ - oe_code_m_es.c \ - oe_code_m_et.c \ - oe_code_m_etseq.c \ - oe_code_m_fruit.c \ - oe_code_m_lseq.c \ - oe_code_m_s.c \ - oe_code_m_s_sl.c \ - oe_code_m_sarr3.c \ - oe_code_m_simple.c \ - oe_code_m_ssarr3.c \ - oe_code_m_sseq.c \ - oe_code_m_ssstr3.c \ - oe_code_m_sstr3.c \ - oe_code_m_str1.c \ - oe_code_m_str3.c \ - oe_code_m_strRec.c \ - oe_code_m_strRec_str5.c \ - oe_code_m_strRec_str7.c - -GEN_HRL_FILES = \ - m.hrl \ - m_i.hrl \ - oe_c_erl_test.hrl - -GEN_ERL_FILES = \ - m.erl \ - m_arr2.erl \ - m_arr3.erl \ - m_i.erl \ - m_str3.erl \ - oe_c_erl_test.erl - -C_FILES = $(GEN_C_FILES) c_client.c my.c - -OBJS = $(C_FILES:.c=@obj@) - -PGMS = c_client@exe@ - -ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl - -EBINS = $(ERL_FILES:.erl=.@EMULATOR@) - - -all: $(PGMS) $(EBINS) - -$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl -$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c -$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES) -$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES) - -clean: - -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -$(PGMS): $(OBJS) - $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS) - -c_erl_test.built_c: c_erl_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_client}" c_erl_test.idl - echo done > c_erl_test.built_c - -c_erl_test.built_erl: c_erl_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" c_erl_test.idl - echo done > c_erl_test.built_erl - -.c@obj@: - $(CC) -c -o $*@obj@ $(CFLAGS) $< - -.erl.@EMULATOR@: - $(ERLC) -I $(IC_INCLUDE_PATH) $< - diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c deleted file mode 100644 index 17ef21f4f4..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c +++ /dev/null @@ -1,1764 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-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% - * - */ -/* C-client for test of IC. - * - * TODO: - * - * 1. XXX #includes for VxWorks, Windows - */ - -#include <stdio.h> -#include <stdlib.h> - -#ifndef __WIN32__ -# include <unistd.h> -#endif - -#include <string.h> - -#ifdef __WIN32__ -# include <time.h> -# include <sys/timeb.h> -#elif defined VXWORKS -#include <time.h> -#include <sys/times.h> -#else -#include <sys/time.h> -#endif - -#include <ctype.h> - -#ifdef __WIN32__ -# include <winsock2.h> -# include <windows.h> -#else -# include <sys/types.h> -# include <sys/socket.h> -# include <netinet/in.h> -# include <arpa/inet.h> -# include <netdb.h> -#endif - -#include "ei.h" -#include "erl_interface.h" -#include "m_i.h" - -#define HOSTNAMESZ 255 -#define NODENAMESZ 512 - -#define INBUFSZ 10 -#define OUTBUFSZ 0 - -#define MAXTRIES 5 - -#define CHECK_EXCEPTION(x) \ - if ((x)->_major != CORBA_NO_EXCEPTION) { \ - fprintf(stderr,"\n\nException: %s\n\n", \ - (char *)CORBA_exception_value((x))); \ - CORBA_exception_free((x)); \ - return -1; \ - } \ - -/* XXX Should free things here too! */ -#define RETURN_IF_OK(x) \ - if ((x)) {\ - fprintf(stdout, "ok\n");\ - return 0;\ - }\ - -#define cmp_str(x,y) (!strcmp((x),(y))) -#define cmp_wstr(x,y) (!ic_wstrcmp((x),(y))) - -typedef CORBA_Environment IC_Env; - -typedef int (*TestFunc)(IC_Env *); -typedef struct { - char *name; - TestFunc func; -} TestCase; - -static char longtext[] = -"Introduction The IC application is an IDL compiler implemented in Erlang." -" The IDL compiler generates client stubs and server skeletons." -" Several back-ends are supported, and they fall into three main groups." -" For more details on IC compiler options consult the ic(3) manual page." -" Argument passing cases 1 Caller allocates all necessary storage," -" except that which may be encapsulated and managed within the parameter itself." -" 2 The caller allocates a pointer and passes it by reference to the callee." -" The callee sets the pointer to point to a valid instance of the parameter's type." -" The caller is responsible for releasing the returned storage." -" Following completion of a request, the caller is not allowed to modify any values" -" in the returned storage. To do so the caller must first copy the returned instance" -" into a new instance, then modify the new instance. 3 The caller allocates a" -" pointer to an array slice which has all the same dimensions of the original" -" array except the first, and passes it by reference to the callee. The callee sets" -" the pointer to point to a valid instance of the array. The caller is responsible for" -" releasing the returned storage. Following completion of a request, the caller is not" -" allowed to modify any values in the returned storage. To do so the caller must first" -" copy the returned instance into a new instance, then modify the new instance." -" Generated Files Two files will be generated for each scope. One set of files will be" -" generated for each module and each interface scope. An extra set is generated for" -" those definitions at top level scope. One of the files is a header file(.h), and the" -" other file is a C source code file (.c). In addition to these files a number of C" -" source files will be generated for type encodings, they are named according to the " -"following template: oe_code_<type>.c."; -static char this_node[NODENAMESZ + 1]; -static char *progname; - -/* Test function prototypes */ - -static int void_test(IC_Env *env); -static int long_test(IC_Env *env); -static int long_long_test(IC_Env *env); -static int unsigned_short_test(IC_Env *env); -static int unsigned_long_test(IC_Env *env); -static int unsigned_long_long_test(IC_Env *env); -static int double_test(IC_Env *env); -static int char_test(IC_Env *env); -static int wchar_test(IC_Env *env); -static int octet_test(IC_Env *env); -static int bool_test(IC_Env *env); -static int struct_test(IC_Env *env); -static int struct2_test(IC_Env *env); -static int seq1_test(IC_Env *env); -static int seq2_test(IC_Env *env); -static int seq3_test(IC_Env *env); -static int seq4_test(IC_Env *env); -static int seq5_test(IC_Env *env); -static int array1_test(IC_Env *env); -static int array2_test(IC_Env *env); -static int enum_test(IC_Env *env); -static int string1_test(IC_Env *env); -static int string2_test(IC_Env *env); -static int string3_test(IC_Env *env); -static int string4_test(IC_Env *env); -static int pid_test(IC_Env *env); -static int port_test(IC_Env *env); -static int ref_test(IC_Env *env); -static int term_test(IC_Env *env); -static int typedef_test(IC_Env *env); -static int inline_sequence_test(IC_Env *env); -static int term_sequence_test(IC_Env *env); -static int term_struct_test(IC_Env *env); -static int wstring1_test(IC_Env *env); - -static TestCase test_cases[] = { - {"void_test", void_test}, - {"long_test", long_test}, - {"long_long_test", long_long_test}, - {"unsigned_short_test", unsigned_short_test}, - {"unsigned_long_test", unsigned_long_test}, - {"unsigned_long_long_test", unsigned_long_long_test}, - {"double_test", double_test}, - {"char_test", char_test}, - {"wchar_test", wchar_test}, - {"octet_test", octet_test}, - {"bool_test", bool_test}, - {"struct_test", struct_test}, - {"struct2_test", struct2_test}, - {"seq1_test", seq1_test}, - {"seq2_test", seq2_test}, - {"seq3_test", seq3_test}, - {"seq4_test", seq4_test}, - {"seq5_test", seq5_test}, - {"array1_test", array1_test}, - {"array2_test", array2_test}, - {"enum_test", enum_test}, - {"string1_test", string1_test}, - {"string2_test", string2_test}, - {"string3_test", string3_test}, - {"string4_test", string4_test}, - {"pid_test", pid_test}, - {"port_test", port_test}, - {"ref_test", ref_test}, - {"term_test", term_test}, - {"typedef_test", typedef_test}, - {"inline_sequence_test", inline_sequence_test}, - {"term_sequence_test", term_sequence_test}, - {"term_struct_test", term_struct_test}, - {"wstring1_test", wstring1_test}, - {"", NULL} -}; - -/* Other prototypes */ -static int cmp_aseq(m_aseq *a1, m_aseq *a2); -static int cmp_a(m_a *a1, m_a *a2); -static int cmp_bseq(m_bseq *b1, m_bseq *b2); -static int cmp_b(m_b *b1, m_b *b2); -static int cmp_lseq(m_lseq *b1, m_lseq *b2); -static int cmp_etseq(m_etseq *b1, m_etseq *b2); -static int cmp_et(m_et* b1, m_et *b2); -static int cmp_es(m_es *b1, m_es *b2); -static int cmp_arr1(m_arr1 b1, m_arr1 b2); -static int cmp_dd(m_dd b1, m_dd b2); -static int cmp_strRec(m_strRec *b1, m_strRec *b2); -static int cmp_sseq(m_sseq *b1, m_sseq *b2); -static int cmp_pid(erlang_pid *p1, erlang_pid *p2); -static int cmp_port(erlang_port *p1, erlang_port *p2); -static int cmp_ref(erlang_ref *p1, erlang_ref *p2); -static int cmp_s(m_s *b1, m_s *b2); -static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2); -static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2); -static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2); -static int cmp_arr3(m_arr3 b1, m_arr3 b2); - -static void print_aseq(m_aseq *a); -static void print_a(m_a *a); -static void print_bseq(m_bseq *b); -static void print_lseq(m_lseq *b); -static void print_b(m_b *b); -static void print_etseq(m_etseq *b); -static void print_et(m_et* b); -static void print_es(m_es *b); -static void print_arr1(long a[500]); -static void print_dd(long a[2][3]); -static void print_strRec(m_strRec* sr); -static void print_sseq(m_sseq *b); -static void print_pid(erlang_pid *p); -static void print_port(erlang_port *p); -static void print_ref(erlang_ref *p); -static void print_term(ETERM *t); -static void print_s(m_s *p); -static void print_ssstr3(m_ssstr3 *b1); -static void print_ssarr3(m_ssarr3 *b1); -static void print_sarr3(m_sarr3 *b1); -static void print_arr3(m_arr3 b1); -static void print_wstr(CORBA_wchar *ws); - -static void free_etseq_buf(m_etseq *b); -static void free_et(m_et* b); - -#ifdef __WIN32__ -typedef struct { - long tv_sec; - long tv_usec; -} MyTimeval; -#else -typedef struct timeval MyTimeval; -#endif -static void my_gettimeofday(MyTimeval *tv); -static void showtime(MyTimeval *start, MyTimeval *stop); -static void usage(void); -static void done(int r); - - - -/* main */ - -#ifdef VXWORKS -int client(int argc, char **argv) -#else -int main(int argc, char **argv) -#endif -{ - struct hostent *hp; - erlang_pid pid; - MyTimeval start, stop; - int i, fd, ires, tres; - IC_Env *env; - int tries = 0; - char *this_node_name = NULL; - char *peer_node = NULL; - char *peer_process_name = NULL; - char *cookie = NULL; - char host[HOSTNAMESZ + 1]; - TestFunc test_func = NULL; - TestCase *test_case; - char *test_case_name = NULL; - -#ifdef __WIN32__ - WORD wVersionRequested; - WSADATA wsaData; - - wVersionRequested = MAKEWORD(2, 0); - - if (WSAStartup(wVersionRequested, &wsaData) != 0) { - fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL"); - exit(1); - } -#endif - - progname = argv[0]; - host[HOSTNAMESZ] = '\0'; - if (gethostname(host, HOSTNAMESZ + 1) < 0) { - fprintf(stderr, "Can't find own hostname\n"); - done(1); - } - if ((hp = gethostbyname(host)) == 0) { - fprintf(stderr, "Can't get ip address for host %s\n", host); - done(1); - } - for (i = 1; i < argc; i++) { - if (cmp_str(argv[i], "-help")) { - usage(); - done(0); - } else if (cmp_str(argv[i], "-this-node-name")) { - i++; - this_node_name = argv[i]; - } else if (cmp_str(argv[i], "-peer-node")) { - i++; - peer_node = argv[i]; - } else if (cmp_str(argv[i], "-peer-process-name")) { - i++; - peer_process_name = argv[i]; - } else if (cmp_str(argv[i], "-cookie")) { - i++; - cookie = argv[i]; - } else if (cmp_str(argv[i], "-test-case")) { - i++; - test_case_name = argv[i]; - } else { - fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]); - usage(); - done(1); - } - } - - if (this_node_name == NULL || peer_node == NULL || test_case_name == NULL - || peer_process_name == NULL || cookie == NULL) { - fprintf(stderr, "Error: missing option\n"); - usage(); - done(1); - } - - test_case = test_cases; - while (test_case->func) { - if (cmp_str(test_case->name, test_case_name)) { - test_func = test_case->func; - break; - } - test_case++; - } - if (test_func == NULL) { - fprintf(stderr, "Error: illegal test case: \"%s\"\n", test_case_name); - done(1); - } - - /* Behead hostname at first dot */ - for (i=0; host[i] != '\0'; i++) { - if (host[i] == '.') { host[i] = '\0'; break; } - } - sprintf(this_node, "%s@%s", this_node_name, host); - fprintf(stderr, "c_client: this node: \"%s\"\n", this_node); - fprintf(stderr, "c_client: peer node: \"%s\"\n", peer_node); - fprintf(stderr, "c_client: test case: \"%s\"\n", test_case_name); - - fprintf(stderr, "c_client: starting\n"); - - /* initialize erl_interface */ - erl_init(NULL, 0); - - for (tries = 0; tries < MAXTRIES; tries++) { - - /* connect to erlang node */ - - ires = erl_connect_xinit(host, this_node_name, this_node, - (struct in_addr *)*hp->h_addr_list, - cookie, 0); - - fprintf(stderr, "c_client: erl_connect_xinit(): %d\n", ires); - - fd = erl_connect(peer_node); - fprintf(stderr, "c_client: erl_connect(): %d\n", fd); - - if (fd >= 0) - break; - fprintf(stderr, "c_client: cannot connect, retrying\n"); - } - if (fd < 0) { - fprintf(stderr, "c_client: cannot connect, exiting\n"); - done(1); - } - env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ); - env->_fd = fd; - strcpy(env->_regname, peer_process_name); - env->_to_pid = NULL; - env->_from_pid = &pid; - - strcpy(pid.node, this_node); - pid.num = fd; - pid.serial = 0; - pid.creation = 0; - - my_gettimeofday(&start); - tres = test_func(env); /* Call test case */ - my_gettimeofday(&stop); - showtime(&start, &stop); - erl_close_connection(fd); - - printf("c_client: env->_inbuf before : %d\n", INBUFSZ); - printf("c_client: env->_outbuf before : %d\n", OUTBUFSZ); - printf("c_client: env->_inbuf after : %d\n", env->_inbufsz); - printf("c_client: env->_outbuf after : %d\n", env->_outbufsz); - - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - done(tres); -} - -static void usage() -{ - fprintf(stderr, "Usage: %s [-help] -this-node-name <name> " - "-peer-node <nodename> -peer-process-name <name> " - "-cookie <cookie> -test-case <test case name>\n", progname); - fprintf(stderr, "Example:\n %s -this-node-name kalle " - "-peer-node olle@home -peer-process-name idltest " - "-cookie oa678er -test-case octet_test\n", progname); -} - -static void done(int r) -{ -#ifdef __WIN32__ - WSACleanup(); -#endif - exit(r); -} - - -/* TESTS */ - -static int void_test(IC_Env *env) -{ - fprintf(stdout, "\n======== m_i_void test ======\n\n"); - m_i_void_test(NULL,env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(1); -} - -static int long_test(IC_Env *env) -{ - long l = 4711, lo, lr; - - fprintf(stdout, "\n======== m_i_long test ======\n\n"); - lr = m_i_long_test(NULL, l, &lo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(l == lo && l == lr); - if (l != lo) - fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", l, lo); - if (l != lr) - fprintf(stdout, " result error, sent: %ld, got: %ld\n", l, lr); - return -1; -} - -static int long_long_test(IC_Env *env) -{ - CORBA_long_long ll = 4711, llo, llr; - - fprintf(stdout, "\n======== m_i_longlong test ======\n\n"); - llr = m_i_longlong_test(NULL, ll, &llo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ll == llo && ll == llr); - if (ll != llo) - fprintf(stdout, " out parameter error, sent: %ld, got: %ld\n", - ll, llo); - if (ll != llr) - fprintf(stdout, " result error, sent: %ld, got: %ld\n", ll, llr); - return -1; -} - -static int unsigned_short_test(IC_Env *env) -{ - unsigned short x, y = 2, z; - - fprintf(stdout, "\n======== m_i_ushort test ======\n\n"); - x = m_i_ushort_test(NULL, y, &z, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(y == z && y == x); - if (y != z) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", y, z); - if (y != x) - fprintf(stdout, " result error, sent: %d, got: %d\n", y, x); - return -1; -} - - -static int unsigned_long_test(IC_Env *env) -{ - unsigned long ul = 5050, ulo, ulr; - - fprintf(stdout, "\n======== m_i_ulong test ======\n\n"); - ulr = m_i_ulong_test(NULL, ul, &ulo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ul == ulo && ul == ulr); - if (ul != ulo) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - ul, ulo); - if (ul != ulr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", ul, ulr); - return -1; -} - -/* - * Note: CORBA_unsigned_long_long is in fact a plain long. - */ -static int unsigned_long_long_test(IC_Env *env) -{ - CORBA_unsigned_long_long ull = 5050, ullo, ullr; - - fprintf(stdout, "\n======== m_i_ulonglong test ======\n\n"); - ullr = m_i_ulonglong_test(NULL, ull, &ullo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ull == ullo && ull == ullr); - if (ull != ullo) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - ull, ullo); - if (ull != ullr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", - ull, ullr); - return -1; -} - -static int double_test(IC_Env *env) -{ - double d = 12.1212, db, dr; - - fprintf(stdout, "\n======== m_i_double test ======\n\n"); - dr = m_i_double_test(NULL, d, &db, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(d == db && d == dr); - if (d != db) - fprintf(stdout, " out parameter error, sent: %f, got: %f\n", d, db); - if (d != dr) - fprintf(stdout, " result error, sent: %f, got: %f\n", d, dr); - return -1; -} - -static int char_test(IC_Env *env) -{ - char c = 'g', co, cr; - - /* char test */ - fprintf(stdout, "\n======== m_i_char test ======\n\n"); - cr = m_i_char_test(NULL, c, &co, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(c == co && c == cr); - if (c !=co) - fprintf(stdout, " out parameter error, sent: %c, got: %c\n", c, co); - if (c != cr) - fprintf(stdout, " result error, sent: %c, got: %c\n", c, cr); - return -1; -} - -static int wchar_test(IC_Env *env) -{ - CORBA_wchar wc = 103, wco, wcr; - - fprintf(stdout, "\n======== m_i_wchar test ======\n\n"); - wcr = m_i_wchar_test(NULL, wc, &wco, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(wc == wco && wc == wcr); - if (wc != wco) - fprintf(stdout, " out parameter error, sent: %lu, got: %lu\n", - wc, wco); - if (wc != wcr) - fprintf(stdout, " result error, sent: %lu, got: %lu\n", - wc, wcr); - return -1; -} - -static int octet_test(IC_Env *env) -{ - char o ='r', oo, or; - - fprintf(stdout, "\n======== m_i_octet test ======\n\n"); - or = m_i_octet_test(NULL, o, &oo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(o == oo && o == or); - if (o != oo) - fprintf(stdout, " out parameter error, sent: %c, got: %c\n", o, oo); - if (o != or) - fprintf(stdout, " result error, sent: %c, got: %c\n", o, or); - return -1; -} - -static int bool_test(IC_Env *env) -{ - unsigned char i = 0, io, ir; - - fprintf(stdout, "\n======== m_i_bool test ======\n\n"); - ir = m_i_bool_test(NULL, i, &io, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(i == io && i == ir); - if (i != io) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", i, io); - if (i != ir) - fprintf(stdout, " result error, sent: %d, got: %d\n", i, ir); - return -1; -} - -static int struct_test(IC_Env *env) -{ - m_b b = {4711, 'a'}, bo, br; - - fprintf(stdout, "\n======== m_i_struct test ======\n\n"); - br = m_i_struct_test(NULL, &b, &bo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_b(&b, &bo) && cmp_b(&b, &br)); - if (!cmp_b(&b, &bo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_b(&b); - fprintf(stdout, " got:\n"); - print_b(&bo); - fprintf(stdout, "\n"); - } - if (!cmp_b(&b, &br)) { - fprintf(stdout, " result error, sent:\n"); - print_b(&b); - fprintf(stdout, " got:\n"); - print_b(&br); - fprintf(stdout, "\n"); - } - return -1; -} - -static int struct2_test(IC_Env *env) -{ - m_es esi = {m_peach, 5050}, eso, esr; - - fprintf(stdout, "\n======== m_i_struct2 test ======\n\n"); - esr = m_i_struct2_test(NULL, &esi, &eso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_es(&esi, &eso) && cmp_es(&esi, &esr)); - if (!cmp_es(&esi, &eso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_es(&esi); - fprintf(stdout, " got:\n"); - print_es(&eso); - fprintf(stdout, "\n"); - } - if (!cmp_es(&esi, &esr)) { - fprintf(stdout, " result error, sent:\n"); - print_es(&esi); - fprintf(stdout, " got:\n"); - print_es(&esr); - fprintf(stdout, "\n"); - } - return -1; -} - - -static int seq1_test(IC_Env *env) -{ - m_bseq bs, *bso, *bsr; - - m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}}; - bs._length = 3; - bs._buffer = ba; - - fprintf(stdout, "\n======== m_i_seq1 test ======\n\n"); - bsr = m_i_seq1_test(NULL, &bs, &bso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_bseq(&bs, bso) && cmp_bseq(&bs, bsr)); - if (!cmp_bseq(&bs, bso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_bseq(&bs); - fprintf(stdout, " got:\n"); - print_bseq(bso); - fprintf(stdout, "\n"); - } - if (!cmp_bseq(&bs, bsr)) { - fprintf(stdout, " result error, sent:\n"); - print_bseq(&bs); - fprintf(stdout, " got:\n"); - print_bseq(bsr); - fprintf(stdout, "\n"); - } - CORBA_free(bso); - CORBA_free(bsr); - return -1; -} - -static int seq2_test(IC_Env *env) -{ - m_b ba[3] = {{4711, 'a'}, {4712, 'b'}, {4713, 'c'}}; - m_a a; - m_a aa[2]; - m_aseq as, *aso, *asr; - - a.l = 9999; - a.y._length = 3; - a.y._buffer = ba; - a.d = 66.89898989; - - aa[0] = a; - aa[1] = a; - as._length = 2; - as._buffer = aa; - - fprintf(stdout, "\n======== m_i_seq2 test ======\n\n"); - asr = m_i_seq2_test(NULL, &as, &aso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_aseq(&as, aso) && cmp_aseq(&as, asr)); - if (!cmp_aseq(&as, aso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_aseq(&as); - fprintf(stdout, " got:\n"); - print_aseq(aso); - fprintf(stdout, "\n"); - } - if (!cmp_aseq(&as, asr)) { - fprintf(stdout, " result error, sent:\n"); - print_aseq(&as); - fprintf(stdout, " got:\n"); - print_aseq(asr); - fprintf(stdout, "\n"); - } - CORBA_free(aso); - CORBA_free(asr); - return -1; -} - -static int seq3_test(IC_Env *env) -{ - m_lseq lsi, *lso, *lsr; - long al[500]; - int i=0; - - for (i = 0; i < 500; i++) - al[i]=i; - lsi._length = 500; - lsi._buffer = al; - - fprintf(stdout, "\n======== m_i_seq3 test ======\n\n"); - lsr = m_i_seq3_test(NULL, &lsi, &lso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_lseq(&lsi, lso) && cmp_lseq(&lsi, lsr)); - if (!cmp_lseq(&lsi, lso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_lseq(&lsi); - fprintf(stdout, " got:\n"); - print_lseq(lso); - fprintf(stdout, "\n"); - } - if (!cmp_lseq(&lsi, lsr)) { - fprintf(stdout, " result error, sent:\n"); - print_lseq(&lsi); - fprintf(stdout, " got:\n"); - print_lseq(lsr); - fprintf(stdout, "\n"); - } - CORBA_free(lso); - CORBA_free(lsr); - return -1; -} - -static int seq4_test(IC_Env *env) -{ - char *stra0[3] = {"a", "long", "time"}; - char *stra1[3] = {"ago", "there", "was"}; - char *stra2[3] = {"a", "buggy", "compiler"}; - m_sstr3 str3s[3] = {{3, 3, stra0}, {3, 3, stra1}, {3, 3, stra2}}; - m_ssstr3 str3ssi = {3, 3, str3s}; - m_ssstr3 *str3sso, *str3ssr; - - fprintf(stdout, "\n======== m_i_seq4 test ======\n\n"); - str3ssr = m_i_seq4_test(NULL, &str3ssi, &str3sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ssstr3(&str3ssi, str3sso) && - cmp_ssstr3(&str3ssi, str3ssr)); - if (!cmp_ssstr3(&str3ssi, str3sso)){ - fprintf(stdout, " out parameter error, sent:\n"); - print_ssstr3(&str3ssi); - fprintf(stdout, " got:\n"); - print_ssstr3(str3sso); - fprintf(stdout, "\n"); - } - if (!cmp_ssstr3(&str3ssi, str3ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_ssstr3(&str3ssi); - fprintf(stdout, " got:\n"); - print_ssstr3(str3ssr); - fprintf(stdout, "\n"); - } - CORBA_free(str3sso); - CORBA_free(str3ssr); - return -1; -} - -static int seq5_test(IC_Env *env) -{ - m_arr3 arr3a[3] = { - {4711, 18931947, 3}, - {4711, 18931947, 3}, - {4711, 18931947, 3}}; - m_sarr3 arr3sa[3] = {{3, 3, arr3a}, {3, 3, arr3a}, {3, 3, arr3a}}; - m_ssarr3 arr3ssi = {3, 3, arr3sa}; - m_ssarr3 *arr3sso; - m_ssarr3 *arr3ssr; - - fprintf(stdout, "\n======== m_i_seq5 test ======\n\n"); - arr3ssr = m_i_seq5_test(NULL, &arr3ssi, &arr3sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ssarr3(&arr3ssi, arr3sso) && - cmp_ssarr3(&arr3ssi, arr3ssr)); - if (!cmp_ssarr3(&arr3ssi, arr3sso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_ssarr3(&arr3ssi); - fprintf(stdout, " got:\n"); - print_ssarr3(arr3sso); - fprintf(stdout, "\n"); - } - if (!cmp_ssarr3(&arr3ssi, arr3ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_ssarr3(&arr3ssi); - fprintf(stdout, " got:\n"); - print_ssarr3(arr3ssr); - fprintf(stdout, "\n"); - } - CORBA_free(arr3sso); - CORBA_free(arr3ssr); - return -1; -} - -static int array1_test(IC_Env *env) -{ - int i; - long al[500]; - m_arr1 alo; - m_arr1_slice* alr; - - for (i = 0; i < 500; i++) - al[i]=i; - - fprintf(stdout, "\n======== m_i_array1 test ======\n\n"); - alr = m_i_array1_test(NULL, al, alo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_arr1(al, alo) && cmp_arr1(al, alr)); - if (!cmp_arr1(al, alo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_arr1(al); - fprintf(stdout, " got:\n"); - print_arr1(alo); - fprintf(stdout, "\n"); - } - if (!cmp_arr1(al,alr)) { - fprintf(stdout, " result error, sent:\n"); - print_arr1(al); - fprintf(stdout, " got:\n"); - print_arr1(alr); - fprintf(stdout, "\n"); - } - free(alo); - free(alr); - return -1; -} - -static int array2_test(IC_Env *env) -{ - long dl[2][3] = {{11, 2, 7}, {22, 8 ,13}}; - m_dd dlo; - m_dd_slice* dlr; - - fprintf(stdout, "\n======== m_i_array2 test ======\n\n"); - dlr = m_i_array2_test(NULL, dl, dlo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_dd(dl,dlo) && cmp_dd(dl,dlr)); - if (!cmp_dd(dl,dlo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_dd(dl); - fprintf(stdout, " got:\n"); - print_dd(dlo); - fprintf(stdout, "\n"); - } - if (!cmp_dd(dl,dlr)) { - fprintf(stdout, " result error, sent:\n"); - print_dd(dl); - fprintf(stdout, " got:\n"); - print_dd(dlr); - fprintf(stdout, "\n"); - } - free(*dlr); - return -1; -} - -static int enum_test(IC_Env *env) -{ - m_fruit ei = m_banana, eo, er; - - fprintf(stdout, "\n======== m_i_enum test ======\n\n"); - er = m_i_enum_test(NULL, ei, &eo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(ei == eo && ei == er); - if (ei != eo) - fprintf(stdout, " out parameter error, sent: %d, got: %d\n", ei, eo); - if (ei != er) - fprintf(stdout, " result error, sent: %d, got: %d\n", ei, er); - return -1; -} - -static int string1_test(IC_Env *env) -{ - char* si = longtext; - char* so; - char* sr; - - fprintf(stdout, "\n======== m_i_string1 test ======\n\n"); - sr = m_i_string1_test(NULL, si, &so, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, sr)); - if (!cmp_str(si, so)) - fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so); - if (!cmp_str(si, sr)) - fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr); - CORBA_free(so); - CORBA_free(sr); - return -1; -} - -static int string2_test(IC_Env *env) -{ - char* sa[3] = {"hello", "foo", "bar"}; - m_sseq ssi = {3, 3, sa}; - m_sseq *sso, *ssr; - - fprintf(stdout, "\n======== m_i_string2 test ======\n\n"); - ssr = m_i_string2_test(NULL, &ssi, &sso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_sseq(&ssi, sso) && cmp_sseq(&ssi, sso)); - if (!cmp_sseq(&ssi, sso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_sseq(&ssi); - fprintf(stdout, "got:\n"); - print_sseq(sso); - } - if (!cmp_sseq(&ssi, ssr)) { - fprintf(stdout, " result error, sent:\n"); - print_sseq(&ssi); - fprintf(stdout, "got:\n"); - print_sseq(ssr); - } - CORBA_free(sso); - CORBA_free(ssr); - return -1; -} - -static int string3_test(IC_Env *env) -{ - char* si = longtext; - char* so; - char* sr; - - fprintf(stdout, "\n======== m_i_string3 test ======\n\n"); - sr = m_i_string3_test(NULL, si, &so, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_str(si, so) && cmp_str(si, so)); - if (!cmp_str(si, so)) - fprintf(stdout, " out parameter error, sent: %s, got: %s\n", si, so); - if (!cmp_str(si, sr)) - fprintf(stdout, " result error, sent: %s, got: %s\n", si, sr); - CORBA_free(so); - CORBA_free(sr); - return -1; -} - -static int string4_test(IC_Env *env) -{ - char as1[100] = "a string", as2[200] = "help", as3[200] = "hello there"; - m_strRec stri = { 1, /* dd */ - as1, /* str4 */ - {{'a', 'k'}, {'z', 'g'}, {'n', 'q'}}, /* str7 */ - {3, 3, "buf"}, /* str5 */ - as2, /* str6 */ - {'m', 'f', 'o'}, /* str8 */ - as3, /* str9 */ - {3, 3, "stu"} /* str10 */ - }; - m_strRec *stro, *strr; - - fprintf(stdout, "\n======== m_i_string4 test ======\n\n"); - strr = m_i_string4_test(NULL, &stri, &stro, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_strRec(&stri,stro) && cmp_strRec(&stri,strr)); - if (!cmp_strRec(&stri,stro)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_strRec(&stri); - fprintf(stdout, " got:\n"); - print_strRec(stro); - fprintf(stdout, "\n"); - } - if (!cmp_strRec(&stri,strr)) { - fprintf(stdout, " result error, sent:\n"); - print_strRec(&stri); - fprintf(stdout, " got:\n"); - print_strRec(strr); - fprintf(stdout, "\n"); - } - CORBA_free(stro); - CORBA_free(strr); - return -1; -} - - -static int pid_test(IC_Env *env) -{ - erlang_pid pid = {"", 7, 0, 0}, pido, pidr; - - strcpy(pid.node, this_node), /* this currently running node */ - fprintf(stdout, "\n======== m_i_pid test ======\n\n"); - pidr = m_i_pid_test(NULL, &pid, &pido, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_pid(&pid, &pido) && cmp_pid(&pid, &pidr)); - if (!cmp_pid(&pid, &pido)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_pid(&pid); - fprintf(stdout, "got:\n"); - print_pid(&pido); - } - if (!cmp_pid(&pid, &pidr)) { - fprintf(stdout, " result error, sent:\n"); - print_pid(&pid); - fprintf(stdout, "got:\n"); - print_pid(&pidr); - } - return -1; -} - -static int port_test(IC_Env *env) -{ - erlang_port porti = {"node", 5, 1}, porto, portr; - - fprintf(stdout, "\n======== m_i_port test ======\n\n"); - portr = m_i_port_test(NULL, &porti, &porto, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_port(&porti, &porto) && cmp_port(&porti, &portr)); - if (!cmp_port(&porti, &porto)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_port(&porti); - fprintf(stdout, "got:\n"); - print_port(&porto); - } - if (!cmp_port(&porti, &portr)) { - fprintf(stdout, " result error, sent:\n"); - print_port(&porti); - fprintf(stdout, "got:\n"); - print_port(&portr); - } - return -1; -} - -static int ref_test(IC_Env *env) -{ - erlang_ref refi = { "node1", 3, {1, 2, 3}, 1}, - refo, refr; - - fprintf(stdout, "\n======== m_i_ref test ======\n\n"); - refr = m_i_ref_test(NULL, &refi, &refo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_ref(&refi, &refo) && cmp_ref(&refi, &refr)); - if (!cmp_ref(&refi, &refo)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_ref(&refi); - fprintf(stdout, "got:\n"); - print_ref(&refo); - } - if (!cmp_ref(&refi, &refr)) { - fprintf(stdout, " result error, sent:\n"); - print_ref(&refi); - fprintf(stdout, "got:\n"); - print_ref(&refr); - } - return -1; -} - -static int term_test(IC_Env *env) -{ - ETERM *ti, *to, *tr; - - ti = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"); - - fprintf(stdout, "\n======== m_i_term test ======\n\n"); - tr = m_i_term_test(NULL, ti, &to, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(erl_match(ti, to) && erl_match(ti, tr)); - if (!erl_match(ti, to)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_term(ti); - fprintf(stdout, "got:\n"); - print_term(to); - } - if (!erl_match(ti, tr)) { - fprintf(stdout, " result error, sent:\n"); - print_term(ti); - fprintf(stdout, "got:\n"); - print_term(tr); - } - erl_free_term(ti); - erl_free_term(to); - erl_free_term(tr); - return -1; -} - -static int typedef_test(IC_Env *env) -{ - m_banan mbi, mbo; /* erlang_port */ - m_apa mai; /* ETERM* */ - m_apa mao = NULL; - long tl; - - strcpy(mbi.node,"node"); - mbi.id = 15; - mbi.creation = 1; - - fprintf(stdout, "\n======== m_i_typedef test ======\n\n"); - mai = erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"); - tl = m_i_typedef_test(NULL, mai, &mbi, &mao, &mbo, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(erl_match(mai, mao) && cmp_port(&mbi, &mbo) && tl == 4711); - if (!erl_match(mai, mao)) { - fprintf(stdout, " out parameter error (term), sent:\n"); - print_term(mai); - fprintf(stdout, "got:\n"); - print_term(mao); - } - if (!cmp_port(&mbi, &mbo)) { - fprintf(stdout, " out parameter error (port), sent:\n"); - print_port(&mbi); - fprintf(stdout, "got:\n"); - print_port(&mbo); - } - if (tl != 4711) { - fprintf(stdout, " result error, sent: 4711, got %ld\n", tl); - } - erl_free_term(mai); - erl_free_term(mao); - return -1; -} - -static int inline_sequence_test(IC_Env *env) -{ - int i; - long al[500]; - m_s isi = {4711, {500, 10, al}}, - *iso, *isr; - - for (i = 0; i < 500; i++) - al[i]=i; - fprintf(stdout, "\n======== m_i_inline_sequence test ======\n\n"); - isr = m_i_inline_sequence_test(NULL, &isi, &iso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_s(&isi, iso) && cmp_s(&isi, isr)); - if (!cmp_s(&isi, iso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_s(&isi); - fprintf(stdout, "got:\n"); - print_s(iso); - } - if (!cmp_s(&isi, isr)) { - fprintf(stdout, " result error, sent:\n"); - print_s(&isi); - fprintf(stdout, "got:\n"); - print_s(isr); - } - CORBA_free(iso); - CORBA_free(isr); - return -1; -} - -static int term_sequence_test(IC_Env *env) -{ - ETERM* et_array[4] = { - erl_format("[{apa, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{banan, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{apelsin, 1, 23}, \"string\", {1.23, 45}]"), - erl_format("[{mango, 1, 23}, \"string\", {1.23, 45}]")}; - m_etseq etsi = {4, 4, et_array}, *etso, *etsr; - - fprintf(stdout, "\n======== m_i_term_sequence test ======\n\n"); - etsr = m_i_term_sequence_test(NULL, &etsi, &etso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_etseq(&etsi, etso) && cmp_etseq(&etsi, etsr)); - if (!cmp_etseq(&etsi, etso)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_etseq(&etsi); - fprintf(stdout, "got:\n"); - print_etseq(etso); - } - if (!cmp_etseq(&etsi, etsr)) { - fprintf(stdout, " result error, sent:\n"); - print_etseq(&etsi); - fprintf(stdout, "got:\n"); - print_etseq(etsr); - } - free_etseq_buf(&etsi); - free_etseq_buf(etso); - free_etseq_buf(etsr); - CORBA_free(etso); - CORBA_free(etsr); - return -1; -} - -static int term_struct_test(IC_Env *env) -{ - m_et eti = { erl_format("[{hej, 1, 23}, \"string\", {1.23, 45}]"), - 121212 }; - m_et eto, etr; - - fprintf(stdout, "\n======== m_i_term_struct test ======\n\n"); - etr = m_i_term_struct_test(NULL, &eti, &eto, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_et(&eti, &eto) && cmp_et(&eti, &etr)); - if (!cmp_et(&eti, &eto)) { - fprintf(stdout, " out parameter error, sent:\n"); - print_et(&eti); - fprintf(stdout, "got:\n"); - print_et(&eto); - } - if (!cmp_et(&eti, &etr)) { - fprintf(stdout, " result error, sent:\n"); - print_et(&eti); - fprintf(stdout, "got:\n"); - print_et(&etr); - } - free_et(&eti); - free_et(&eto); - free_et(&etr); - return -1; -} - -static int wstring1_test(IC_Env *env) -{ - CORBA_wchar wsi[] = {100, 101, 102, 103, 104, 0}, *wso, *wsr; - - fprintf(stdout, "\n======== m_i_wstring1 test ======\n\n"); - wsr = m_i_wstring1_test(NULL, wsi, &wso, env); - CHECK_EXCEPTION(env); - RETURN_IF_OK(cmp_wstr(wsi, wso) && cmp_wstr(wsi, wsr)); - if (!cmp_wstr(wsi, wso)) { - fprintf(stdout, " out parameter error, sent: \n"); - print_wstr(wsi); - fprintf(stdout, "got:\n"); - print_wstr(wso); - } - if (!cmp_wstr(wsi, wsr)) { - fprintf(stdout, " result error, sent: \n"); - print_wstr(wsi); - fprintf(stdout, "got:\n"); - print_wstr(wsr); - } - CORBA_free(wso); - CORBA_free(wsr); - return -1; -} - -/* Compare functions */ -static int cmp_aseq(m_aseq *a1, m_aseq *a2) -{ - int i; - - if (a1->_length != a2->_length) - return 0; - for (i = 0; i < a1->_length; i++) - if (cmp_a(&(a1->_buffer[i]), &(a2->_buffer[i])) == 0) - return 0; - return 1; -} - -static int cmp_a(m_a *a1, m_a *a2) -{ - return a1->l == a2->l && - a1->d == a2->d && - cmp_bseq(&a1->y, &a2->y); -} - -static int cmp_bseq(m_bseq *b1, m_bseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (cmp_b(&(b1->_buffer[i]), &(b2->_buffer[i])) == 0) - return 0; - return 1; -} - -static int cmp_b(m_b *b1, m_b *b2) -{ - return b1->l == b2->l && b1->c == b2->c; -} - -static int cmp_lseq(m_lseq *b1, m_lseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (b1->_buffer[i] != b2->_buffer[i]) - return 0; - return 1; -} - -static int cmp_etseq(m_etseq *b1, m_etseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (!erl_match(b1->_buffer[i], b2->_buffer[i])) - return 0; - return 1; -} - -static int cmp_et(m_et* b1, m_et *b2) -{ - return erl_match(b1->e, b2->e) && b1->l == b2->l; -} - -static int cmp_es(m_es *b1, m_es *b2) -{ - return b1->f == b2->f && b1->l == b2->l; -} - -static int cmp_arr1(m_arr1 b1, m_arr1 b2) -{ - int i; - - for (i = 0; i < 500; i++) - if (b1[i] != b2[i]) - return 0; - return 1; -} - -static int cmp_dd(m_dd b1, m_dd b2) -{ - - int i, j; - - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) - if (b1[i][j] != b2[i][j]) - return 0; - return 1; -} - - - -static int cmp_strRec(m_strRec *b1, m_strRec *b2) -{ - int i, j; - - if (b1->bb != b2->bb) - return 0; - if (!cmp_str(b1->str4,b2->str4)) - return 0; - if (b1->str5._length != b2->str5._length) - return 0; - for (j = 0; j < b1->str5._length; j++) - if (b1->str5._buffer[j] != b2->str5._buffer[j]) - return 0; - if (!cmp_str(b1->str6,b2->str6)) - return 0; - for (i = 0; i < 3; i++) - for (j = 0; j < 2; j++) - if (b1->str7[i][j] != b2->str7[i][j]) - return 0; - for (j = 0; j < 3; j++) - if (b1->str8[j] != b2->str8[j]) - return 0; - if (!cmp_str(b1->str9,b2->str9)) - return 0; - if (b1->str10._length != b2->str10._length) - return 0; - for (j = 0; j < b1->str10._length; j++) - if (b1->str10._buffer[j] != b2->str10._buffer[j]) - return 0; - return 1; -} - - -static int cmp_sseq(m_sseq *b1, m_sseq *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) - if (!cmp_str(b1->_buffer[i], b2->_buffer[i])) - return 0; - return 1; -} - - -static int cmp_pid(erlang_pid *p1, erlang_pid *p2) -{ - return cmp_str(p1->node,p2-> node) && - p1->num == p2->num && - p1->serial == p2->serial && - p1->creation == p2->creation; -} - -static int cmp_port(erlang_port *p1, erlang_port *p2) -{ - return cmp_str(p1->node,p2-> node) && p1->id == p2->id; -} - -static int cmp_ref(erlang_ref *p1, erlang_ref *p2) -{ - return cmp_str(p1->node, p2->node) && - p1->len == p2->len && - (p1->len < 1 || p1->n[0] == p2->n[0]) && - (p1->len < 2 || p1->n[1] == p2->n[1]) && - (p1->len < 3 || p1->n[2] == p2->n[2]); -} - -static int cmp_s(m_s *b1, m_s *b2) -{ - int i; - - if (b1->l != b2->l) - return 0; - if (b1->sl._length != b2->sl._length) - return 0; - for (i = 0; i < b1->sl._length; i++) - if (b1->sl._buffer[i] != b2->sl._buffer[i]) - return 0; - return 1; -} - - -static int cmp_ssstr3(m_ssstr3 *b1, m_ssstr3 *b2) -{ - int i,j; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (b1->_buffer[i]._length != b2->_buffer[i]._length) - return 0; - for (j = 0; j < b1->_buffer[i]._length; j++) - if (!cmp_str(b1->_buffer[i]._buffer[j], - b2->_buffer[i]._buffer[j])) - return 0; - } - return 1; -} - - - -static int cmp_ssarr3(m_ssarr3 *b1, m_ssarr3 *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (!cmp_sarr3(&b1->_buffer[i], &b2->_buffer[i])) - return 0; - } - return 1; -} - -static int cmp_sarr3(m_sarr3 *b1, m_sarr3 *b2) -{ - int i; - - if (b1->_length != b2->_length) - return 0; - for (i = 0; i < b1->_length; i++) { - if (!cmp_arr3(b1->_buffer[i], b2->_buffer[i])) - return 0; - } - return 1; -} - -static int cmp_arr3(m_arr3 b1, m_arr3 b2) -{ - int i; - - for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) { - if (b1[i] != b2[i]) - return 0; - } - return 1; -} - -/* Print functions */ -static void print_aseq(m_aseq *a) -{ - int i; - fprintf(stdout, "\nm_aseq size: %ld --------\n", a->_length); - for (i = 0; i < a->_length; i++) - print_a(&(a->_buffer[i])); -} - -static void print_a(m_a *a) -{ - fprintf(stdout, "\nm_a --------\n l: %ld\n d:%f\n", a->l, a->d); - print_bseq(&a->y); -} - -static void print_bseq(m_bseq *b) -{ - int i; - - fprintf(stdout, "\nm_bseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - print_b(&(b->_buffer[i])); -} - -static void print_lseq(m_lseq *b) -{ - int i; - - fprintf(stdout, "\nm_lseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - fprintf(stdout, "[%d]: %ld\n", i, b->_buffer[i]); -} - -static void print_b(m_b *b) -{ - fprintf(stdout, "\nm_b --------\n l: %ld\n c: %c\n", b->l, b->c); -} - - -static void print_etseq(m_etseq *b) -{ - int i; - - for (i = 0; i < b->_length; i++) { - fprintf(stdout, "[%d]:\n", i); - erl_print_term(stdout, b->_buffer[i]); - } -} - - -static void print_et(m_et* b) -{ - fprintf(stdout, "\net struct --------\n"); - erl_print_term(stdout, b->e); - fprintf(stdout, "long: %ld\n", b->l); - fprintf(stdout, "\n--------\n"); -} - -static void print_es(m_es *b) -{ - fprintf(stdout, "\nm_es --------\n f: %d\n l: %ld\n", b->f, b->l); -} - - -static void print_arr1(long a[10]) -{ - int i; - - for (i = 0; i < 10; i++) - fprintf(stdout, "\n[%d]: %ld\n", i, a[i]); -} - -static void print_dd(long a[2][3]) -{ - int i, j; - - fprintf(stdout, "\nlong dd[2][3] --------\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) - fprintf(stdout, "\n[%d][%d]: %ld\n", i, j, a[i][j]); -} - - -static void print_strRec(m_strRec* sr) -{ - int i, j; - - fprintf(stdout, "\nboolean bb : %d\n",sr->bb); - fprintf(stdout, "string str4 : %s\n",sr->str4); - fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 3; i++) - for (j = 0; j < 2; j++) - fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); - fprintf(stdout, "str5._length : %ld\n",sr->str5._length); - for (j = 0; j < sr->str5._length; j++) - fprintf(stdout, "str5._buffer[%d]: %c\n", j, sr->str5._buffer[j]); - fprintf(stdout, "string str6 : %s\n",sr->str6); - fprintf(stdout, "str8 :\n"); - for (j = 0; j < 3; j++) - fprintf(stdout, "str8[%d]: %c\n", j, sr->str8[j]); - fprintf(stdout, "string str9 : %s\n",sr->str9); - fprintf(stdout, "str10._length : %ld\n",sr->str10._length); - for (j = 0; j < sr->str10._length; j++) - fprintf(stdout, "str10._buffer[%d]: %c\n", j, sr->str10._buffer[j]); -} - -static void print_sseq(m_sseq *b) -{ - int i; - - fprintf(stdout, "\nm_sseq size: %ld --------\n",b->_length); - for (i = 0; i < b->_length; i++) - fprintf(stdout, "%s\n", b->_buffer[i]); - -} - - -static void print_pid(erlang_pid *p) -{ - fprintf(stdout, "\nerlang_pid --------\n node: %s\n num: %d\n " - "serial: %d\n creation: %d\n", - p->node, p->num, p->serial, p->creation); -} - -static void print_port(erlang_port *p) -{ - fprintf(stdout, "\nerlang_port --------\n node: %s\n id: %d\n " - "creation: %d\n", p->node, p->id, p->creation); -} - -static void print_ref(erlang_ref *p) -{ - fprintf(stdout, "\nerlang_ref --------\n node: %s\n len: %d\n " - "n[0]: %d\n n[1]: %d\n n[2]: %d\n creation: %d\n", - p->node, p->len, p->n[0], p->n[1], p->n[2], p->creation); -} - -static void print_term(ETERM *t) -{ - fprintf(stdout, "\nETERM --------\n"); - erl_print_term(stdout, t); - fprintf(stdout, "\n--------\n"); -} - -static void print_s(m_s *p) -{ - int i; - - fprintf(stdout, "\n%ld\n", p->l); - for (i = 0; i < p->sl._length; i++) - fprintf(stdout, "\n[%d]: %ld\n", i, p->sl._buffer[i]); -} - - -static void print_ssstr3(m_ssstr3 *b1) -{ - int i,j; - - fprintf(stdout, "\nSSSTR3 --------\n"); - fprintf(stdout,"b1->_length = %ld\n",b1->_length); - for (i = 0; i < b1->_length; i++) { - fprintf(stdout,"\nb1->_buffer[%d]._length %ld\n", - i, b1->_buffer[i]._length); - for (j = 0; j < b1->_buffer[i]._length; j++) - fprintf(stdout,"b1->_buffer[%d]._buffer[%d] = %s\n", - i, j, b1->_buffer[i]._buffer[j]); - } - fprintf(stdout, "\n--------\n"); -} - -static void print_wstr(CORBA_wchar *ws) -{ - int i = 0; - - fprintf(stdout, "\nwstr --------\n"); - while (ws[i]) { - fprintf(stdout, "[%d]: %ld\n", i, ws[i]); - i++; - } - fprintf(stdout, "\n--------\n"); -} - - -static void print_ssarr3(m_ssarr3 *b1) -{ - int i; - - fprintf(stdout, "\nssarr3 --------\n"); - fprintf(stdout,"length: %ld\n",b1->_length); - fprintf(stdout, "buffer:\n"); - for (i = 0; i < b1->_length; i++) - print_sarr3(&b1->_buffer[i]); - fprintf(stdout, "\n--------\n"); -} - -static void print_sarr3(m_sarr3 *b1) -{ - int i; - - fprintf(stdout, "\nsarr3 --------\n"); - fprintf(stdout,"length: %ld\n",b1->_length); - fprintf(stdout, "buffer:\n"); - for (i = 0; i < b1->_length; i++) - print_arr3(b1->_buffer[i]); - fprintf(stdout, "\n--------\n"); -} - -static void print_arr3(m_arr3 b1) -{ - int i; - - fprintf(stdout, "\narr3 --------\n"); - for (i = 0; i < sizeof(m_arr3)/sizeof(CORBA_long); i++) - fprintf(stdout, "%ld ", b1[i]); - fprintf(stdout, "\n--------\n"); -} - -static void free_etseq_buf(m_etseq *b) -{ - int i; - - for (i = 0; i < b->_length; i++) - erl_free_term(b->_buffer[i]); -} - -static void free_et(m_et* b) -{ - erl_free_term(b->e); -} - -static void showtime(MyTimeval *start, MyTimeval *stop) -{ - MyTimeval elapsed; - - elapsed.tv_sec = stop->tv_sec - start->tv_sec; - elapsed.tv_usec = stop->tv_usec - start->tv_usec; - while (elapsed.tv_usec < 0) { - elapsed.tv_sec -= 1; - elapsed.tv_usec += 1000000; - } - fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec); -} - -static void my_gettimeofday(MyTimeval *tv) -#ifdef __WIN32__ -#define EPOCH_JULIAN_DIFF 11644473600i64 -{ - SYSTEMTIME t; - FILETIME ft; - LONGLONG lft; - - GetSystemTime(&t); - SystemTimeToFileTime(&t, &ft); - memcpy(&lft, &ft, sizeof(lft)); - tv->tv_usec = (long) ((lft / 10i64) % 1000000i64); - tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF); -} -#elif defined VXWORKS -{ - int rate = sysClkRateGet(); /* Ticks per second */ - unsigned long ctick = tickGet(); - tv->tv_sec = ctick / rate; /* secs since reboot */ - tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate; -} -#else -{ - gettimeofday(tv, NULL); -} -#endif diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl deleted file mode 100644 index ec74d36cea..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_erl_test.idl +++ /dev/null @@ -1,174 +0,0 @@ - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2004-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% - -#include "erlang.idl" - - -const short TestConst = 1; - -module m { - - const short TestConst = 2; - - struct b { - long l; - char c; - }; - - struct simple { - long l; - b b_t; - }; - - enum fruit {orange, banana, apple, peach, pear}; - - typedef sequence<long> lseq; - - typedef sequence<b> bseq; - - struct a { - long l; - bseq y; - double d; - }; - - typedef sequence<a> aseq; - - typedef sequence<string> sseq; - typedef string str; - typedef long myLong; - - typedef long arr1[500], dd[2][3]; - - typedef erlang::term apa; - typedef erlang::port banan; - - typedef sequence<erlang::term> etseq; - - struct s { - long l; - sequence<long> sl; - }; - - struct es { - fruit f; - myLong l; - }; - - struct et { - erlang::term e; - long l; - }; - - - typedef sequence<char> str1; - typedef string<12> str2; - typedef char str3[3]; - - typedef sequence<string> sstr3; // sequence of string - typedef sequence<sstr3> ssstr3; // sequence of sequences of strings - - typedef long arr3[3]; // array of long - typedef sequence<arr3> sarr3; // sequence of array - typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings - - struct strRec{ - boolean bb; - string str4; - long str7[3][2]; - sequence<char> str5; - string<12> str6; - str3 str8; - str2 str9; - str1 str10; - }; - - - struct dyn { - long l; - sequence<long> sl; - }; - typedef dyn arr2[1][2]; - - - interface i { - - const short TestConst = 3; - - //arr2 suck(in arr2 x, out arr2 y ); - - ///////////////////////////////// attribute long l; - - // simple types - void void_test(); - long long_test(in long a, out long a1); - long long longlong_test(in long long a, out long long a1); - unsigned short ushort_test(in unsigned short a, out unsigned short a1); - unsigned long ulong_test(in unsigned long a, out unsigned long a1); - unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1); - double double_test(in double a, out double a1); - char char_test(in char a, out char a1); - wchar wchar_test(in wchar a, out wchar a1); - octet octet_test(in octet a, out octet a1); - boolean bool_test(in boolean a, out boolean a1); - - // Seq. and struct tests - b struct_test(in b a, out b a1); - es struct2_test(in es a, out es a1); - //simple struct3_test(in simple x, out simple y); - bseq seq1_test(in bseq a, out bseq a1); - aseq seq2_test(in aseq a, out aseq a1); - lseq seq3_test(in lseq a, out lseq a1); - ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1); - ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1); - - // Array tests - arr1 array1_test(in arr1 a, out arr1 a1); - dd array2_test(in dd a, out dd a1); - - // enum test - fruit enum_test(in fruit a, out fruit a1); - - // string tests - string string1_test(in string a, out string a1); - wstring wstring1_test(in wstring a, out wstring a1); - sseq string2_test(in sseq a, out sseq a1); - str string3_test(in str a, out str a1); - strRec string4_test(in strRec a, out strRec a1); - - // Special erlang types - erlang::pid pid_test(in erlang::pid a, out erlang::pid a1); - erlang::port port_test(in erlang::port a, out erlang::port a1); - erlang::ref ref_test(in erlang::ref a, out erlang::ref a1); - erlang::term term_test(in erlang::term a, out erlang::term a1); - - // typedef test - long typedef_test(in apa a, in banan b, out apa a1, out banan b1); - - // inlined seq. test - s inline_sequence_test(in s a, out s a1); - - // term seq. test - etseq term_sequence_test(in etseq a, out etseq a1); - // term struct test - et term_struct_test(in et a, out et a1); - - }; - -}; diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/erl_server.erl b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/erl_server.erl deleted file mode 100644 index f2a6ed83fa..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/erl_server.erl +++ /dev/null @@ -1,29 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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% -%% -%% --module(erl_server). - --export([run/0, stop/0]). - -run() -> - m_i:oe_create(). - -stop() -> - gen_server:cast(cidl_test, stop). diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl deleted file mode 100644 index ab62ee40c0..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/m_i_impl.erl +++ /dev/null @@ -1,162 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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% -%% -%% --module(m_i_impl). --include("m.hrl"). - --export([init/1, terminate/2, void_test/1, long_test/2, ushort_test/2, - longlong_test/2, ulong_test/2, ulonglong_test/2, - double_test/2, char_test/2, wchar_test/2, octet_test/2, - bool_test/2, struct_test/2, struct2_test/2, seq1_test/2, - seq2_test/2, seq3_test/2, seq4_test/2, seq5_test/2, - array1_test/2, array2_test/2, enum_test/2, string1_test/2, - string2_test/2, string3_test/2, string4_test/2, pid_test/2, - port_test/2, ref_test/2, term_test/2, typedef_test/3, - inline_sequence_test/2, '_set_l'/2, '_get_l'/1, - term_struct_test/2, term_sequence_test/2, wstring1_test/2]). - --define(PRINTDEBUG(Case), - io:format("erl_server: case: ~p~n" - "erl_server: location: ~p~n", [Case, [?FILE, ?LINE]])). --define(PRINTDEBUG2(Case, Msg), - io:format("erl_server: case: ~p~n" - "erl_server: Msg: ~p~n" - "erl_server: location: ~p~n", [Case, Msg, [?FILE, ?LINE]])). - -init(Env) -> - {ok, []}. - -terminate(F, R) -> - ok. - -'_get_l'(State) -> - ?PRINTDEBUG("_get_l"), - {reply, State, State}. -void_test(State) -> - ?PRINTDEBUG("void_test"), - {reply, ok, State}. - -'_set_l'(State, V) -> - ?PRINTDEBUG2("_set_l", V), - {reply, ok, V}. -ushort_test(State, V) -> - ?PRINTDEBUG2("ushort_test", V), - {reply, {V, V}, State}. -long_test(State, V) -> - ?PRINTDEBUG2("long_test", V), - {reply, {V, V}, State}. -longlong_test(State, V) -> - ?PRINTDEBUG2("longlong_test", V), - {reply, {V, V}, State}. -ulong_test(State, V) -> - ?PRINTDEBUG2("ulong_test", V), - {reply, {V, V}, State}. -ulonglong_test(State, V) -> - ?PRINTDEBUG2("ulonglong_test", V), - {reply, {V, V}, State}. -double_test(State, V) -> - ?PRINTDEBUG2("double_test", V), - {reply, {V, V}, State}. -char_test(State, V) -> - ?PRINTDEBUG2("char_test", V), - {reply, {V, V}, State}. -wchar_test(State, V) -> - ?PRINTDEBUG2("wchar_test", V), - {reply, {V, V}, State}. -octet_test(State, V) -> - ?PRINTDEBUG2("octet_test", V), - {reply, {V, V}, State}. -bool_test(State, V) -> - ?PRINTDEBUG2("bool_test", V), - {reply, {V, V}, State}. - -struct_test(State, V) -> - ?PRINTDEBUG2("struct_test", V), - {reply, {V, V}, State}. -struct2_test(State, V) -> - ?PRINTDEBUG2("struct2_test", V), - {reply, {V, V}, State}. -seq1_test(State, V) -> - ?PRINTDEBUG2("seq1_test", V), - {reply, {V, V}, State}. -seq2_test(State, V) -> - ?PRINTDEBUG2("seq2_test", V), - {reply, {V, V}, State}. -seq3_test(State, V) -> - ?PRINTDEBUG2("seq3_test", V), - {reply, {V, V}, State}. -seq4_test(State, V) -> - ?PRINTDEBUG2("seq4_test", V), - {reply, {V, V}, State}. -seq5_test(State, V) -> - ?PRINTDEBUG2("seq5_test", V), - {reply, {V, V}, State}. -array1_test(State, V) -> - ?PRINTDEBUG2("array1_test", V), - {reply, {V, V}, State}. -array2_test(State, V) -> - ?PRINTDEBUG2("array2_test", V), - {reply, {V, V}, State}. -enum_test(State, V) -> - ?PRINTDEBUG2("enum_test", V), - {reply, {V, V}, State}. -string1_test(State, V) -> - ?PRINTDEBUG2("string1_test", V), - {reply, {V, V}, State}. -string2_test(State, V) -> - ?PRINTDEBUG2("string2_test", V), - {reply, {V, V}, State}. -string3_test(State, V) -> - ?PRINTDEBUG2("string3_test", V), - {reply, {V, V}, State}. -string4_test(State, V) -> - ?PRINTDEBUG2("string4_test", V), - {reply, {V, V}, State}. -pid_test(State, V) -> - ?PRINTDEBUG2("pid_test", V), - {reply, {V, V}, State}. -port_test(State, V) -> - ?PRINTDEBUG2("port_test", binary_to_list(term_to_binary(V))), - {reply, {V, V}, State}. -ref_test(State, V) -> - ?PRINTDEBUG2("ref_test", binary_to_list(term_to_binary(V))), - {reply, {V, V}, State}. -term_test(State, V) -> - ?PRINTDEBUG2("term_test", V), - {reply, {V, V}, State}. -typedef_test(State, A, B) -> - ?PRINTDEBUG2("typedef_test", [A,B]), - {reply, {4711, A, B}, State}. -inline_sequence_test(State, V) -> - ?PRINTDEBUG2("inline_sequence_test", V), - {reply, {V, V}, State}. -term_sequence_test(State, V) -> - ?PRINTDEBUG2("term_sequence_test", V), - {reply, {V, V}, State}. -term_struct_test(State, V) -> - ?PRINTDEBUG2("term_struct_test", V), - {reply, {V, V}, State}. -wstring1_test(State, V) -> - ?PRINTDEBUG2("wstring1_test", V), - {reply, {V, V}, State}. - - - - diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/my.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/my.c deleted file mode 100644 index 6045034052..0000000000 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/my.c +++ /dev/null @@ -1,52 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-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% - * - */ -#include "ic.h" -#include "m_i.h" - -int my_prepare_notification_encoding(CORBA_Environment *env) -{ - return oe_prepare_notification_encoding(env); -} - -int my_send_notification_tmo(CORBA_Environment *env, unsigned int send_ms) -{ - return oe_send_notification_tmo(env, send_ms); -} - -int my_prepare_request_encoding(CORBA_Environment *env) -{ - return oe_prepare_request_encoding(env); -} - -int my_send_request_and_receive_reply_tmo(CORBA_Environment *env, - unsigned int send_ms, - unsigned int recv_ms) -{ - return oe_send_request_and_receive_reply_tmo(env, send_ms, recv_ms); -} - -int my_prepare_reply_decoding(CORBA_Environment *env) -{ - return oe_prepare_reply_decoding(env); -} - - - diff --git a/lib/ic/test/erl_client_c_server_SUITE.erl b/lib/ic/test/erl_client_c_server_SUITE.erl deleted file mode 100644 index d592a611f7..0000000000 --- a/lib/ic/test/erl_client_c_server_SUITE.erl +++ /dev/null @@ -1,298 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-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 erl-client/c-server -%%---------------------------------------------------------------------- - - --module(erl_client_c_server_SUITE). --include_lib("common_test/include/ct.hrl"). - --export([init_per_testcase/2, end_per_testcase/2,all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, void_test/1, - long_test/1, longlong_test/1, ushort_test/1, ulong_test/1, - ulonglong_test/1, double_test/1, char_test/1, wchar_test/1, - octet_test/1, bool_test/1, struct_test/1, struct2_test/1, - seq1_test/1, seq2_test/1, seq3_test/1, seq4_test/1, - seq5_test/1, array1_test/1, array2_test/1, enum_test/1, - string1_test/1, string2_test/1, string3_test/1, - string4_test/1, pid_test/1, port_test/1, ref_test/1, - term_test/1, typedef_test/1, inline_sequence_test/1, - term_sequence_test/1, term_struct_test/1, wstring1_test/1]). - --define(DEFAULT_TIMEOUT, 20000). --define(PORT_TIMEOUT, 15000). --define(CALL_TIMEOUT, 5000). - --define(C_SERVER_NODE_NAME, idl_c_server_test). - -%% Add/remove code path and watchdog before/after each test case. -%% -init_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:add_patha(DataDir), - - %% Since other test suites use the module m_i, we have - %% to make sure we are using the right m_i module. - code:purge(m_i), - code:load_file(m_i), - - WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:del_path(DataDir), - WatchDog = proplists:get_value(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> -[void_test, long_test, longlong_test, ushort_test, - ulong_test, ulonglong_test, double_test, char_test, - wchar_test, octet_test, bool_test, struct_test, - struct2_test, seq1_test, seq2_test, seq3_test, - seq4_test, seq5_test, array1_test, array2_test, - enum_test, string1_test, string2_test, string3_test, - string4_test, pid_test, port_test, ref_test, term_test, - typedef_test, inline_sequence_test, term_sequence_test, - term_struct_test, wstring1_test]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -array1_test(Config) -> - do_test(array1_test, Config). - -array2_test(Config) -> - do_test(array2_test, Config). - -bool_test(Config) -> - do_test(bool_test, Config). - -char_test(Config) -> - do_test(char_test, Config). - -double_test(Config) -> - do_test(double_test, Config). - -enum_test(Config) -> - do_test(enum_test, Config). - -inline_sequence_test(Config) -> - do_test(inline_sequence_test, Config). - -longlong_test(Config) -> - do_test(longlong_test, Config). - -long_test(Config) -> - do_test(long_test, Config). - -octet_test(Config) -> - do_test(octet_test, Config). - -pid_test(Config) -> - do_test(pid_test, Config). - -port_test(Config) -> - do_test(port_test, Config). - -ref_test(Config) -> - do_test(ref_test, Config). - -seq1_test(Config) -> - do_test(seq1_test, Config). - -seq2_test(Config) -> - do_test(seq2_test, Config). - -seq3_test(Config) -> - do_test(seq3_test, Config). - -seq4_test(Config) -> - do_test(seq4_test, Config). - -seq5_test(Config) -> - do_test(seq5_test, Config). - -string1_test(Config) -> - do_test(string1_test, Config). - -string2_test(Config) -> - do_test(string2_test, Config). - -string3_test(Config) -> - do_test(string3_test, Config). - -string4_test(Config) -> - do_test(string4_test, Config). - -struct2_test(Config) -> - do_test(struct2_test, Config). - -struct_test(Config) -> - do_test(struct_test, Config). - -term_sequence_test(Config) -> - do_test(term_sequence_test, Config). - -term_struct_test(Config) -> - do_test(term_struct_test, Config). - -term_test(Config) -> - do_test(term_test, Config). - -typedef_test(Config) -> - do_test(typedef_test, Config). - -ulonglong_test(Config) -> - do_test(ulonglong_test, Config). - -ulong_test(Config) -> - do_test(ulong_test, Config). - -ushort_test(Config) -> - do_test(ushort_test, Config). - -void_test(Config) -> - do_test(void_test, Config). - -wchar_test(Config) -> - do_test(wchar_test, Config). - -wstring1_test(Config) -> - do_test(wstring1_test, Config). - - -do_test(Case, Config) -> - %% Trap exits - process_flag(trap_exit, true), - Node = atom_to_list(node()), - [_NodeName, HostName] = string:tokens(Node, "@"), - DataDir = proplists:get_value(data_dir, Config), - %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]), - Cookie = atom_to_list(erlang:get_cookie()), - ServerNodeName = atom_to_list(?C_SERVER_NODE_NAME), - %% Start C-server node as a port program. We wait for the node - %% to connect to us. - Cmd = filename:join([DataDir, "c_server"]) ++ - " -this-node-name " ++ ServerNodeName ++ - " -peer-node " ++ Node ++ - " -cookie " ++ Cookie, - Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]), - ServerNode = list_to_atom(ServerNodeName ++ "@" ++ HostName), - Res = case wait_for_hidden_node(ServerNode) of - ok -> - %% Need a port for port_test and typedef_test - put(port_test_port, Port), - R = (catch erl_client:Case(ServerNode, ?CALL_TIMEOUT)), - case wait_for_completion(Port) of - {error, timeout} -> - kill_off_node(ServerNode); - _ -> - ok - end, - R; - {error, timeout} -> - case wait_for_completion(Port) of - {error, timeout} -> - kill_off_node(ServerNode); - _ -> - ok - end, - {error, timeout} - end, - process_flag(trap_exit, false), - true = Res. - - -%% Wait for eof *and* exit status, but return if exit status indicates -%% an error, or we have been waiting more than PORT_TIMEOUT seconds. -%% -wait_for_completion(Port) -> - wait_for_completion(Port, 0). - -wait_for_completion(Port, N) when N < 2 -> - receive - {Port, {data, Bytes}} -> - %% Relay output - io:format("~s", [Bytes]), - wait_for_completion(Port, N); - {Port, {exit_status, 0}} -> - wait_for_completion(Port, N + 1); - {Port, {exit_status, Status}} -> - {error, Status}; - {Port, eof} -> - wait_for_completion(Port, N + 1); - {'EXIT', Port, Reason} -> - io:format("Port exited with reason: ~w~n", [Reason]), - wait_for_completion(Port, N); - {'EXIT', From, Reason} -> - io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]), - wait_for_completion(Port, N) - after ?PORT_TIMEOUT -> - {error, timeout} - end; -wait_for_completion(_, _) -> - ok. - -wait_for_hidden_node(Node) -> - Times = ?DEFAULT_TIMEOUT div 100, - wait_for_hidden_node(Node, Times, 100). - -wait_for_hidden_node(Node, Times, WaitTime) when Times > 0 -> - io:format("Waiting for hidden node: ~p~n", [Node]), - case lists:member(Node, erlang:nodes(hidden)) of - true -> - ok; - false -> - delay(WaitTime), - wait_for_hidden_node(Node, Times - 1, WaitTime) - end; -wait_for_hidden_node(_Node, _, _WaitTime) -> - {error, timeout}. - -kill_off_node(Node) -> - catch rpc:cast(Node, erlang, halt, [1]). - -delay(Time) -> - receive - after Time -> - ok - end. - - - - diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/Makefile.src b/lib/ic/test/erl_client_c_server_SUITE_data/Makefile.src deleted file mode 100644 index 11eee8b7ac..0000000000 --- a/lib/ic/test/erl_client_c_server_SUITE_data/Makefile.src +++ /dev/null @@ -1,160 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2002-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% -# -# -# Makefile.src for erl_client_c_server test -# Note: This file *must* work for both Unix and Windows -# -# We use both `rm' (Unix) and `del' (Windows) for removing files, but -# with a `-' in front so that the error in not finding `rm' (`del') on -# Windows (Unix) is ignored. -# -# VxWorks? XXX -# - -.SUFFIXES: -.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@ - - -# Variables from ts: -# - -ERL_INCLUDE = @erl_include@ - -IC_INCLUDE_PATH = @ic_include_path@ -IC_LIB = @ic_lib@ - -ERL_INTERFACE_INCLUDE = @erl_interface_include@ -ERL_INTERFACE_LIB = @erl_interface_lib@ -ERL_INTERFACE_EILIB = @erl_interface_eilib@ -ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@ -ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@ - -CC = @CC@ -## XXX Should set warning flag with a DEBUG_FLAG -CFLAGS = @CFLAGS@ @DEFS@ -I$(ERL_INCLUDE) \ - -I$(IC_INCLUDE_PATH) -I$(ERL_INTERFACE_INCLUDE) - -LD = @LD@ -LDFLAGS = @CROSSLDFLAGS@ -LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \ - $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS) -ERLC = erlc - -# Generated C header files -GEN_H_FILES = \ - m__s.h \ - m_i__s.h \ - oe_erl_c_test__s.h - -# Generated C files -GEN_C_FILES = \ - m__s.c \ - m_i__s.c \ - oe_code_m_a.c \ - oe_code_m_arr1.c \ - oe_code_m_arr2.c \ - oe_code_m_arr3.c \ - oe_code_m_aseq.c \ - oe_code_m_b.c \ - oe_code_m_bseq.c \ - oe_code_m_dd.c \ - oe_code_m_dyn.c \ - oe_code_m_dyn_sl.c \ - oe_code_m_es.c \ - oe_code_m_et.c \ - oe_code_m_etseq.c \ - oe_code_m_fruit.c \ - oe_code_m_lseq.c \ - oe_code_m_s.c \ - oe_code_m_s_sl.c \ - oe_code_m_sarr3.c \ - oe_code_m_simple.c \ - oe_code_m_ssarr3.c \ - oe_code_m_sseq.c \ - oe_code_m_ssstr3.c \ - oe_code_m_sstr3.c \ - oe_code_m_str1.c \ - oe_code_m_str3.c \ - oe_code_m_strRec.c \ - oe_code_m_strRec_str5.c \ - oe_code_m_strRec_str7.c \ - oe_erl_c_test__s.c - -GEN_HRL_FILES = \ - m.hrl \ - m_i.hrl \ - oe_erl_c_test.hrl - -GEN_ERL_FILES = \ - m.erl \ - m_arr2.erl \ - m_arr3.erl \ - m_i.erl \ - m_str3.erl \ - oe_erl_c_test.erl - -C_FILES = $(GEN_C_FILES) c_server.c callbacks.c - -OBJS = $(C_FILES:.c=@obj@) - -PGMS = c_server@exe@ - -ERL_FILES = $(GEN_ERL_FILES) erl_client.erl - -EBINS = $(ERL_FILES:.erl=.@EMULATOR@) - - -all: $(PGMS) $(EBINS) - -$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl -$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c -$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES) -$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES) - -clean: - -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -$(PGMS): $(OBJS) - $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS) - -c_erl_test.built_c: erl_c_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_server}" \ - "+{scoped_op_calls,true}" erl_c_test.idl - echo done > c_erl_test.built_c - -# If we have scoped operation calls for C, we must have that for -# Erlang as well, if we use the m_i.erl file for calling the server. - -c_erl_test.built_erl: erl_c_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" \ - "+{scoped_op_calls,true}" "+{timeout,true}" erl_c_test.idl - echo done > c_erl_test.built_erl - -.c@obj@: - $(CC) -c -o $*@obj@ $(CFLAGS) $< - -.erl.@EMULATOR@: - $(ERLC) -W -I $(IC_INCLUDE_PATH) $< - diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/c_server.c b/lib/ic/test/erl_client_c_server_SUITE_data/c_server.c deleted file mode 100644 index f48480e8dc..0000000000 --- a/lib/ic/test/erl_client_c_server_SUITE_data/c_server.c +++ /dev/null @@ -1,300 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2002-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% - * - */ -/* C-server for test of IC. - * - * The C-node implemented here connects to its peer node, waits for - * one message, evaluates the message, returns an result message, and - * terminates. - * - * TODO: - * - * 1. XXX #includes for VxWorks, Windows - */ - -#include <stdio.h> -#include <stdlib.h> - -#ifndef __WIN32__ -# include <unistd.h> -#endif - -#include <string.h> - -#ifdef __WIN32__ -# include <time.h> -# include <sys/timeb.h> -#elif defined VXWORKS -# include <time.h> -# include <sys/times.h> -#else -# include <sys/time.h> -#endif - -#include <ctype.h> - -#ifdef __WIN32__ -# include <winsock2.h> -# include <windows.h> -#else -# include <sys/types.h> -# include <sys/socket.h> -# include <netinet/in.h> -# include <arpa/inet.h> -# include <netdb.h> -#endif - -#include "ic.h" -#include "ei.h" -#include "erl_interface.h" -#include "eicode.h" -#include "m_i__s.h" -#include "m__s.h" - -#ifdef __WIN32__ -typedef struct { - long tv_sec; - long tv_usec; -} MyTimeval; -#else -typedef struct timeval MyTimeval; -#endif -static void my_gettimeofday(MyTimeval *tv); -static void showtime(MyTimeval *start, MyTimeval *stop); -static void usage(void); -static void done(int r); - -#define HOSTNAMESZ 255 -#define NODENAMESZ 512 -#define INBUFSZ 10 -#define OUTBUFSZ 0 -#define MAXTRIES 5 - -static char *progname; - -/* main */ -#ifdef VXWORKS -int c_server(int argc, char **argv) -#else -int main(int argc, char **argv) -#endif -{ - struct hostent *hp; - MyTimeval start, stop; - int i, fd, ires, tries; - CORBA_Environment *env; - char *this_node_name = NULL; - char *peer_node = NULL; - char *cookie = NULL; - char host[HOSTNAMESZ + 1]; - char this_node[NODENAMESZ + 1]; - erlang_msg msg; - int status, loop; - -#ifdef __WIN32__ - WORD wVersionRequested; - WSADATA wsaData; - - wVersionRequested = MAKEWORD(2, 0); - - if (WSAStartup(wVersionRequested, &wsaData) != 0) { - fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL"); - exit(1); - } -#endif - - progname = argv[0]; - host[HOSTNAMESZ] = '\0'; - if (gethostname(host, HOSTNAMESZ + 1) < 0) { - fprintf(stderr, "Can't find own hostname\n"); - done(1); - } - if ((hp = gethostbyname(host)) == 0) { - fprintf(stderr, "Can't get ip address for host %s\n", host); - done(1); - } - for (i = 1; i < argc; i++) { - if (strcmp(argv[i], "-help") == 0) { - usage(); - done(0); - } else if (strcmp(argv[i], "-this-node-name") == 0) { - i++; - this_node_name = argv[i]; - } else if (strcmp(argv[i], "-peer-node") == 0) { - i++; - peer_node = argv[i]; - } else if (strcmp(argv[i], "-cookie") == 0) { - i++; - cookie = argv[i]; - } else { - fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]); - usage(); - done(1); - } - } - - if (this_node_name == NULL || peer_node == NULL || cookie == NULL) { - fprintf(stderr, "Error: missing option\n"); - usage(); - done(1); - } - - /* Behead hostname at first dot */ - for (i=0; host[i] != '\0'; i++) { - if (host[i] == '.') { host[i] = '\0'; break; } - } - sprintf(this_node, "%s@%s", this_node_name, host); - - fprintf(stderr, "c_server: this node: \"%s\"\n", this_node); - fprintf(stderr, "c_server: peer node: \"%s\"\n", peer_node); - - /* initialize erl_interface */ - erl_init(NULL, 0); - - for (tries = 0; tries < MAXTRIES; tries++) { - /* connect to peer node */ - ires = erl_connect_xinit(host, this_node_name, this_node, - (struct in_addr *)*hp->h_addr_list, - cookie, 0); - fprintf(stderr, "c_server: erl_connect_xinit(): %d\n", ires); - - fd = erl_connect(peer_node); - fprintf(stderr, "c_server: erl_connect(): %d\n", fd); - if (fd >= 0) - break; - fprintf(stderr, "c_server: cannot connect, retrying\n"); - } - if (fd < 0) { - fprintf(stderr, "c_server: cannot connect, exiting\n"); - done(1); - } - env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ); - env->_fd = fd; - - status = 1; - loop = 1; - my_gettimeofday(&start); - while (status >= 0 && loop > 0) { - status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, - &msg, &env->_iin); - switch(status) { - case ERL_SEND: - case ERL_REG_SEND: - /* get result */ - m_i__switch(NULL, env); - switch(env->_major) { - case CORBA_NO_EXCEPTION: - break; - case CORBA_SYSTEM_EXCEPTION: - fprintf(stderr, "Request failure, reason : %s\n", - (char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - break; - default: /* Should not happen */ - CORBA_exception_free(env); - break; - } - /* send back result data */ - if (env->_iout > 0) - ei_send_encoded(env->_fd, &env->_caller, env->_outbuf, - env->_iout); - loop = 0; - break; - case ERL_TICK: - break; - default: - if (status < 0) { - fprintf(stderr, "Status negative: %d\n", status); - loop = 0; - } - break; - } - } - my_gettimeofday(&stop); - showtime(&start, &stop); - - erl_close_connection(fd); - - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - if (status < 0) - done(-status); - else - done(0); -} - -static void usage() -{ - fprintf(stderr, "Usage: %s [-help] -this-node-name <name> " - "-peer-node <nodename> -cookie <cookie>\n", progname); - fprintf(stderr, "Example:\n %s -this-node-name kalle " - "-peer-node olle@home -cookie oa678er\n", progname); -} - -static void done(int r) -{ -#ifdef __WIN32__ - WSACleanup(); -#endif - exit(r); -} - -static void showtime(MyTimeval *start, MyTimeval *stop) -{ - MyTimeval elapsed; - - elapsed.tv_sec = stop->tv_sec - start->tv_sec; - elapsed.tv_usec = stop->tv_usec - start->tv_usec; - while (elapsed.tv_usec < 0) { - elapsed.tv_sec -= 1; - elapsed.tv_usec += 1000000; - } - fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec); -} - - - -static void my_gettimeofday(MyTimeval *tv) -#ifdef __WIN32__ -#define EPOCH_JULIAN_DIFF 11644473600i64 -{ - SYSTEMTIME t; - FILETIME ft; - LONGLONG lft; - - GetSystemTime(&t); - SystemTimeToFileTime(&t, &ft); - memcpy(&lft, &ft, sizeof(lft)); - tv->tv_usec = (long) ((lft / 10i64) % 1000000i64); - tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF); -} -#elif defined VXWORKS -{ - int rate = sysClkRateGet(); /* Ticks per second */ - unsigned long ctick = tickGet(); - tv->tv_sec = ctick / rate; /* secs since reboot */ - tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate; -} -#else -{ - gettimeofday(tv, NULL); -} -#endif diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c b/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c deleted file mode 100644 index 2611e15f5a..0000000000 --- a/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c +++ /dev/null @@ -1,611 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2002-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% - * - */ -#include <stdio.h> -#include <stdlib.h> -#ifndef __WIN32__ -# include <unistd.h> -#endif -#include <string.h> -#include <ctype.h> -#include <ic.h> -#include <erl_interface.h> -#include <ei.h> -#include "m_i__s.h" - - - -/* OK */ - -void my_void_test(CORBA_Object oe_obj, - CORBA_Environment *oe_env) -{ - /* printf("void test !\n"); */ -} - -m_i_void_test__rs* m_i_void_test__cb(CORBA_Object oe_obj, - CORBA_Environment *oe_env) -{ - return (m_i_void_test__rs*) (my_void_test); -} - - - -/* OK */ - -void my_long_test(CORBA_Object oe_obj, - long* a, - long* b, - long* c, - CORBA_Environment *oe_env) -{ - /* printf("long test !\n"); */ -} - - -m_i_long_test__rs* m_i_long_test__cb(CORBA_Object oe_obj, - long* a, - long* b, - long* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_long_test__rs*) (my_long_test); -} - -/* OK */ - -void my_longlong_test(CORBA_Object oe_obj, - CORBA_long_long* a, - CORBA_long_long* b, - CORBA_long_long* c, - CORBA_Environment *oe_env) -{ - /* printf("long test !\n"); */ -} - -m_i_longlong_test__rs* m_i_longlong_test__cb(CORBA_Object oe_obj, - CORBA_long_long* a, - CORBA_long_long* b, - CORBA_long_long* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_longlong_test__rs*) (my_longlong_test); -} - -/* OK */ -void my_ulong_test(CORBA_Object oe_obj, - unsigned long* a, - unsigned long* b, - unsigned long* c, - CORBA_Environment *oe_env) -{ - /* printf("ulong test !\n"); */ -} - -m_i_ulong_test__rs* m_i_ulong_test__cb(CORBA_Object oe_obj, - unsigned long* a, - unsigned long* b, - unsigned long* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_ulong_test__rs*) (my_ulong_test); -} - -/* OK */ -void my_ulonglong_test(CORBA_Object oe_obj, - CORBA_unsigned_long_long* a, - CORBA_unsigned_long_long* b, - CORBA_unsigned_long_long* c, - CORBA_Environment *oe_env) -{ - /* printf("ulong test !\n"); */ -} - -m_i_ulonglong_test__rs* m_i_ulonglong_test__cb(CORBA_Object oe_obj, - CORBA_unsigned_long_long* a, - CORBA_unsigned_long_long* b, - CORBA_unsigned_long_long* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_ulonglong_test__rs*) (my_ulonglong_test); -} - -m_i_ushort_test__rs* m_i_ushort_test__cb(CORBA_Object oe_obj, - unsigned short* a, - unsigned short* b, - unsigned short* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_ushort_test__rs*) NULL; -} - - -/* OK */ -void my_double_test(CORBA_Object oe_obj, - double* a, - double* b, - double* c, - CORBA_Environment *oe_env) -{ - /* printf("double test !\n"); */ -} - -m_i_double_test__rs* m_i_double_test__cb(CORBA_Object oe_obj, - double* a, - double* b, - double* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_double_test__rs*) (my_double_test); -} - -/* OK */ -m_i_char_test__rs* m_i_char_test__cb(CORBA_Object oe_obj, - char* a, - char* b, - char* c, - CORBA_Environment *oe_env) -{ - m_i_char_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - - -/* OK */ -m_i_wchar_test__rs* m_i_wchar_test__cb(CORBA_Object oe_obj, - CORBA_wchar* a, - CORBA_wchar* b, - CORBA_wchar* c, - CORBA_Environment *oe_env) -{ - m_i_wchar_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -m_i_octet_test__rs* m_i_octet_test__cb(CORBA_Object oe_obj, - char* a, - char* b, - char* c, - CORBA_Environment *oe_env) -{ - m_i_octet_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -m_i_bool_test__rs* m_i_bool_test__cb(CORBA_Object oe_obj, - CORBA_boolean* a, - CORBA_boolean* b, - CORBA_boolean* c, - CORBA_Environment *oe_env) -{ - m_i_bool_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -void my_struct_test(CORBA_Object oe_obj, - m_b* a, - m_b* b, - m_b* c, - CORBA_Environment *oe_env) -{ - /* printf("struct test !\n"); */ -} - -m_i_struct_test__rs* m_i_struct_test__cb(CORBA_Object oe_obj, - m_b* a, - m_b* b, - m_b* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_struct_test__rs*) (my_struct_test); -} - -/* OK */ -m_i_struct2_test__rs* m_i_struct2_test__cb(CORBA_Object oe_obj, - m_es* a, - m_es* b, - m_es* c, - CORBA_Environment *oe_env) -{ - m_i_struct2_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -/* XXX Commented out -m_i_struct3_test__rs* m_i_struct3_test__cb(CORBA_Object oe_obj, - m_simple* a, - m_simple* b, - m_simple* c, - CORBA_Environment *oe_env) -{ - m_i_struct3_test__rs* rs = NULL; - *a = *b; - *c = *b; - return rs; -} -*/ - -/* OK */ -m_i_seq1_test__rs* m_i_seq1_test__cb(CORBA_Object oe_obj, - m_bseq** a, - m_bseq* b, - m_bseq** c, - CORBA_Environment *oe_env) -{ - m_i_seq1_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - - -/* OK */ -m_i_seq2_test__rs* m_i_seq2_test__cb(CORBA_Object oe_obj, - m_aseq** a, - m_aseq* b, - m_aseq** c, - CORBA_Environment *oe_env) -{ - m_i_seq2_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_seq3_test__rs* m_i_seq3_test__cb(CORBA_Object oe_obj, - m_lseq** a, - m_lseq* b, - m_lseq** c, - CORBA_Environment *oe_env) -{ - m_i_seq3_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_seq4_test__rs* m_i_seq4_test__cb(CORBA_Object oe_obj, - m_ssstr3** a, - m_ssstr3* b, - m_ssstr3** c, - CORBA_Environment *oe_env) -{ - m_i_seq4_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_seq5_test__rs* m_i_seq5_test__cb(CORBA_Object oe_obj, - m_ssarr3** a, - m_ssarr3* b, - m_ssarr3** c, - CORBA_Environment *oe_env) -{ - m_i_seq5_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_array1_test__rs* m_i_array1_test__cb(CORBA_Object oe_obj, - m_arr1 a, - m_arr1 b, - m_arr1 c, - CORBA_Environment *oe_env) -{ - int i; - m_i_array1_test__rs* rs = NULL; - - for (i = 0; i < 500; i++) { - a[i] = b[i]; - c[i] = b[i]; - } - return rs; -} - -/* OK */ -m_i_array2_test__rs* m_i_array2_test__cb(CORBA_Object oe_obj, - m_dd a, - m_dd b, - m_dd c, - CORBA_Environment *oe_env) -{ - int i,j; - m_i_array2_test__rs* rs = NULL; - - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) { - a[i][j] = b[i][j]; - c[i][j] = b[i][j]; - } - return rs; -} - - -/* OK */ -m_i_enum_test__rs* m_i_enum_test__cb(CORBA_Object oe_obj, - m_fruit* a, - m_fruit* b, - m_fruit* c, - CORBA_Environment *oe_env) -{ - m_i_enum_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -m_i_string1_test__rs* m_i_string1_test__cb(CORBA_Object oe_obj, - char ** a, - char * b, - char ** c, - CORBA_Environment *oe_env) -{ - m_i_string1_test__rs* rs = NULL; - - /*printf("\nString in ------> %s\n\n",b);*/ - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_string2_test__rs* m_i_string2_test__cb(CORBA_Object oe_obj, - m_sseq** a, - m_sseq* b, - m_sseq** c, - CORBA_Environment *oe_env) -{ - m_i_string2_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_string3_test__rs* m_i_string3_test__cb(CORBA_Object oe_obj, - char ** a, - char * b, - char ** c, - CORBA_Environment *oe_env) -{ - m_i_string3_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -m_i_string4_test__rs* m_i_string4_test__cb(CORBA_Object oe_obj, - m_strRec** a, - m_strRec* b, - m_strRec** c, - CORBA_Environment *oe_env) -{ - *a = b; - *c = b; - - return (m_i_string4_test__rs*) NULL; -} - -/* OK */ -m_i_wstring1_test__rs* m_i_wstring1_test__cb(CORBA_Object oe_obj, - CORBA_wchar ** a, - CORBA_wchar * b, - CORBA_wchar ** c, - CORBA_Environment *oe_env) -{ - int tmp; - m_i_wstring1_test__rs* rs = NULL; - - /*printf("\nString in ------> %s\n\n",b);*/ - - for(tmp = 0; tmp < 5; tmp++) - fprintf(stderr,"\np[%d] = %ld\n", tmp, b[tmp]); - *a = b; - *c = b; - return rs; -} - - -/* OK */ -m_i_pid_test__rs* m_i_pid_test__cb(CORBA_Object oe_obj, - erlang_pid* a, - erlang_pid* b, - erlang_pid* c, - CORBA_Environment *oe_env) -{ - m_i_pid_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -m_i_port_test__rs* m_i_port_test__cb(CORBA_Object oe_obj, - erlang_port* a, - erlang_port* b, - erlang_port* c, - CORBA_Environment *oe_env) -{ - m_i_port_test__rs* rs = NULL; - - strcpy((*a).node,(*b).node); - (*a).id = (*b).id; - (*a).creation = 0; - - strcpy((*c).node,(*b).node); - (*c).id = (*b).id; - (*c).creation = 0; - return rs; -} - -/* OK */ -m_i_ref_test__rs* m_i_ref_test__cb(CORBA_Object oe_obj, - erlang_ref* a, - erlang_ref* b, - erlang_ref* c, - CORBA_Environment *oe_env) -{ - - m_i_ref_test__rs* rs = NULL; - - strcpy((*a).node,(*b).node); - /*(*a).id = (*b).id;*/ - (*a).len = (*b).len; - (*a).n[0] = (*b).n[0]; - (*a).n[1] = (*b).n[1]; - (*a).n[2] = (*b).n[2]; - (*a).creation = 0; - - strcpy((*c).node,(*b).node); - /*(*c).id = (*b).id;*/ - (*c).len = (*b).len; - (*c).n[0] = (*b).n[0]; - (*c).n[1] = (*b).n[1]; - (*c).n[2] = (*b).n[2]; - (*c).creation = 0; - return rs; -} - -/* OK */ -m_i_term_test__rs* m_i_term_test__cb(CORBA_Object oe_obj, - ETERM** a, - ETERM** b, - ETERM** c, - CORBA_Environment *oe_env) -{ - m_i_term_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -m_i_typedef_test__rs* m_i_typedef_test__cb(CORBA_Object oe_obj, - long* a, - ETERM** b, - erlang_port* c, - ETERM** d , - erlang_port* e, - CORBA_Environment *oe_env) -{ - m_i_typedef_test__rs* rs = NULL; - - *d = *b; - strcpy((*e).node,(*c).node); - (*e).id = (*c).id; - (*e).creation = 0; - *a = 4711; - return rs; -} - -/* OK */ -m_i_inline_sequence_test__rs* m_i_inline_sequence_test__cb( - CORBA_Object oe_obj, - m_s** a, - m_s* b, - m_s** c, - CORBA_Environment *oe_env) -{ - m_i_inline_sequence_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_term_sequence_test__rs* m_i_term_sequence_test__cb( - CORBA_Object oe_obj, - m_etseq** a, - m_etseq* b, - m_etseq** c, - CORBA_Environment *oe_env) -{ - m_i_term_sequence_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - - -/* OK */ -m_i_term_struct_test__rs* m_i_term_struct_test__cb(CORBA_Object oe_obj, - m_et* a, - m_et* b, - m_et* c, - CORBA_Environment *oe_env) -{ - m_i_term_struct_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/erl_c_test.idl b/lib/ic/test/erl_client_c_server_SUITE_data/erl_c_test.idl deleted file mode 100644 index 6ed28f0822..0000000000 --- a/lib/ic/test/erl_client_c_server_SUITE_data/erl_c_test.idl +++ /dev/null @@ -1,175 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2002-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% - -#include "erlang.idl" - - -const short TestConst = 1; - -module m { - - const short TestConst = 2; - - struct b { - long l; - char c; - }; - - struct simple { - long l; - b b_t; - }; - - enum fruit {orange, banana, apple, peach, pear}; - - typedef sequence<long> lseq; - - typedef sequence<b> bseq; - - struct a { - long l; - bseq y; - double d; - }; - - typedef sequence<a> aseq; - - typedef sequence<string> sseq; - typedef string str; - typedef long myLong; - - typedef long arr1[500], dd[2][3]; - - typedef erlang::term apa; - typedef erlang::port banan; - - typedef sequence<erlang::term> etseq; - - struct s { - long l; - sequence<long> sl; - }; - - struct es { - fruit f; - myLong l; - }; - - struct et { - erlang::term e; - long l; - }; - - - typedef sequence<char> str1; - typedef string<12> str2; - typedef char str3[3]; - - typedef sequence<string> sstr3; // sequence of string - typedef sequence<sstr3> ssstr3; // sequence of sequences of strings - - typedef long arr3[3]; // array of long - typedef sequence<arr3> sarr3; // sequence of array - typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings - - struct strRec{ - boolean bb; - string str4; - long str7[3][2]; - sequence<char> str5; - string<12> str6; - str3 str8; - str2 str9; - str1 str10; - }; - - - struct dyn { - long l; - sequence<long> sl; - }; - typedef dyn arr2[1][2]; - - - interface i { - - const short TestConst = 3; - - //arr2 suck(in arr2 x, out arr2 y ); - - ///////////////////////////////// attribute long l; - - // simple types - void void_test(); - long long_test(in long a, out long a1); - long long longlong_test(in long long a, out long long a1); - unsigned short ushort_test(in unsigned short a, out unsigned short a1); - unsigned long ulong_test(in unsigned long a, out unsigned long a1); - unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1); - double double_test(in double a, out double a1); - char char_test(in char a, out char a1); - wchar wchar_test(in wchar a, out wchar a1); - octet octet_test(in octet a, out octet a1); - boolean bool_test(in boolean a, out boolean a1); - - // Seq. and struct tests - b struct_test(in b a, out b a1); - es struct2_test(in es a, out es a1); - //simple struct3_test(in simple x, out simple y); - bseq seq1_test(in bseq a, out bseq a1); - aseq seq2_test(in aseq a, out aseq a1); - lseq seq3_test(in lseq a, out lseq a1); - ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1); - ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1); - - // Array tests - arr1 array1_test(in arr1 a, out arr1 a1); - dd array2_test(in dd a, out dd a1); - - // enum test - fruit enum_test(in fruit a, out fruit a1); - - // string tests - string string1_test(in string a, out string a1); - wstring wstring1_test(in wstring a, out wstring a1); - sseq string2_test(in sseq a, out sseq a1); - str string3_test(in str a, out str a1); - strRec string4_test(in strRec a, out strRec a1); - - // Special erlang types - erlang::pid pid_test(in erlang::pid a, out erlang::pid a1); - erlang::port port_test(in erlang::port a, out erlang::port a1); - erlang::ref ref_test(in erlang::ref a, out erlang::ref a1); - erlang::term term_test(in erlang::term a, out erlang::term a1); - - // typedef test - long typedef_test(in apa a, in banan b, out apa a1, out banan b1); - - // inlined seq. test - s inline_sequence_test(in s a, out s a1); - - // term seq. test - etseq term_sequence_test(in etseq a, out etseq a1); - // term struct test - et term_struct_test(in et a, out et a1); - - }; - -}; diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/erl_client.erl b/lib/ic/test/erl_client_c_server_SUITE_data/erl_client.erl deleted file mode 100644 index 139e2d7661..0000000000 --- a/lib/ic/test/erl_client_c_server_SUITE_data/erl_client.erl +++ /dev/null @@ -1,332 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-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% -%% -%% --module(erl_client). - --export([void_test/2, long_test/2, longlong_test/2, ushort_test/2, - ulong_test/2, ulonglong_test/2, double_test/2, char_test/2, - wchar_test/2, octet_test/2, bool_test/2, struct_test/2, - struct2_test/2, seq1_test/2, seq2_test/2, seq3_test/2, - seq4_test/2, seq5_test/2, array1_test/2, array2_test/2, - enum_test/2, string1_test/2, wstring1_test/2, string2_test/2, - string3_test/2, string4_test/2, pid_test/2, port_test/2, - ref_test/2, term_test/2, typedef_test/2, - inline_sequence_test/2, term_sequence_test/2, - term_struct_test/2 - -]). - --include("m.hrl"). --include("m_i.hrl"). --include("oe_erl_c_test.hrl"). - -%%b -void_test(Node, Timeout) -> - Ret = m_i:void_test({olsson, Node}, Timeout), - Ret == void. % XXX Not documented -%%e - -%%b -long_test(Node, Timeout) -> - In = max_long(), - {Ret, Out} = m_i:long_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -longlong_test(Node, Timeout) -> - In = 65537, - {Ret, Out} = m_i:longlong_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -ushort_test(Node, Timeout) -> - In = max_ushort(), - {Ret, Out} = m_i:ushort_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -ulong_test(Node, Timeout) -> - In = max_ulong(), - {Ret, Out} = m_i:ulong_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -ulonglong_test(Node, Timeout) -> - In = 65537, - {Ret, Out} = m_i:ulonglong_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -double_test(Node, Timeout) -> - In = 37768.93, - {Ret, Out} = m_i:double_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -char_test(Node, Timeout) -> - In = 80, - {Ret, Out} = m_i:char_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -wchar_test(Node, Timeout) -> - In = 4097, - {Ret, Out} = m_i:wchar_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -octet_test(Node, Timeout) -> - In = 255, - {Ret, Out} = m_i:octet_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -bool_test(Node, Timeout) -> - In = false, - {Ret, Out} = m_i:bool_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -struct_test(Node, Timeout) -> - In = #m_b{l = max_long(), c = $a}, - {Ret, Out} = m_i:struct_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -struct2_test(Node, Timeout) -> - In = #m_es{ f = banana, l = max_long()}, - {Ret, Out} = m_i:struct2_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq1_test(Node, Timeout) -> - B1 = #m_b{l = max_long(), c = $a}, - B2 = #m_b{l = min_long(), c = $b}, - In = [B1, B2], - {Ret, Out} = m_i:seq1_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq2_test(Node, Timeout) -> - B = #m_b{l = max_long(), c = $a}, - A = #m_a{l = min_long(), y = [B, B], d = 4711.31}, - In = [A, A, A], - {Ret, Out} = m_i:seq2_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq3_test(Node, Timeout) -> - In = [max_long(), min_long(), max_long()], - {Ret, Out} = m_i:seq3_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq4_test(Node, Timeout) -> - In = [["hello", "all"], ["Erlang", "users", "!"]], - {Ret, Out} = m_i:seq4_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq5_test(Node, Timeout) -> - Arr3 = mk_array(3, max_long()), - In = [[Arr3, Arr3], [Arr3, Arr3, Arr3]], - {Ret, Out} = m_i:seq5_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -array1_test(Node, Timeout) -> - In = mk_array(500, min_long()), - {Ret, Out} = m_i:array1_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -array2_test(Node, Timeout) -> - In = mk_array(2, mk_array(3, min_long())), - {Ret, Out} = m_i:array2_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -enum_test(Node, Timeout) -> - In = banana, - {Ret, Out} = m_i:enum_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -string1_test(Node, Timeout) -> - In = "Developing Erlang applications is fun!", - {Ret, Out} = m_i:string1_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -wstring1_test(Node, Timeout) -> - In = [1047| "eveloping Erlang applications is fun!"], - {Ret, Out} = m_i:wstring1_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -string2_test(Node, Timeout) -> - In = ["Developing Erlang applications ", "is fun!"], - {Ret, Out} = m_i:string2_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -string3_test(Node, Timeout) -> - In = "Developing Erlang applications is fun!", - {Ret, Out} = m_i:string3_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -string4_test(Node, Timeout) -> - - In = #m_strRec{ - bb = true, - str4 = "Developing Erlang applications " - "is fun!", - str7 = mk_array(3, mk_array(2, max_long())), - str5 = [$a, $b, $c, $d, $e, $f], - str6 = "123456789012", - str8 = {$x, $y, $x}, - str9 = "123456789012", - str10 = [$a, $b, $c, $d, $e, $f] - }, - {Ret, Out} = m_i:string4_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -pid_test(Node, Timeout) -> - In = self(), - {Ret, Out} = m_i:pid_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -port_test(Node, Timeout) -> - In = get(port_test_port), - {Ret, Out} = m_i:port_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -ref_test(Node, Timeout) -> - In = make_ref(), - {Ret, Out} = m_i:ref_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -term_test(Node, Timeout) -> - In = {[a, b], 17, kalle}, - {Ret, Out} = m_i:term_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -typedef_test(Node, Timeout) -> - In1 = {nisse, [1, 2], olsson}, - In2 = get(port_test_port), - {Ret, Out1, Out2} = m_i:typedef_test({olsson, Node}, Timeout, In1, In2), - %% XXX Should check that Ret is an integer. - (Out1 == In1) and (Out2 == In2). -%%e - -%%b -inline_sequence_test(Node, Timeout) -> - In = #m_s{l = min_long(), sl = [max_long(), min_long()]}, - {Ret, Out} = m_i:inline_sequence_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -term_sequence_test(Node, Timeout) -> - In = lists:duplicate(17, {nisse, [1, 2], {kalle, olsson}}), - {Ret, Out} = m_i:term_sequence_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -term_struct_test(Node, Timeout) -> - In = #m_et{e = {nisse, ["abcde"], {kalle, olsson}}, l = 4711}, - {Ret, Out} = m_i:term_struct_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - - -%% Locals - -mk_array(Es) -> - list_to_tuple(Es). - -mk_array(N, E) -> - mk_array(lists:duplicate(N, E)). - -%% max_short() -> -%% power_of_two(15) - 1. -max_long() -> - power_of_two(31) - 1. -max_longlong() -> - power_of_two(63) - 1. -max_ushort() -> - power_of_two(16) - 1. -max_ulong() -> - power_of_two(32) - 1. -max_ulonglong() -> - power_of_two(64) - 1. - -%% min_short() -> -%% -power_of_two(15). -min_long() -> - -power_of_two(31). -%% min_longlong() -> -%% -power_of_two(63). -%% min_ushort() -> -%% 0. -%% min_ulong() -> -%% 0. -%% min_ulonglong() -> -%% 0. - -power_of_two(N) -> - round(math:pow(2, N)). - diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE.erl b/lib/ic/test/erl_client_c_server_proto_SUITE.erl deleted file mode 100644 index 99eeed01ad..0000000000 --- a/lib/ic/test/erl_client_c_server_proto_SUITE.erl +++ /dev/null @@ -1,298 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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 erl-client/c-server -%%---------------------------------------------------------------------- - - --module(erl_client_c_server_proto_SUITE). --include_lib("common_test/include/ct.hrl"). - --export([init_per_testcase/2, end_per_testcase/2,all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, void_test/1, - long_test/1, longlong_test/1, ushort_test/1, ulong_test/1, - ulonglong_test/1, double_test/1, char_test/1, wchar_test/1, - octet_test/1, bool_test/1, struct_test/1, struct2_test/1, - seq1_test/1, seq2_test/1, seq3_test/1, seq4_test/1, - seq5_test/1, array1_test/1, array2_test/1, enum_test/1, - string1_test/1, string2_test/1, string3_test/1, - string4_test/1, pid_test/1, port_test/1, ref_test/1, - term_test/1, typedef_test/1, inline_sequence_test/1, - term_sequence_test/1, term_struct_test/1, wstring1_test/1]). - --define(DEFAULT_TIMEOUT, 20000). --define(PORT_TIMEOUT, 15000). --define(CALL_TIMEOUT, 5000). - --define(C_SERVER_NODE_NAME, idl_c_server_test). - -%% Add/remove code path and watchdog before/after each test case. -%% -init_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:add_patha(DataDir), - - %% Since other test suites use the module m_i, we have - %% to make sure we are using the right m_i module. - code:purge(m_i), - code:load_file(m_i), - - WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:del_path(DataDir), - WatchDog = proplists:get_value(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> -[void_test, long_test, longlong_test, ushort_test, - ulong_test, ulonglong_test, double_test, char_test, - wchar_test, octet_test, bool_test, struct_test, - struct2_test, seq1_test, seq2_test, seq3_test, - seq4_test, seq5_test, array1_test, array2_test, - enum_test, string1_test, string2_test, string3_test, - string4_test, pid_test, port_test, ref_test, term_test, - typedef_test, inline_sequence_test, term_sequence_test, - term_struct_test, wstring1_test]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -array1_test(Config) -> - do_test(array1_test, Config). - -array2_test(Config) -> - do_test(array2_test, Config). - -bool_test(Config) -> - do_test(bool_test, Config). - -char_test(Config) -> - do_test(char_test, Config). - -double_test(Config) -> - do_test(double_test, Config). - -enum_test(Config) -> - do_test(enum_test, Config). - -inline_sequence_test(Config) -> - do_test(inline_sequence_test, Config). - -longlong_test(Config) -> - do_test(longlong_test, Config). - -long_test(Config) -> - do_test(long_test, Config). - -octet_test(Config) -> - do_test(octet_test, Config). - -pid_test(Config) -> - do_test(pid_test, Config). - -port_test(Config) -> - do_test(port_test, Config). - -ref_test(Config) -> - do_test(ref_test, Config). - -seq1_test(Config) -> - do_test(seq1_test, Config). - -seq2_test(Config) -> - do_test(seq2_test, Config). - -seq3_test(Config) -> - do_test(seq3_test, Config). - -seq4_test(Config) -> - do_test(seq4_test, Config). - -seq5_test(Config) -> - do_test(seq5_test, Config). - -string1_test(Config) -> - do_test(string1_test, Config). - -string2_test(Config) -> - do_test(string2_test, Config). - -string3_test(Config) -> - do_test(string3_test, Config). - -string4_test(Config) -> - do_test(string4_test, Config). - -struct2_test(Config) -> - do_test(struct2_test, Config). - -struct_test(Config) -> - do_test(struct_test, Config). - -term_sequence_test(Config) -> - do_test(term_sequence_test, Config). - -term_struct_test(Config) -> - do_test(term_struct_test, Config). - -term_test(Config) -> - do_test(term_test, Config). - -typedef_test(Config) -> - do_test(typedef_test, Config). - -ulonglong_test(Config) -> - do_test(ulonglong_test, Config). - -ulong_test(Config) -> - do_test(ulong_test, Config). - -ushort_test(Config) -> - do_test(ushort_test, Config). - -void_test(Config) -> - do_test(void_test, Config). - -wchar_test(Config) -> - do_test(wchar_test, Config). - -wstring1_test(Config) -> - do_test(wstring1_test, Config). - - -do_test(Case, Config) -> - %% Trap exits - process_flag(trap_exit, true), - Node = atom_to_list(node()), - [_NodeName, HostName] = string:tokens(Node, "@"), - DataDir = proplists:get_value(data_dir, Config), - %% io:format("~p: data directory: ~p~n", [?MODULE, DataDir]), - Cookie = atom_to_list(erlang:get_cookie()), - ServerNodeName = atom_to_list(?C_SERVER_NODE_NAME), - %% Start C-server node as a port program. We wait for the node - %% to connect to us. - Cmd = filename:join([DataDir, "c_server"]) ++ - " -this-node-name " ++ ServerNodeName ++ - " -peer-node " ++ Node ++ - " -cookie " ++ Cookie, - Port = open_port({spawn, Cmd}, [exit_status, eof, stderr_to_stdout]), - ServerNode = list_to_atom(ServerNodeName ++ "@" ++ HostName), - Res = case wait_for_hidden_node(ServerNode) of - ok -> - %% Need a port for port_test and typedef_test - put(port_test_port, Port), - R = (catch erl_client:Case(ServerNode, ?CALL_TIMEOUT)), - case wait_for_completion(Port) of - {error, timeout} -> - kill_off_node(ServerNode); - _ -> - ok - end, - R; - {error, timeout} -> - case wait_for_completion(Port) of - {error, timeout} -> - kill_off_node(ServerNode); - _ -> - ok - end, - {error, timeout} - end, - process_flag(trap_exit, false), - true = Res. - - -%% Wait for eof *and* exit status, but return if exit status indicates -%% an error, or we have been waiting more than PORT_TIMEOUT seconds. -%% -wait_for_completion(Port) -> - wait_for_completion(Port, 0). - -wait_for_completion(Port, N) when N < 2 -> - receive - {Port, {data, Bytes}} -> - %% Relay output - io:format("~s", [Bytes]), - wait_for_completion(Port, N); - {Port, {exit_status, 0}} -> - wait_for_completion(Port, N + 1); - {Port, {exit_status, Status}} -> - {error, Status}; - {Port, eof} -> - wait_for_completion(Port, N + 1); - {'EXIT', Port, Reason} -> - io:format("Port exited with reason: ~w~n", [Reason]), - wait_for_completion(Port, N); - {'EXIT', From, Reason} -> - io:format("Got unexpected exit: ~p~n", [{'EXIT', From, Reason}]), - wait_for_completion(Port, N) - after ?PORT_TIMEOUT -> - {error, timeout} - end; -wait_for_completion(_, _) -> - ok. - -wait_for_hidden_node(Node) -> - Times = ?DEFAULT_TIMEOUT div 100, - wait_for_hidden_node(Node, Times, 100). - -wait_for_hidden_node(Node, Times, WaitTime) when Times > 0 -> - io:format("Waiting for hidden node: ~p~n", [Node]), - case lists:member(Node, erlang:nodes(hidden)) of - true -> - ok; - false -> - delay(WaitTime), - wait_for_hidden_node(Node, Times - 1, WaitTime) - end; -wait_for_hidden_node(_Node, _, _WaitTime) -> - {error, timeout}. - -kill_off_node(Node) -> - catch rpc:cast(Node, erlang, halt, [1]). - -delay(Time) -> - receive - after Time -> - ok - end. - - - - diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/Makefile.src b/lib/ic/test/erl_client_c_server_proto_SUITE_data/Makefile.src deleted file mode 100644 index 4ef7a74cde..0000000000 --- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/Makefile.src +++ /dev/null @@ -1,160 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2004-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% -# -# -# Makefile.src for erl_client_c_server test -# Note: This file *must* work for both Unix and Windows -# -# We use both `rm' (Unix) and `del' (Windows) for removing files, but -# with a `-' in front so that the error in not finding `rm' (`del') on -# Windows (Unix) is ignored. -# -# VxWorks? XXX -# - -.SUFFIXES: -.SUFFIXES: .c .h .erl .idl @obj@ .@EMULATOR@ - - -# Variables from ts: -# - -ERL_INCLUDE = @erl_include@ - -IC_INCLUDE_PATH = @ic_include_path@ -IC_LIB = @ic_lib@ - -ERL_INTERFACE_INCLUDE = @erl_interface_include@ -ERL_INTERFACE_LIB = @erl_interface_lib@ -ERL_INTERFACE_EILIB = @erl_interface_eilib@ -ERL_INTERFACE_THREADLIB = @erl_interface_threadlib@ -ERL_INTERFACE_SOCK_LIBS = @erl_interface_sock_libs@ - -CC = @CC@ -## XXX Should set warning flag with a DEBUG_FLAG -CFLAGS = @CFLAGS@ @DEFS@ -I$(ERL_INCLUDE) \ - -I$(IC_INCLUDE_PATH) -I$(ERL_INTERFACE_INCLUDE) - -LD = @LD@ -LDFLAGS = @CROSSLDFLAGS@ -LIBS = $(IC_LIB) $(ERL_INTERFACE_LIB) $(ERL_INTERFACE_EILIB) \ - $(ERL_INTERFACE_THREADLIB) @LIBS@ $(ERL_INTERFACE_SOCK_LIBS) -ERLC = erlc - -# Generated C header files -GEN_H_FILES = \ - m__s.h \ - m_i__s.h \ - oe_erl_c_test__s.h - -# Generated C files -GEN_C_FILES = \ - m__s.c \ - m_i__s.c \ - oe_code_m_a.c \ - oe_code_m_arr1.c \ - oe_code_m_arr2.c \ - oe_code_m_arr3.c \ - oe_code_m_aseq.c \ - oe_code_m_b.c \ - oe_code_m_bseq.c \ - oe_code_m_dd.c \ - oe_code_m_dyn.c \ - oe_code_m_dyn_sl.c \ - oe_code_m_es.c \ - oe_code_m_et.c \ - oe_code_m_etseq.c \ - oe_code_m_fruit.c \ - oe_code_m_lseq.c \ - oe_code_m_s.c \ - oe_code_m_s_sl.c \ - oe_code_m_sarr3.c \ - oe_code_m_simple.c \ - oe_code_m_ssarr3.c \ - oe_code_m_sseq.c \ - oe_code_m_ssstr3.c \ - oe_code_m_sstr3.c \ - oe_code_m_str1.c \ - oe_code_m_str3.c \ - oe_code_m_strRec.c \ - oe_code_m_strRec_str5.c \ - oe_code_m_strRec_str7.c \ - oe_erl_c_test__s.c - -GEN_HRL_FILES = \ - m.hrl \ - m_i.hrl \ - oe_erl_c_test.hrl - -GEN_ERL_FILES = \ - m.erl \ - m_arr2.erl \ - m_arr3.erl \ - m_i.erl \ - m_str3.erl \ - oe_erl_c_test.erl - -C_FILES = $(GEN_C_FILES) c_server.c callbacks.c - -OBJS = $(C_FILES:.c=@obj@) - -PGMS = c_server@exe@ - -ERL_FILES = $(GEN_ERL_FILES) erl_client.erl - -EBINS = $(ERL_FILES:.erl=.@EMULATOR@) - - -all: $(PGMS) $(EBINS) - -$(GEN_ERL_FILES) $(GEN_HRL_FILES): c_erl_test.built_erl -$(GEN_C_FILES) $(GEN_H_FILES): c_erl_test.built_c -$(OBJS): $(GEN_C_FILES) $(GEN_H_FILES) -$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES) - -clean: - -rm -f $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -del /F /Q $(OBJS) $(GEN_C_FILES) $(GEN_H_FILES) $(PGMS) \ - $(EBINS) $(GEN_ERL_FILES) $(GEN_HRL_FILES) \ - c_erl_test.built_erl c_erl_test.built_c - -$(PGMS): $(OBJS) - $(LD) $(LDFLAGS) -o $@ $(OBJS) $(LIBS) - -c_erl_test.built_c: erl_c_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,c_server}" \ - "+{scoped_op_calls,true}" erl_c_test.idl - echo done > c_erl_test.built_c - -# If we have scoped operation calls for C, we must have that for -# Erlang as well, if we use the m_i.erl file for calling the server. - -c_erl_test.built_erl: erl_c_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" \ - "+{scoped_op_calls,true}" "+{timeout,true}" erl_c_test.idl - echo done > c_erl_test.built_erl - -.c@obj@: - $(CC) -c -o $*@obj@ $(CFLAGS) $< - -.erl.@EMULATOR@: - $(ERLC) -W -I $(IC_INCLUDE_PATH) $< - diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/c_server.c b/lib/ic/test/erl_client_c_server_proto_SUITE_data/c_server.c deleted file mode 100644 index e2ba5bd5b6..0000000000 --- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/c_server.c +++ /dev/null @@ -1,300 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-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% - * - */ -/* C-server for test of IC. - * - * The C-node implemented here connects to its peer node, waits for - * one message, evaluates the message, returns an result message, and - * terminates. - * - * TODO: - * - * 1. XXX #includes for VxWorks, Windows - */ - -#include <stdio.h> -#include <stdlib.h> - -#ifndef __WIN32__ -# include <unistd.h> -#endif - -#include <string.h> - -#ifdef __WIN32__ -# include <time.h> -# include <sys/timeb.h> -#elif defined VXWORKS -# include <time.h> -# include <sys/times.h> -#else -# include <sys/time.h> -#endif - -#include <ctype.h> - -#ifdef __WIN32__ -# include <winsock2.h> -# include <windows.h> -#else -# include <sys/types.h> -# include <sys/socket.h> -# include <netinet/in.h> -# include <arpa/inet.h> -# include <netdb.h> -#endif - -#include "ic.h" -#include "ei.h" -#include "erl_interface.h" -#include "eicode.h" -#include "m_i__s.h" -#include "m__s.h" - -#ifdef __WIN32__ -typedef struct { - long tv_sec; - long tv_usec; -} MyTimeval; -#else -typedef struct timeval MyTimeval; -#endif -static void my_gettimeofday(MyTimeval *tv); -static void showtime(MyTimeval *start, MyTimeval *stop); -static void usage(void); -static void done(int r); - -#define HOSTNAMESZ 255 -#define NODENAMESZ 512 -#define INBUFSZ 10 -#define OUTBUFSZ 0 -#define MAXTRIES 5 - -static char *progname; - -/* main */ -#ifdef VXWORKS -int c_server(int argc, char **argv) -#else -int main(int argc, char **argv) -#endif -{ - struct hostent *hp; - MyTimeval start, stop; - int i, fd, ires, tries; - CORBA_Environment *env; - char *this_node_name = NULL; - char *peer_node = NULL; - char *cookie = NULL; - char host[HOSTNAMESZ + 1]; - char this_node[NODENAMESZ + 1]; - erlang_msg msg; - int status, loop; - -#ifdef __WIN32__ - WORD wVersionRequested; - WSADATA wsaData; - - wVersionRequested = MAKEWORD(2, 0); - - if (WSAStartup(wVersionRequested, &wsaData) != 0) { - fprintf(stderr, "Could not load winsock2 v2.0 compatible DLL"); - exit(1); - } -#endif - - progname = argv[0]; - host[HOSTNAMESZ] = '\0'; - if (gethostname(host, HOSTNAMESZ + 1) < 0) { - fprintf(stderr, "Can't find own hostname\n"); - done(1); - } - if ((hp = gethostbyname(host)) == 0) { - fprintf(stderr, "Can't get ip address for host %s\n", host); - done(1); - } - for (i = 1; i < argc; i++) { - if (strcmp(argv[i], "-help") == 0) { - usage(); - done(0); - } else if (strcmp(argv[i], "-this-node-name") == 0) { - i++; - this_node_name = argv[i]; - } else if (strcmp(argv[i], "-peer-node") == 0) { - i++; - peer_node = argv[i]; - } else if (strcmp(argv[i], "-cookie") == 0) { - i++; - cookie = argv[i]; - } else { - fprintf(stderr, "Error : invalid argument \"%s\"\n", argv[i]); - usage(); - done(1); - } - } - - if (this_node_name == NULL || peer_node == NULL || cookie == NULL) { - fprintf(stderr, "Error: missing option\n"); - usage(); - done(1); - } - - /* Behead hostname at first dot */ - for (i=0; host[i] != '\0'; i++) { - if (host[i] == '.') { host[i] = '\0'; break; } - } - sprintf(this_node, "%s@%s", this_node_name, host); - - fprintf(stderr, "c_server: this node: \"%s\"\n", this_node); - fprintf(stderr, "c_server: peer node: \"%s\"\n", peer_node); - - /* initialize erl_interface */ - erl_init(NULL, 0); - - for (tries = 0; tries < MAXTRIES; tries++) { - /* connect to peer node */ - ires = erl_connect_xinit(host, this_node_name, this_node, - (struct in_addr *)*hp->h_addr_list, - cookie, 0); - fprintf(stderr, "c_server: erl_connect_xinit(): %d\n", ires); - - fd = erl_connect(peer_node); - fprintf(stderr, "c_server: erl_connect(): %d\n", fd); - if (fd >= 0) - break; - fprintf(stderr, "c_server: cannot connect, retrying\n"); - } - if (fd < 0) { - fprintf(stderr, "c_server: cannot connect, exiting\n"); - done(1); - } - env = CORBA_Environment_alloc(INBUFSZ, OUTBUFSZ); - env->_fd = fd; - - status = 1; - loop = 1; - my_gettimeofday(&start); - while (status >= 0 && loop > 0) { - status = ei_receive_encoded(env->_fd, &env->_inbuf, &env->_inbufsz, - &msg, &env->_iin); - switch(status) { - case ERL_SEND: - case ERL_REG_SEND: - /* get result */ - m_i__switch(NULL, env); - switch(env->_major) { - case CORBA_NO_EXCEPTION: - break; - case CORBA_SYSTEM_EXCEPTION: - fprintf(stderr, "Request failure, reason : %s\n", - (char *) CORBA_exception_value(env)); - CORBA_exception_free(env); - break; - default: /* Should not happen */ - CORBA_exception_free(env); - break; - } - /* send back result data */ - if (env->_iout > 0) - ei_send_encoded(env->_fd, &env->_caller, env->_outbuf, - env->_iout); - loop = 0; - break; - case ERL_TICK: - break; - default: - if (status < 0) { - fprintf(stderr, "Status negative: %d\n", status); - loop = 0; - } - break; - } - } - my_gettimeofday(&stop); - showtime(&start, &stop); - - erl_close_connection(fd); - - CORBA_free(env->_inbuf); - CORBA_free(env->_outbuf); - CORBA_free(env); - if (status < 0) - done(-status); - else - done(0); -} - -static void usage() -{ - fprintf(stderr, "Usage: %s [-help] -this-node-name <name> " - "-peer-node <nodename> -cookie <cookie>\n", progname); - fprintf(stderr, "Example:\n %s -this-node-name kalle " - "-peer-node olle@home -cookie oa678er\n", progname); -} - -static void done(int r) -{ -#ifdef __WIN32__ - WSACleanup(); -#endif - exit(r); -} - -static void showtime(MyTimeval *start, MyTimeval *stop) -{ - MyTimeval elapsed; - - elapsed.tv_sec = stop->tv_sec - start->tv_sec; - elapsed.tv_usec = stop->tv_usec - start->tv_usec; - while (elapsed.tv_usec < 0) { - elapsed.tv_sec -= 1; - elapsed.tv_usec += 1000000; - } - fprintf(stderr,"%ld.%06ld seconds\n",elapsed.tv_sec, elapsed.tv_usec); -} - - - -static void my_gettimeofday(MyTimeval *tv) -#ifdef __WIN32__ -#define EPOCH_JULIAN_DIFF 11644473600i64 -{ - SYSTEMTIME t; - FILETIME ft; - LONGLONG lft; - - GetSystemTime(&t); - SystemTimeToFileTime(&t, &ft); - memcpy(&lft, &ft, sizeof(lft)); - tv->tv_usec = (long) ((lft / 10i64) % 1000000i64); - tv->tv_sec = (long) ((lft / 10000000i64) - EPOCH_JULIAN_DIFF); -} -#elif defined VXWORKS -{ - int rate = sysClkRateGet(); /* Ticks per second */ - unsigned long ctick = tickGet(); - tv->tv_sec = ctick / rate; /* secs since reboot */ - tv->tv_usec = ((ctick - (tv->tv_sec * rate))*1000000)/rate; -} -#else -{ - gettimeofday(tv, NULL); -} -#endif diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c b/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c deleted file mode 100644 index bed1dc2dd3..0000000000 --- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c +++ /dev/null @@ -1,611 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-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% - * - */ -#include <stdio.h> -#include <stdlib.h> -#ifndef __WIN32__ -# include <unistd.h> -#endif -#include <string.h> -#include <ctype.h> -#include <ic.h> -#include <erl_interface.h> -#include <ei.h> -#include "m_i__s.h" - - - -/* OK */ - -void my_void_test(CORBA_Object oe_obj, - CORBA_Environment *oe_env) -{ - /* printf("void test !\n"); */ -} - -m_i_void_test__rs* m_i_void_test__cb(CORBA_Object oe_obj, - CORBA_Environment *oe_env) -{ - return (m_i_void_test__rs*) (my_void_test); -} - - - -/* OK */ - -void my_long_test(CORBA_Object oe_obj, - long* a, - long* b, - long* c, - CORBA_Environment *oe_env) -{ - /* printf("long test !\n"); */ -} - - -m_i_long_test__rs* m_i_long_test__cb(CORBA_Object oe_obj, - long* a, - long* b, - long* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_long_test__rs*) (my_long_test); -} - -/* OK */ - -void my_longlong_test(CORBA_Object oe_obj, - CORBA_long_long* a, - CORBA_long_long* b, - CORBA_long_long* c, - CORBA_Environment *oe_env) -{ - /* printf("long test !\n"); */ -} - -m_i_longlong_test__rs* m_i_longlong_test__cb(CORBA_Object oe_obj, - CORBA_long_long* a, - CORBA_long_long* b, - CORBA_long_long* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_longlong_test__rs*) (my_longlong_test); -} - -/* OK */ -void my_ulong_test(CORBA_Object oe_obj, - unsigned long* a, - unsigned long* b, - unsigned long* c, - CORBA_Environment *oe_env) -{ - /* printf("ulong test !\n"); */ -} - -m_i_ulong_test__rs* m_i_ulong_test__cb(CORBA_Object oe_obj, - unsigned long* a, - unsigned long* b, - unsigned long* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_ulong_test__rs*) (my_ulong_test); -} - -/* OK */ -void my_ulonglong_test(CORBA_Object oe_obj, - CORBA_unsigned_long_long* a, - CORBA_unsigned_long_long* b, - CORBA_unsigned_long_long* c, - CORBA_Environment *oe_env) -{ - /* printf("ulong test !\n"); */ -} - -m_i_ulonglong_test__rs* m_i_ulonglong_test__cb(CORBA_Object oe_obj, - CORBA_unsigned_long_long* a, - CORBA_unsigned_long_long* b, - CORBA_unsigned_long_long* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_ulonglong_test__rs*) (my_ulonglong_test); -} - -m_i_ushort_test__rs* m_i_ushort_test__cb(CORBA_Object oe_obj, - unsigned short* a, - unsigned short* b, - unsigned short* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_ushort_test__rs*) NULL; -} - - -/* OK */ -void my_double_test(CORBA_Object oe_obj, - double* a, - double* b, - double* c, - CORBA_Environment *oe_env) -{ - /* printf("double test !\n"); */ -} - -m_i_double_test__rs* m_i_double_test__cb(CORBA_Object oe_obj, - double* a, - double* b, - double* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_double_test__rs*) (my_double_test); -} - -/* OK */ -m_i_char_test__rs* m_i_char_test__cb(CORBA_Object oe_obj, - char* a, - char* b, - char* c, - CORBA_Environment *oe_env) -{ - m_i_char_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - - -/* OK */ -m_i_wchar_test__rs* m_i_wchar_test__cb(CORBA_Object oe_obj, - CORBA_wchar* a, - CORBA_wchar* b, - CORBA_wchar* c, - CORBA_Environment *oe_env) -{ - m_i_wchar_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -m_i_octet_test__rs* m_i_octet_test__cb(CORBA_Object oe_obj, - char* a, - char* b, - char* c, - CORBA_Environment *oe_env) -{ - m_i_octet_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -m_i_bool_test__rs* m_i_bool_test__cb(CORBA_Object oe_obj, - CORBA_boolean* a, - CORBA_boolean* b, - CORBA_boolean* c, - CORBA_Environment *oe_env) -{ - m_i_bool_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -void my_struct_test(CORBA_Object oe_obj, - m_b* a, - m_b* b, - m_b* c, - CORBA_Environment *oe_env) -{ - /* printf("struct test !\n"); */ -} - -m_i_struct_test__rs* m_i_struct_test__cb(CORBA_Object oe_obj, - m_b* a, - m_b* b, - m_b* c, - CORBA_Environment *oe_env) -{ - *a = *b; - *c = *b; - return (m_i_struct_test__rs*) (my_struct_test); -} - -/* OK */ -m_i_struct2_test__rs* m_i_struct2_test__cb(CORBA_Object oe_obj, - m_es* a, - m_es* b, - m_es* c, - CORBA_Environment *oe_env) -{ - m_i_struct2_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -/* XXX Commented out -m_i_struct3_test__rs* m_i_struct3_test__cb(CORBA_Object oe_obj, - m_simple* a, - m_simple* b, - m_simple* c, - CORBA_Environment *oe_env) -{ - m_i_struct3_test__rs* rs = NULL; - *a = *b; - *c = *b; - return rs; -} -*/ - -/* OK */ -m_i_seq1_test__rs* m_i_seq1_test__cb(CORBA_Object oe_obj, - m_bseq** a, - m_bseq* b, - m_bseq** c, - CORBA_Environment *oe_env) -{ - m_i_seq1_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - - -/* OK */ -m_i_seq2_test__rs* m_i_seq2_test__cb(CORBA_Object oe_obj, - m_aseq** a, - m_aseq* b, - m_aseq** c, - CORBA_Environment *oe_env) -{ - m_i_seq2_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_seq3_test__rs* m_i_seq3_test__cb(CORBA_Object oe_obj, - m_lseq** a, - m_lseq* b, - m_lseq** c, - CORBA_Environment *oe_env) -{ - m_i_seq3_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_seq4_test__rs* m_i_seq4_test__cb(CORBA_Object oe_obj, - m_ssstr3** a, - m_ssstr3* b, - m_ssstr3** c, - CORBA_Environment *oe_env) -{ - m_i_seq4_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_seq5_test__rs* m_i_seq5_test__cb(CORBA_Object oe_obj, - m_ssarr3** a, - m_ssarr3* b, - m_ssarr3** c, - CORBA_Environment *oe_env) -{ - m_i_seq5_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_array1_test__rs* m_i_array1_test__cb(CORBA_Object oe_obj, - m_arr1 a, - m_arr1 b, - m_arr1 c, - CORBA_Environment *oe_env) -{ - int i; - m_i_array1_test__rs* rs = NULL; - - for (i = 0; i < 500; i++) { - a[i] = b[i]; - c[i] = b[i]; - } - return rs; -} - -/* OK */ -m_i_array2_test__rs* m_i_array2_test__cb(CORBA_Object oe_obj, - m_dd a, - m_dd b, - m_dd c, - CORBA_Environment *oe_env) -{ - int i,j; - m_i_array2_test__rs* rs = NULL; - - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) { - a[i][j] = b[i][j]; - c[i][j] = b[i][j]; - } - return rs; -} - - -/* OK */ -m_i_enum_test__rs* m_i_enum_test__cb(CORBA_Object oe_obj, - m_fruit* a, - m_fruit* b, - m_fruit* c, - CORBA_Environment *oe_env) -{ - m_i_enum_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -m_i_string1_test__rs* m_i_string1_test__cb(CORBA_Object oe_obj, - char ** a, - char * b, - char ** c, - CORBA_Environment *oe_env) -{ - m_i_string1_test__rs* rs = NULL; - - /*printf("\nString in ------> %s\n\n",b);*/ - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_string2_test__rs* m_i_string2_test__cb(CORBA_Object oe_obj, - m_sseq** a, - m_sseq* b, - m_sseq** c, - CORBA_Environment *oe_env) -{ - m_i_string2_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_string3_test__rs* m_i_string3_test__cb(CORBA_Object oe_obj, - char ** a, - char * b, - char ** c, - CORBA_Environment *oe_env) -{ - m_i_string3_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -m_i_string4_test__rs* m_i_string4_test__cb(CORBA_Object oe_obj, - m_strRec** a, - m_strRec* b, - m_strRec** c, - CORBA_Environment *oe_env) -{ - *a = b; - *c = b; - - return (m_i_string4_test__rs*) NULL; -} - -/* OK */ -m_i_wstring1_test__rs* m_i_wstring1_test__cb(CORBA_Object oe_obj, - CORBA_wchar ** a, - CORBA_wchar * b, - CORBA_wchar ** c, - CORBA_Environment *oe_env) -{ - int tmp; - m_i_wstring1_test__rs* rs = NULL; - - /*printf("\nString in ------> %s\n\n",b);*/ - - for(tmp = 0; tmp < 5; tmp++) - fprintf(stderr,"\np[%d] = %ld\n", tmp, b[tmp]); - *a = b; - *c = b; - return rs; -} - - -/* OK */ -m_i_pid_test__rs* m_i_pid_test__cb(CORBA_Object oe_obj, - erlang_pid* a, - erlang_pid* b, - erlang_pid* c, - CORBA_Environment *oe_env) -{ - m_i_pid_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -/* OK */ -m_i_port_test__rs* m_i_port_test__cb(CORBA_Object oe_obj, - erlang_port* a, - erlang_port* b, - erlang_port* c, - CORBA_Environment *oe_env) -{ - m_i_port_test__rs* rs = NULL; - - strcpy((*a).node,(*b).node); - (*a).id = (*b).id; - (*a).creation = 0; - - strcpy((*c).node,(*b).node); - (*c).id = (*b).id; - (*c).creation = 0; - return rs; -} - -/* OK */ -m_i_ref_test__rs* m_i_ref_test__cb(CORBA_Object oe_obj, - erlang_ref* a, - erlang_ref* b, - erlang_ref* c, - CORBA_Environment *oe_env) -{ - - m_i_ref_test__rs* rs = NULL; - - strcpy((*a).node,(*b).node); - /*(*a).id = (*b).id;*/ - (*a).len = (*b).len; - (*a).n[0] = (*b).n[0]; - (*a).n[1] = (*b).n[1]; - (*a).n[2] = (*b).n[2]; - (*a).creation = 0; - - strcpy((*c).node,(*b).node); - /*(*c).id = (*b).id;*/ - (*c).len = (*b).len; - (*c).n[0] = (*b).n[0]; - (*c).n[1] = (*b).n[1]; - (*c).n[2] = (*b).n[2]; - (*c).creation = 0; - return rs; -} - -/* OK */ -m_i_term_test__rs* m_i_term_test__cb(CORBA_Object oe_obj, - ETERM** a, - ETERM** b, - ETERM** c, - CORBA_Environment *oe_env) -{ - m_i_term_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - -m_i_typedef_test__rs* m_i_typedef_test__cb(CORBA_Object oe_obj, - long* a, - ETERM** b, - erlang_port* c, - ETERM** d , - erlang_port* e, - CORBA_Environment *oe_env) -{ - m_i_typedef_test__rs* rs = NULL; - - *d = *b; - strcpy((*e).node,(*c).node); - (*e).id = (*c).id; - (*e).creation = 0; - *a = 4711; - return rs; -} - -/* OK */ -m_i_inline_sequence_test__rs* m_i_inline_sequence_test__cb( - CORBA_Object oe_obj, - m_s** a, - m_s* b, - m_s** c, - CORBA_Environment *oe_env) -{ - m_i_inline_sequence_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - -/* OK */ -m_i_term_sequence_test__rs* m_i_term_sequence_test__cb( - CORBA_Object oe_obj, - m_etseq** a, - m_etseq* b, - m_etseq** c, - CORBA_Environment *oe_env) -{ - m_i_term_sequence_test__rs* rs = NULL; - - *a = b; - *c = b; - return rs; -} - - -/* OK */ -m_i_term_struct_test__rs* m_i_term_struct_test__cb(CORBA_Object oe_obj, - m_et* a, - m_et* b, - m_et* c, - CORBA_Environment *oe_env) -{ - m_i_term_struct_test__rs* rs = NULL; - - *a = *b; - *c = *b; - return rs; -} - diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_c_test.idl b/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_c_test.idl deleted file mode 100644 index ef9556dd42..0000000000 --- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_c_test.idl +++ /dev/null @@ -1,175 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2004-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% - -#include "erlang.idl" - - -const short TestConst = 1; - -module m { - - const short TestConst = 2; - - struct b { - long l; - char c; - }; - - struct simple { - long l; - b b_t; - }; - - enum fruit {orange, banana, apple, peach, pear}; - - typedef sequence<long> lseq; - - typedef sequence<b> bseq; - - struct a { - long l; - bseq y; - double d; - }; - - typedef sequence<a> aseq; - - typedef sequence<string> sseq; - typedef string str; - typedef long myLong; - - typedef long arr1[500], dd[2][3]; - - typedef erlang::term apa; - typedef erlang::port banan; - - typedef sequence<erlang::term> etseq; - - struct s { - long l; - sequence<long> sl; - }; - - struct es { - fruit f; - myLong l; - }; - - struct et { - erlang::term e; - long l; - }; - - - typedef sequence<char> str1; - typedef string<12> str2; - typedef char str3[3]; - - typedef sequence<string> sstr3; // sequence of string - typedef sequence<sstr3> ssstr3; // sequence of sequences of strings - - typedef long arr3[3]; // array of long - typedef sequence<arr3> sarr3; // sequence of array - typedef sequence<sarr3> ssarr3; // sequence of sequnces of arrays of strings - - struct strRec{ - boolean bb; - string str4; - long str7[3][2]; - sequence<char> str5; - string<12> str6; - str3 str8; - str2 str9; - str1 str10; - }; - - - struct dyn { - long l; - sequence<long> sl; - }; - typedef dyn arr2[1][2]; - - - interface i { - - const short TestConst = 3; - - //arr2 suck(in arr2 x, out arr2 y ); - - ///////////////////////////////// attribute long l; - - // simple types - void void_test(); - long long_test(in long a, out long a1); - long long longlong_test(in long long a, out long long a1); - unsigned short ushort_test(in unsigned short a, out unsigned short a1); - unsigned long ulong_test(in unsigned long a, out unsigned long a1); - unsigned long long ulonglong_test(in unsigned long long a, out unsigned long long a1); - double double_test(in double a, out double a1); - char char_test(in char a, out char a1); - wchar wchar_test(in wchar a, out wchar a1); - octet octet_test(in octet a, out octet a1); - boolean bool_test(in boolean a, out boolean a1); - - // Seq. and struct tests - b struct_test(in b a, out b a1); - es struct2_test(in es a, out es a1); - //simple struct3_test(in simple x, out simple y); - bseq seq1_test(in bseq a, out bseq a1); - aseq seq2_test(in aseq a, out aseq a1); - lseq seq3_test(in lseq a, out lseq a1); - ssstr3 seq4_test(in ssstr3 a, out ssstr3 a1); - ssarr3 seq5_test(in ssarr3 a, out ssarr3 a1); - - // Array tests - arr1 array1_test(in arr1 a, out arr1 a1); - dd array2_test(in dd a, out dd a1); - - // enum test - fruit enum_test(in fruit a, out fruit a1); - - // string tests - string string1_test(in string a, out string a1); - wstring wstring1_test(in wstring a, out wstring a1); - sseq string2_test(in sseq a, out sseq a1); - str string3_test(in str a, out str a1); - strRec string4_test(in strRec a, out strRec a1); - - // Special erlang types - erlang::pid pid_test(in erlang::pid a, out erlang::pid a1); - erlang::port port_test(in erlang::port a, out erlang::port a1); - erlang::ref ref_test(in erlang::ref a, out erlang::ref a1); - erlang::term term_test(in erlang::term a, out erlang::term a1); - - // typedef test - long typedef_test(in apa a, in banan b, out apa a1, out banan b1); - - // inlined seq. test - s inline_sequence_test(in s a, out s a1); - - // term seq. test - etseq term_sequence_test(in etseq a, out etseq a1); - // term struct test - et term_struct_test(in et a, out et a1); - - }; - -}; diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_client.erl b/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_client.erl deleted file mode 100644 index 5fe80cdd7a..0000000000 --- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/erl_client.erl +++ /dev/null @@ -1,332 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-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% -%% -%% --module(erl_client). - --export([void_test/2, long_test/2, longlong_test/2, ushort_test/2, - ulong_test/2, ulonglong_test/2, double_test/2, char_test/2, - wchar_test/2, octet_test/2, bool_test/2, struct_test/2, - struct2_test/2, seq1_test/2, seq2_test/2, seq3_test/2, - seq4_test/2, seq5_test/2, array1_test/2, array2_test/2, - enum_test/2, string1_test/2, wstring1_test/2, string2_test/2, - string3_test/2, string4_test/2, pid_test/2, port_test/2, - ref_test/2, term_test/2, typedef_test/2, - inline_sequence_test/2, term_sequence_test/2, - term_struct_test/2 - -]). - --include("m.hrl"). --include("m_i.hrl"). --include("oe_erl_c_test.hrl"). - -%%b -void_test(Node, Timeout) -> - Ret = m_i:void_test({olsson, Node}, Timeout), - Ret == void. % XXX Not documented -%%e - -%%b -long_test(Node, Timeout) -> - In = max_long(), - {Ret, Out} = m_i:long_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -longlong_test(Node, Timeout) -> - In = 65537, - {Ret, Out} = m_i:longlong_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -ushort_test(Node, Timeout) -> - In = max_ushort(), - {Ret, Out} = m_i:ushort_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -ulong_test(Node, Timeout) -> - In = max_ulong(), - {Ret, Out} = m_i:ulong_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -ulonglong_test(Node, Timeout) -> - In = 65537, - {Ret, Out} = m_i:ulonglong_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -double_test(Node, Timeout) -> - In = 37768.93, - {Ret, Out} = m_i:double_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -char_test(Node, Timeout) -> - In = 80, - {Ret, Out} = m_i:char_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -wchar_test(Node, Timeout) -> - In = 4097, - {Ret, Out} = m_i:wchar_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -octet_test(Node, Timeout) -> - In = 255, - {Ret, Out} = m_i:octet_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -bool_test(Node, Timeout) -> - In = false, - {Ret, Out} = m_i:bool_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -struct_test(Node, Timeout) -> - In = #m_b{l = max_long(), c = $a}, - {Ret, Out} = m_i:struct_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -struct2_test(Node, Timeout) -> - In = #m_es{ f = banana, l = max_long()}, - {Ret, Out} = m_i:struct2_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq1_test(Node, Timeout) -> - B1 = #m_b{l = max_long(), c = $a}, - B2 = #m_b{l = min_long(), c = $b}, - In = [B1, B2], - {Ret, Out} = m_i:seq1_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq2_test(Node, Timeout) -> - B = #m_b{l = max_long(), c = $a}, - A = #m_a{l = min_long(), y = [B, B], d = 4711.31}, - In = [A, A, A], - {Ret, Out} = m_i:seq2_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq3_test(Node, Timeout) -> - In = [max_long(), min_long(), max_long()], - {Ret, Out} = m_i:seq3_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq4_test(Node, Timeout) -> - In = [["hej", "hopp"], ["ditt", "feta", "nylle"]], - {Ret, Out} = m_i:seq4_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -seq5_test(Node, Timeout) -> - Arr3 = mk_array(3, max_long()), - In = [[Arr3, Arr3], [Arr3, Arr3, Arr3]], - {Ret, Out} = m_i:seq5_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -array1_test(Node, Timeout) -> - In = mk_array(500, min_long()), - {Ret, Out} = m_i:array1_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -array2_test(Node, Timeout) -> - In = mk_array(2, mk_array(3, min_long())), - {Ret, Out} = m_i:array2_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -enum_test(Node, Timeout) -> - In = banana, - {Ret, Out} = m_i:enum_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -string1_test(Node, Timeout) -> - In = "Die Paula muss beim Tango immer weinen", - {Ret, Out} = m_i:string1_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -wstring1_test(Node, Timeout) -> - In = [1047| "ie Paula muss beim Tango immer weinen"], - {Ret, Out} = m_i:wstring1_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -string2_test(Node, Timeout) -> - In = ["Lass doch die Blumen,", "Konrad!"], - {Ret, Out} = m_i:string2_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -string3_test(Node, Timeout) -> - In = "Seeman, lass uns freuden!", - {Ret, Out} = m_i:string3_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -string4_test(Node, Timeout) -> - - In = #m_strRec{ - bb = true, - str4 = "Paula war zu Hause in ihrem Stadtchen als die beste Tanzerin" - "bekannt", - str7 = mk_array(3, mk_array(2, max_long())), - str5 = [$a, $b, $c, $d, $e, $f], - str6 = "123456789012", - str8 = {$x, $y, $x}, - str9 = "123456789012", - str10 = [$a, $b, $c, $d, $e, $f] - }, - {Ret, Out} = m_i:string4_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -pid_test(Node, Timeout) -> - In = self(), - {Ret, Out} = m_i:pid_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -port_test(Node, Timeout) -> - In = get(port_test_port), - {Ret, Out} = m_i:port_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -ref_test(Node, Timeout) -> - In = make_ref(), - {Ret, Out} = m_i:ref_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -term_test(Node, Timeout) -> - In = {[a, b], 17, kalle}, - {Ret, Out} = m_i:term_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -typedef_test(Node, Timeout) -> - In1 = {nisse, [1, 2], olsson}, - In2 = get(port_test_port), - {Ret, Out1, Out2} = m_i:typedef_test({olsson, Node}, Timeout, In1, In2), - %% XXX Should check that Ret is an integer. - (Out1 == In1) and (Out2 == In2). -%%e - -%%b -inline_sequence_test(Node, Timeout) -> - In = #m_s{l = min_long(), sl = [max_long(), min_long()]}, - {Ret, Out} = m_i:inline_sequence_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -term_sequence_test(Node, Timeout) -> - In = lists:duplicate(17, {nisse, [1, 2], {kalle, olsson}}), - {Ret, Out} = m_i:term_sequence_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - -%%b -term_struct_test(Node, Timeout) -> - In = #m_et{e = {nisse, ["abcde"], {kalle, olsson}}, l = 4711}, - {Ret, Out} = m_i:term_struct_test({olsson, Node}, Timeout, In), - (Ret == In) and (Out == In). -%%e - - -%% Locals - -mk_array(Es) -> - list_to_tuple(Es). - -mk_array(N, E) -> - mk_array(lists:duplicate(N, E)). - -%% max_short() -> -%% power_of_two(15) - 1. -max_long() -> - power_of_two(31) - 1. -max_longlong() -> - power_of_two(63) - 1. -max_ushort() -> - power_of_two(16) - 1. -max_ulong() -> - power_of_two(32) - 1. -max_ulonglong() -> - power_of_two(64) - 1. - -%% min_short() -> -%% -power_of_two(15). -min_long() -> - -power_of_two(31). -%% min_longlong() -> -%% -power_of_two(63). -%% min_ushort() -> -%% 0. -%% min_ulong() -> -%% 0. -%% min_ulonglong() -> -%% 0. - -power_of_two(N) -> - round(math:pow(2, N)). - diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/my.c b/lib/ic/test/erl_client_c_server_proto_SUITE_data/my.c deleted file mode 100644 index aff03253d6..0000000000 --- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/my.c +++ /dev/null @@ -1,35 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2004-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% - * - */ -#include "ic.h" -#include "m_i.h" - -int my_prepare_request_decoding(CORBA_Environment *env) -{ - return oe_prepare_request_decoding(env); -} - -int my_prepare_reply_encoding(CORBA_Environment *env) -{ - return oe_prepare_reply_encoding(env); -} - - - diff --git a/lib/ic/test/ic.cover b/lib/ic/test/ic.cover deleted file mode 100644 index 5a679c8b6f..0000000000 --- a/lib/ic/test/ic.cover +++ /dev/null @@ -1,2 +0,0 @@ -{incl_app,ic,details}. - diff --git a/lib/ic/test/ic.spec b/lib/ic/test/ic.spec deleted file mode 100644 index 22905dcee4..0000000000 --- a/lib/ic/test/ic.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../ic_test",all}. diff --git a/lib/ic/test/ic.spec.vxworks b/lib/ic/test/ic.spec.vxworks deleted file mode 100644 index b15260ab70..0000000000 --- a/lib/ic/test/ic.spec.vxworks +++ /dev/null @@ -1,2 +0,0 @@ -{topcase, {dir, "../ic_test"}}. -{skip,{ic_pp_SUITE,"Uses gcc"}}. 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']. - - - - - - - - - - - - - - - - diff --git a/lib/ic/test/ic_SUITE_data/Corba.idl b/lib/ic/test/ic_SUITE_data/Corba.idl deleted file mode 100644 index 6b81132500..0000000000 --- a/lib/ic/test/ic_SUITE_data/Corba.idl +++ /dev/null @@ -1,1013 +0,0 @@ -// This file contains OMG IDL from CORBA V2.0, July 1995. -// Includes IDL for CORBA Core -// (Interface Repository, ORB Interface, Basic Object Adapter Interface) -// and CORBA Interoperability (IOP, GIOP, IIOP, and DCE CIOP modules) - -// Complete OMG IDL for Interface Repository starts on pg 6-42, CORBA V2.0 July 1995 -// IRObject interface described on pg 6-9 CORBA V2.0, July 1995 -// Contained interface: pg 6-11 CORBA V2, 7-95 -// Container interface: pg 6-12 thru 6-15 CORBA V2, 7-95 -// IDLType interface: pg 6-15 CORBA V2, 7-95 -// Repository interface: pg 6-16 CORBA V2, 7-95 -// ModuleDef interface: pg 6-17 CORBA V2, 7-95 -// ConstantDef interface: pg 6-18 CORBA V2, 7-95 -// TypeDef interface: pg 6-19 CORBA V2, 7-95 -// StructDef interface: pg 6-19 CORBA V2, 7-95 -// UnionDef interface: pg 6-19 CORBA V2, 7-95 -// EnumDef interface: pg 6-20 CORBA V2, 7-95 -// AliasDef interface: pg 6-21 CORBA V2, 7-95 -// PrimitiveDef interface: pg 6-21 CORBA V2, 7-95 -// StringDef interface: pg 6-22 CORBA V2, 7-95 -// SequenceDef interface: pg 6-22 CORBA V2, 7-95 -// ArrayDef interface: pg 6-23 CORBA V2, 7-95 -// ExceptionDef interface: pg 6-24 CORBA V2, 7-95 -// AttributeDef interface: pg 6-25 CORBA V2, 7-95 -// OperationDef interface: pg 6-26 CORBA V2, 7-95 -// InterfaceDef interface: pg 6-28 CORBA V2, 7-95 -// TypeCode interface (PIDL): pg 6-34 CORBA V2, 7-95 -// ORB interface: pg 6-40 CORBA V2, 7-95 - -#ifndef __CORBA_IDL -#define __CORBA_IDL - -// #pragma prefix "omg.org" -module CORBA { - - interface TypeCode; - typedef string Identifier; - typedef string ScopedName; - typedef string RepositoryId; - - /* - * start of section added by Christian Blum - */ - - typedef enum new_type {NO,USER,SYSTEM_EXCEPTION} exception_type; - - /** - * no definition for this type - */ - interface ImplementationDef - { - }; - - /** - * no definition for this type - */ - //interface Principal - struct Principal - { - string str; - }; - - /** - * no definition for this type - */ - interface Environment - { - - }; - - typedef unsigned long Flags; - typedef unsigned long Status; - - struct NamedValue // PIDL - { - Identifier name; // argument name - any argument; // argument - long len; // length/count of argument value - Flags arg_modes; // argument mode flags - - }; - - typedef sequence<NamedValue> NVList; /* C */ - - interface Request // PIDL - { - - Status add_arg ( - in Identifier name, // argument name - in TypeCode arg_type, // argument datatype - // in void * value, // argument value to be added - in any value_LOOK_AT_SOURCE, // changed by blum - in long len, // length/count of argument value - in Flags arg_flags // argument flags - ); - - Status invoke ( - in Flags invoke_flags // invocation flags - ); - - Status delete (); - Status send ( - in Flags invoke_flags // invocation flags - ); - - Status get_response ( - in Flags response_flags // response flags - ); - - }; - - - interface Context // PIDL - { - - Status set_one_value ( - in Identifier prop_name, // property name to add - in string value // property value to add - ); - - Status set_values ( - in NVList values // property values to be changed - ); - - Status get_values ( - in Identifier start_scope, // search scope - in Flags op_flags, // operation flags - in Identifier prop_name, // name of property(s) to retrieve - out NVList values // requested property(s) - ); - - Status delete_values ( - in Identifier prop_name // name of property(s) to delete - ); - - Status create_child ( - in Identifier ctx_name, // name of context object - out Context child_ctx // newly created context object - ); - - Status delete ( - in Flags del_flags // flags controlling deletion - ); - - }; - - /* - * end of section added by Christian Blum - */ - - - enum DefinitionKind { - dk_none, dk_all, - dk_Attribute, dk_Constant, dk_Exception, dk_Interface, - dk_Module, dk_Operation, dk_Typedef, - dk_Alias, dk_Struct, dk_Union, dk_Enum, - dk_Primitive, dk_String, dk_Sequence, dk_Array, - dk_Repository - }; - - - interface IRObject { - // read interface - readonly attribute DefinitionKind def_kind; - - // write interface - void destroy (); - }; - - - - typedef string VersionSpec; - - interface Contained; - interface Repository; - interface Container; - - interface Contained : IRObject { - // read/write interface - - attribute RepositoryId id; - attribute Identifier name; - attribute VersionSpec version; - - // read interface - - readonly attribute Container defined_in; - readonly attribute ScopedName absolute_name; - readonly attribute Repository containing_repository; - - struct Description { - DefinitionKind kind; - any value; - }; - - Description describe (); - - // write interface - - void move ( - in Container new_container, - in Identifier new_name, - in VersionSpec new_version - ); - }; - - - interface ModuleDef; - interface ConstantDef; - interface IDLType; - interface StructDef; - interface UnionDef; - interface EnumDef; - interface AliasDef; - interface InterfaceDef; - typedef sequence <InterfaceDef> InterfaceDefSeq; - - typedef sequence <Contained> ContainedSeq; - - struct StructMember { - Identifier name; - TypeCode type; - IDLType type_def; - }; - typedef sequence <StructMember> StructMemberSeq; - - struct UnionMember { - Identifier name; - any label; - TypeCode type; - IDLType type_def; - }; - typedef sequence <UnionMember> UnionMemberSeq; - - typedef sequence <Identifier> EnumMemberSeq; - - interface Container : IRObject { - // read interface - - Contained lookup ( in ScopedName search_name); - - ContainedSeq contents ( - in DefinitionKind limit_type, - in boolean exclude_inherited - ); - - ContainedSeq lookup_name ( - in Identifier search_name, - in long levels_to_search, - in DefinitionKind limit_type, - in boolean exclude_inherited - ); - - struct Description { - Contained contained_object; - DefinitionKind kind; - any value; - }; - - typedef sequence<Description> DescriptionSeq; - - DescriptionSeq describe_contents ( - in DefinitionKind limit_type, - in boolean exclude_inherited, - in long max_returned_objs - ); - - // write interface - - ModuleDef create_module ( - in RepositoryId id, - in Identifier name, - in VersionSpec version - ); - - ConstantDef create_constant ( - in RepositoryId id, - in Identifier name, - in VersionSpec version, - in IDLType type, - in any value - ); - - StructDef create_struct ( - in RepositoryId id, - in Identifier name, - in VersionSpec version, - in StructMemberSeq members - ); - - UnionDef create_union ( - in RepositoryId id, - in Identifier name, - in VersionSpec version, - in IDLType discriminator_type, - in UnionMemberSeq members - ); - - EnumDef create_enum ( - in RepositoryId id, - in Identifier name, - in VersionSpec version, - in EnumMemberSeq members - ); - - AliasDef create_alias ( - in RepositoryId id, - in Identifier name, - in VersionSpec version, - in IDLType original_type - ); - - InterfaceDef create_interface ( - in RepositoryId id, - in Identifier name, - in VersionSpec version, - in InterfaceDefSeq base_interfaces - ); - }; - - - - interface IDLType : IRObject { - readonly attribute TypeCode type; - }; - - - - interface PrimitiveDef; - interface StringDef; - interface SequenceDef; - interface ArrayDef; - - enum PrimitiveKind { - pk_null, pk_void, pk_short, pk_long, pk_ushort, pk_ulong, - pk_float, pk_double, pk_boolean, pk_char, pk_octet, - pk_any, pk_TypeCode, pk_Principal, pk_string, pk_objref - }; - - interface Repository : Container { - // read interface - - Contained lookup_id (in RepositoryId search_id); - - PrimitiveDef get_primitive (in PrimitiveKind kind); - - // write interface - - StringDef create_string (in unsigned long bound); - - SequenceDef create_sequence ( - in unsigned long bound, - in IDLType element_type - ); - - ArrayDef create_array ( - in unsigned long length, - in IDLType element_type - ); - }; - - - interface ModuleDef : Container, Contained { - }; - - struct ModuleDescription { - Identifier name; - RepositoryId id; - RepositoryId defined_in; - VersionSpec version; - }; - - - interface ConstantDef : Contained { - readonly attribute TypeCode type; - attribute IDLType type_def; - attribute any value; - }; - - struct ConstantDescription { - Identifier name; - RepositoryId id; - RepositoryId defined_in; - VersionSpec version; - TypeCode type; - any value; - }; - - - interface TypedefDef : Contained, IDLType { - }; - - struct TypeDescription { - Identifier name; - RepositoryId id; - RepositoryId defined_in; - VersionSpec version; - TypeCode type; - }; - - - interface StructDef : TypedefDef { - attribute StructMemberSeq members; - }; - - - interface UnionDef : TypedefDef { - readonly attribute TypeCode discriminator_type; - attribute IDLType discriminator_type_def; - attribute UnionMemberSeq members; - }; - - - interface EnumDef : TypedefDef { - attribute EnumMemberSeq members; - }; - - - interface AliasDef : TypedefDef { - attribute IDLType original_type_def; - }; - - - interface PrimitiveDef: IDLType { - readonly attribute PrimitiveKind kind; - }; - - - interface StringDef : IDLType { - attribute unsigned long bound; - }; - - - interface SequenceDef : IDLType { - attribute unsigned long bound; - readonly attribute TypeCode element_type; - attribute IDLType element_type_def; - }; - - interface ArrayDef : IDLType { - attribute unsigned long length; - readonly attribute TypeCode element_type; - attribute IDLType element_type_def; - }; - - - interface ExceptionDef : Contained { - readonly attribute TypeCode type; - attribute StructMemberSeq members; - }; - struct ExceptionDescription { - Identifier name; - RepositoryId id; - RepositoryId defined_in; - VersionSpec version; - TypeCode type; - }; - - - - enum AttributeMode {ATTR_NORMAL, ATTR_READONLY}; - - interface AttributeDef : Contained { - readonly attribute TypeCode type; - attribute IDLType type_def; - attribute AttributeMode mode; - }; - - struct AttributeDescription { - Identifier name; - RepositoryId id; - RepositoryId defined_in; - VersionSpec version; - TypeCode type; - AttributeMode mode; - }; - - - - enum OperationMode {OP_NORMAL, OP_ONEWAY}; - - enum ParameterMode {PARAM_IN, PARAM_OUT, PARAM_INOUT}; - struct ParameterDescription { - Identifier name; - TypeCode type; - IDLType type_def; - ParameterMode mode; - }; - typedef sequence <ParameterDescription> ParDescriptionSeq; - - typedef Identifier ContextIdentifier; - typedef sequence <ContextIdentifier> ContextIdSeq; - - typedef sequence <ExceptionDef> ExceptionDefSeq; - typedef sequence <ExceptionDescription> ExcDescriptionSeq; - - interface OperationDef : Contained { - readonly attribute TypeCode result; - attribute IDLType result_def; - attribute ParDescriptionSeq params; - attribute OperationMode mode; - attribute ContextIdSeq contexts; - attribute ExceptionDefSeq exceptions; - }; - - struct OperationDescription { - Identifier name; - RepositoryId id; - RepositoryId defined_in; - VersionSpec version; - TypeCode result; - OperationMode mode; - ContextIdSeq contexts; - ParDescriptionSeq parameters; - ExcDescriptionSeq exceptions; - }; - - - - typedef sequence <RepositoryId> RepositoryIdSeq; - typedef sequence <OperationDescription> OpDescriptionSeq; - typedef sequence <AttributeDescription> AttrDescriptionSeq; - - interface InterfaceDef : Container, Contained, IDLType { - // read/write interface - - attribute InterfaceDefSeq base_interfaces; - - // read interface - - boolean is_a (in RepositoryId interface_id); - - struct FullInterfaceDescription { - Identifier name; - RepositoryId id; - RepositoryId defined_in; - VersionSpec version; - OpDescriptionSeq operations; - AttrDescriptionSeq attributes; - RepositoryIdSeq base_interfaces; - TypeCode type; - }; - - FullInterfaceDescription describe_interface(); - - // write interface - - AttributeDef create_attribute ( - in RepositoryId id, - in Identifier name, - in VersionSpec version, - in IDLType type, - in AttributeMode mode - ); - - OperationDef create_operation ( - in RepositoryId id, - in Identifier name, - in VersionSpec version, - in IDLType result, - in OperationMode mode, - in ParDescriptionSeq params, - in ExceptionDefSeq exceptions, - in ContextIdSeq contexts - ); - }; - - struct InterfaceDescription { - Identifier name; - RepositoryId id; - RepositoryId defined_in; - VersionSpec version; - RepositoryIdSeq base_interfaces; - }; - - - - enum TCKind { - tk_null, tk_void, - tk_short, tk_long, tk_ushort, tk_ulong, - tk_float, tk_double, tk_boolean, tk_char, - tk_octet, tk_any, tk_TypeCode, tk_Principal, tk_objref, - tk_struct, tk_union, tk_enum, tk_string, - tk_sequence, tk_array, tk_alias, tk_except - }; - - interface TypeCode { // PIDL - exception Bounds {}; - exception BadKind {}; - - // for all TypeCode kinds - boolean equal (in TypeCode tc); - TCKind kind (); - - // for tk_objref, tk_struct, tk_union, tk_enum, tk_alias, and tk_except - RepositoryId id () raises (BadKind); - - // for tk_objref, tk_struct, tk_union, tk_enum, tk_alias, and tk_except - Identifier name () raises (BadKind); - - // for tk_struct, tk_union, tk_enum, and tk_except - unsigned long member_count () raises (BadKind); - Identifier member_name (in unsigned long index) raises (BadKind, Bounds); - - // for tk_struct, tk_union, and tk_except - TypeCode member_type (in unsigned long index) raises (BadKind, Bounds); - - // for tk_union - any member_label (in unsigned long index) raises (BadKind, Bounds); - TypeCode discriminator_type () raises (BadKind); - long default_index () raises (BadKind); - - // for tk_string, tk_sequence, and tk_array - unsigned long length () raises (BadKind); - - // for tk_sequence, tk_array, and tk_alias - TypeCode content_type () raises (BadKind); - - // deprecated interface - long param_count (); - any parameter (in long index) raises (Bounds); - }; - - - /* - * following line added by Christian Blum - */ - interface BOA; - - interface ORB { - // other operations ... - - TypeCode create_struct_tc ( - in RepositoryId id, - in Identifier name, - in StructMemberSeq members - ); - - TypeCode create_union_tc ( - in RepositoryId id, - in Identifier name, - in TypeCode discriminator_type, - in UnionMemberSeq members - ); - - TypeCode create_enum_tc ( - in RepositoryId id, - in Identifier name, - in EnumMemberSeq members - ); - - TypeCode create_alias_tc ( - in RepositoryId id, - in Identifier name, - in TypeCode original_type - ); - - TypeCode create_exception_tc ( - in RepositoryId id, - in Identifier name, - in StructMemberSeq members - ); - - TypeCode create_interface_tc ( - in RepositoryId id, - in Identifier name - ); - - TypeCode create_string_tc ( - in unsigned long bound - ); - - TypeCode create_sequence_tc ( - in unsigned long bound, - in TypeCode element_type - ); - - TypeCode create_recursive_sequence_tc ( - in unsigned long bound, - in unsigned long offset - ); - - TypeCode create_array_tc ( - in unsigned long length, - in TypeCode element_type - ); - - /* - * following line commented out by Christian Blum - */ - // }; - - // The ORB interface (PIDL) is described in Chapter 7, CORBA V2.0 July 1995 - // Object interface (object reference operations): pg 7-3 CORBA V2, 7-95 - // ORB initialization: pg 7-7 CORBA V2, 7-95 - // Object Adapter and Basic Object Adapter initialization: pg 7-8 CORBA V2 7-95 - // Getting initial references: pg 7-10 CORBA V2 7-95 - //PIDL - - /* - * following line commented out by Christian Blum - */ - //interface ORB { - - - string object_to_string (in Object obj); - Object string_to_object (in string str); - - Status create_list ( - in long count, - out NVList new_list - ); - Status create_operation_list ( - in OperationDef oper, - out NVList new_list - ); - Status get_default_context (out Context ctx); - - // Initializing the ORB - typedef string ORBid; - typedef sequence <string> arg_list; - ORB ORB_init (inout arg_list argv, in ORBid orb_identifier); - - // Initializing an object adapter and the Basic Object Adapter - typedef string OAid; - - // Template for OA initialization operations - // <OA> <OA>_init (inout arg_list argv, - // in OAid oa_identifier); - - - - BOA BOA_init (inout arg_list argv, - in OAid boa_identifier); - - - - // Getting initial object references - typedef string ObjectId; - typedef sequence <ObjectId> ObjectIdList; - - exception InvalidName {}; - - ObjectIdList list_initial_services (); - - Object resolve_initial_references (in ObjectId identifier) - raises (InvalidName); - }; - - // had to be changed..., Gerald Brose 1996 - interface ORBject { - - ImplementationDef get_implementation (); - InterfaceDef get_interface (); - boolean is_nil(); - Object duplicate (); - void release (); - boolean is_a (in string logical_type_id); - boolean non_existent(); - boolean is_equivalent (in Object other_object); - unsigned long hash(in unsigned long maximum); - - - Status create_request ( - in Context ctx, - in Identifier operation, - in NVList arg_list, - inout NamedValue result, - out Request request, - in Flags req_flags - ); - }; - - - // Basic Object Adapter interface described in Chapter 8, CORBA V2.0, July 1995 - // interface InterfaceDef; // from Interface Repository // PIDL - // interface ImplementationDef; // from Implementation Repository - // interface Object; // an object reference - // interface Principal; // for the authentication service - typedef sequence <octet, 1024> ReferenceData; - - interface BOA { - Object create ( - in ReferenceData id, - in InterfaceDef intf, - in ImplementationDef impl - ); - void dispose (in Object obj); - ReferenceData get_id (in Object obj); - - void change_implementation (in Object obj, - in ImplementationDef impl - ); - - Principal get_principal (in Object obj, - in Environment ev - ); - - void set_exception (in exception_type major, // NO, USER, - //or SYSTEM_EXCEPTION - in string userid, // exception type id - in any param_LOOK_AT_SOURCE - // in void *param // pointer to associated data - ); - - void impl_is_ready (in ImplementationDef impl); - void deactivate_impl (in ImplementationDef impl); - void obj_is_ready (in Object obj, in ImplementationDef impl); - void deactivate_obj (in Object obj); - }; -}; - -// IOP module described in chap 10 CORBA V2, 7-95 -module IOP{ // IDL - // - // Standard Protocol Profile tag values - // - typedef unsigned long ProfileId; - const ProfileId TAG_INTERNET_IOP = 0; - const ProfileId TAG_MULTIPLE_COMPONENTS = 1; - - struct TaggedProfile { - ProfileId tag; - sequence <octet> profile_data; - }; - - // - // an Interoperable Object Reference is a sequence of - // object-specific protocol profiles, plus a type ID. - // - struct IOR { - string type_id; - sequence <TaggedProfile> profiles; - }; - - // - // Standard way of representing multicomponent profiles. - // This would be encapsulated in a TaggedProfile. - // - typedef unsigned long ComponentId; - struct TaggedComponent { - ComponentId tag; - sequence <octet> component_data; - }; - typedef sequence <TaggedComponent> MultipleComponentProfile; - - - typedef unsigned long ServiceID; - - struct ServiceContext { - ServiceID context_id; - sequence <octet> context_data; - }; - typedef sequence <ServiceContext> ServiceContextList; - - const ServiceID TransactionService = 0; - - - -}; -// GIOP module described in CORBA V2, 7-95 chap 12 -// Complete IDL for GIOP module in CORBA -// V2.0, 7-95 p 10-29 -// GIOP message header: CORBA V2, 7-95 p 12-16 -// GIOP request header: CORBA V2, 7-95 p 12-17 -// GIOP reply header: CORBA V2, 7-95 p 12-19 -// GIOP cancel request and locate request: CORBA V2, 7-95 pp 12-20 -- 12-21 -// GIOP locate reply: CORBA V2, 7-95 p 12-22 -module GIOP { // IDL - enum MsgType { - Request, Reply, CancelRequest, - LocateRequest, LocateReply, - CloseConnection, MessageError - }; - - struct Version { - char major; - char minor; - }; - - struct MessageHeader { - char magic [4]; - Version GIOP_version; - boolean byte_order; - octet message_type; - unsigned long message_size; - }; - - struct RequestHeader { - ::IOP::ServiceContextList service_context; - unsigned long request_id; - boolean response_expected; - sequence <octet> object_key; - string operation; - - /* - * ::CORBA:: added for correct scope - */ - ::CORBA::Principal requesting_principal; - }; - - enum ReplyStatusType { - NO_EXCEPTION, - USER_EXCEPTION, - SYSTEM_EXCEPTION, - LOCATION_FORWARD - }; - - struct ReplyHeader { - ::IOP::ServiceContextList service_context; - unsigned long request_id; - ReplyStatusType reply_status; - }; - - struct CancelRequestHeader { - unsigned long request_id; - }; - - struct LocateRequestHeader { - unsigned long request_id; - sequence <octet> object_key; - }; - - enum LocateStatusType { - UNKNOWN_OBJECT, - OBJECT_HERE, - OBJECT_FORWARD - }; - - struct LocateReplyHeader { - unsigned long request_id; - LocateStatusType locate_status; - }; -}; -// IIOP module described in CORBA V2, 7-95 chap 12 -// Complete IDL for IIOP module: CORBA V2, 7-95 p 12-31 -module IIOP { // IDL - struct Version { - char major; - char minor; - }; - - struct ProfileBody { - Version iiop_version; - string host; - unsigned short port; - sequence <octet> object_key; - }; -}; -// DCE CIOP module described in CORBA V2, 7-95 chap 13 -// IDL for DCE CIOP module: CORBA V2, 7-95 p 13-2 -module DCE_CIOP { - struct InvokeRequestHeader { - boolean byte_order; - ::IOP::ServiceContextList service_context; - sequence <octet> object_key; - string endpoint_id; - string operation; - ::CORBA::Principal principal; - sequence <string> client_context; - - // in and inout parameters follow - }; - enum InvokeResponseStatus { - INVOKE_NO_EXCEPTION, - INVOKE_USER_EXCEPTION, - INVOKE_SYSTEM_EXCEPTION, - INVOKE_LOCATION_FORWARD, - INVOKE_TRY_AGAIN - }; - - struct InvokeResponseHeader { - boolean byte_order; - ::IOP::ServiceContextList service_context; - InvokeResponseStatus status; - - // if status = INVOKE_NO_EXCEPTION, - // result then inouts and outs follow - - // if status = INVOKE_USER_EXCEPTION or - // INVOKE_SYSTEM_EXCEPTION, an exception follows - - // if status = INVOKE_LOCATION_FORWARD, an - // ::IOP::MultipleComponentsProfile follows - }; - - struct LocateRequestHeader { - boolean byte_order; - sequence <octet> object_key; - string endpoint_id; - string operation; - - // no body follows - }; - - module IOP { - - /* - * ::IOP:: added to get the right scope - */ - const ::IOP::ComponentId TAG_OBJECT_KEY = 10; - const ::IOP::ComponentId TAG_ENDPOINT_ID = 11; - const ::IOP::ComponentId TAG_LOCATION_POLICY = 12; - // illegal IDL - /* const octet LOCATE_NEVER = 0; - const octet LOCATE_OBJECT = 1; - const octet LOCATE_OPERATION = 2; - const octet LOCATE_ALWAYS = 3; - */ - }; -}; - -#endif diff --git a/lib/ic/test/ic_SUITE_data/Coss.idl b/lib/ic/test/ic_SUITE_data/Coss.idl deleted file mode 100644 index c84d4a8247..0000000000 --- a/lib/ic/test/ic_SUITE_data/Coss.idl +++ /dev/null @@ -1,1537 +0,0 @@ -// This file contains OMG IDL and PIDL for the Common Object Services. -// CosNaming Module, p 3-6 CORBAservices, Naming Service V1.0, 3/94 - -// A few minor changes for the JacORB distribution: -// -// added am enclosing COSS module and changed scoped names accordingly -// -// corrected a few syntax errors -// -// commented out: -// #includes -// forward declaration of Object - -#include "Corba.idl" - -module COSS { - -module CosNaming { - - typedef string Istring; - struct NameComponent { - Istring id; - Istring kind; - }; - - typedef sequence <NameComponent> Name; - - enum BindingType {nobject, ncontext}; - - struct Binding { - Name binding_name; - BindingType binding_type; - }; - - typedef sequence <Binding> BindingList; - interface BindingIterator; - - interface NamingContext { - - enum NotFoundReason { missing_node, not_context, not_object}; - - exception NotFound { - NotFoundReason why; - Name rest_of_name; - }; - - exception CannotProceed { - NamingContext cxt; - Name rest_of_name; - }; - - exception InvalidName{}; - exception AlreadyBound {}; - exception NotEmpty{}; - - void bind(in Name n, in Object obj) - raises(NotFound, CannotProceed, InvalidName, AlreadyBound); - void rebind(in Name n, in Object obj) - raises(NotFound, CannotProceed, InvalidName); - void bind_context(in Name n, in NamingContext nc) - raises(NotFound, CannotProceed, InvalidName, AlreadyBound); - void rebind_context(in Name n, in NamingContext nc) - raises(NotFound, CannotProceed, InvalidName); - Object resolve (in Name n) - raises(NotFound, CannotProceed, InvalidName); - void unbind(in Name n) - raises(NotFound, CannotProceed, InvalidName); - NamingContext new_context(); - NamingContext bind_new_context(in Name n) - raises(NotFound, AlreadyBound, CannotProceed, InvalidName); - void destroy( ) - raises(NotEmpty); - void list (in unsigned long how_many, - out BindingList bl, out BindingIterator bi); - }; - - interface BindingIterator { - boolean next_one(out Binding b); - boolean next_n(in unsigned long how_many, - out BindingList bl); - void destroy(); - }; -}; - -// Names Library interface in PIDL, CORBAservices p 3- 14, Naming Service V1.0 3/94 -/* -interface LNameComponent { // PIDL - exception NotSet{}; - string get_id() - raises(NotSet); - void set_id(in string i); - string get_kind() - raises(NotSet); - void set_kind(in string k); - void destroy(); -}; - -interface LName { // PIDL - exception NoComponent{}; - exception OverFlow{}; - exception InvalidName{}; - LName insert_component(in unsigned long i, - in LNameComponent n) - raises(NoComponent, OverFlow); - LNameComponent get_component(in unsigned long i) - raises(NoComponent); - LNameComponent delete_component(in unsigned long i) - raises(NoComponent); - unsigned long num_components(); - boolean equal(in LName ln); - boolean less_than(in LName ln); - Name to_idl_form() - raises(InvalidName); - void from_idl_form(in Name n); - void destroy(); -}; - -LName create_lname(); // C/C++ -LNameComponent create_lname_component(); // C/C++ -*/ - -// CosEventComm Module, CORBAservices p 4-8, Event Service V1.0 3/94 - -module CosEventComm { - - exception Disconnected{}; - - interface PushConsumer { - void push (in any data) raises(Disconnected); - void disconnect_push_consumer(); - }; - - interface PushSupplier { - void disconnect_push_supplier(); - }; - - interface PullSupplier { - any pull () raises(Disconnected); - any try_pull (out boolean has_event) - raises(Disconnected); - void disconnect_pull_supplier(); - }; - - interface PullConsumer { - void disconnect_pull_consumer(); - }; - -}; - -// CosEventChannelAdmin Module, p 4-15 CORBAservices, Event -// Service V1.0, 3/94 - -// #include "CosEventComm.idl" - -module CosEventChannelAdmin { - - exception AlreadyConnected {}; - exception TypeError {}; - - interface ProxyPushConsumer: ::COSS::CosEventComm::PushConsumer { - void connect_push_supplier( - in ::COSS::CosEventComm::PushSupplier push_supplier) - raises(AlreadyConnected); - }; - - interface ProxyPullSupplier: ::COSS::CosEventComm::PullSupplier { - void connect_pull_consumer( - in ::COSS::CosEventComm::PullConsumer pull_consumer) - raises(AlreadyConnected); - }; - - interface ProxyPullConsumer: ::COSS::CosEventComm::PullConsumer { - void connect_pull_supplier( - in ::COSS::CosEventComm::PullSupplier pull_supplier) - raises(AlreadyConnected,TypeError); - }; - - interface ProxyPushSupplier: ::COSS::CosEventComm::PushSupplier { - void connect_push_consumer( - in ::COSS::CosEventComm::PushConsumer - push_consumer) - raises(AlreadyConnected, TypeError); - }; - - - interface ConsumerAdmin { - ProxyPushSupplier obtain_push_supplier(); - ProxyPullSupplier obtain_pull_supplier(); - }; - - interface SupplierAdmin { - ProxyPushConsumer obtain_push_consumer(); - ProxyPullConsumer obtain_pull_consumer(); - }; - - interface EventChannel { - ConsumerAdmin for_consumers(); - SupplierAdmin for_suppliers(); - void destroy(); - }; - -}; - - -// CosTyped Event Module, p 4-22 CORBAservices, Event Service -// V1.0, 3/94 - -// // #include "CosEventComm.idl" - -module CosTypedEventComm { - - interface TypedPushConsumer : ::COSS::CosEventComm::PushConsumer { - Object get_typed_consumer(); - }; - - interface TypedPullSupplier : ::COSS::CosEventComm::PullSupplier { - Object get_typed_supplier(); - }; - -}; - -// CosTypedEventChannelAdmin Module, p 4- 25 CORBAservices, -// Event Service V1.0, 3/94 - -// // #include "CosEventChannel.idl" -// // #include "CosTypedEventComm.idl" -module CosTypedEventChannelAdmin { - exception InterfaceNotSupported {}; - exception NoSuchImplementation {}; - typedef string Key; - - interface TypedProxyPushConsumer : - ::COSS::CosEventChannelAdmin::ProxyPushConsumer, - ::COSS::CosTypedEventComm::TypedPushConsumer { }; - - interface TypedProxyPullSupplier : - ::COSS::CosEventChannelAdmin::ProxyPullSupplier, - ::COSS::CosTypedEventComm::TypedPullSupplier { }; - - interface TypedSupplierAdmin : - ::COSS::CosEventChannelAdmin::SupplierAdmin { - TypedProxyPushConsumer obtain_typed_push_consumer( - in Key supported_interface) - raises(InterfaceNotSupported); - ::COSS::CosEventChannelAdmin::ProxyPullConsumer obtain_typed_pull_consumer ( - in Key uses_interface) - raises(NoSuchImplementation); - }; - - interface TypedConsumerAdmin : - ::COSS::CosEventChannelAdmin::ConsumerAdmin { - TypedProxyPullSupplier obtain_typed_pull_supplier( - in Key supported_interface) - raises (InterfaceNotSupported); - ::COSS::CosEventChannelAdmin::ProxyPushSupplier obtain_typed_push_supplier( - in Key uses_interface) - raises(NoSuchImplementation); - }; - - interface TypedEventChannel { - TypedConsumerAdmin for_consumers(); - TypedSupplierAdmin for_suppliers(); - void destroy (); - }; -}; - - -// CosPersistencePID Module, p 5-20 CORBAservices, -// Persistent Object Service V1.0, 3/94 - -//#ifndef __COSPERSISTENCE -//#define __COSPERSISTENCE - -module CosPersistencePID { - - interface PID { - attribute string datastore_type; - string get_PIDString(); - }; -}; - - -// CosPersistencePDS Module, p 5-20 CORBAservices, -// Persistent Object Service V1.0, 3/94 - -// #include "CosPersistencePID.idl" - -module CosPersistencePDS { - -// interface Object; - interface PDS { - PDS connect (in Object obj, - in ::COSS::CosPersistencePID::PID p); - void disconnect (in Object obj, - in ::COSS::CosPersistencePID::PID p); - void store (in Object obj, - in ::COSS::CosPersistencePID::PID p); - void restore (in Object obj, - in ::COSS::CosPersistencePID::PID p); - void delete (in Object obj, - in ::COSS::CosPersistencePID::PID p); - }; -}; - - -// CosPersistencePO Module, p 5-12 CORBAservices, -// Persistent Object Service V1.0, 3/94 - -// // #include "CosPersistencePDS.idl" -// CosPersistencePDS.idl -// // #includes CosPersistencePID.idl - -module CosPersistencePO { - - interface PO { - attribute ::COSS::CosPersistencePID::PID p; - ::COSS::CosPersistencePDS::PDS connect ( - in ::COSS::CosPersistencePID::PID p); - void disconnect (in ::COSS::CosPersistencePID::PID p); - void store (in ::COSS::CosPersistencePID::PID p); - void restore (in ::COSS::CosPersistencePID::PID p); - void delete (in ::COSS::CosPersistencePID::PID p); - }; - - interface SD { - void pre_store(); - void post_restore(); - }; -}; - - -// CosPersistencePOM Module, p 5-15 CORBAservices, -// Persistent Object Service V1.0, 3/94 - -// #include "CosPersistencePDS.idl" - -// CosPersistencePDS.idl // #includes CosPersistencePID.idl - -module CosPersistencePOM { - -// interface Object; - - interface POM { - ::COSS::CosPersistencePDS::PDS connect ( - in Object obj, - in ::COSS::CosPersistencePID::PID p); - void disconnect ( - in Object obj, - in ::COSS::CosPersistencePID::PID p); - void store ( - in Object obj, - in ::COSS::CosPersistencePID::PID p); - void restore ( - in Object obj, - in ::COSS::CosPersistencePID::PID p); - void delete ( - in Object obj, - in ::COSS::CosPersistencePID::PID p); - }; - }; - -// CosPersistencePDS_DA Module, p 5-22 CORBAservices, -// Persistent Object Service, V1.0, 3/94 - -// #include "CosPersistencePDS.idl" -// CosPersistencePDS.idl // #includes CosPersistencePID.idl - -module CosPersistencePDS_DA { - - typedef string DAObjectID; - - interface PID_DA : ::COSS::CosPersistencePID::PID { - attribute DAObjectID oid; - }; - - interface DAObject { - boolean dado_same(in DAObject d); - DAObjectID dado_oid(); - PID_DA dado_pid(); - void dado_remove(); - void dado_free(); - }; - - interface DAObjectFactory { - DAObject create(); - }; - - interface DAObjectFactoryFinder { - DAObjectFactory find_factory(in string key); - }; - - interface PDS_DA : ::COSS::CosPersistencePDS::PDS { - DAObject get_data(); - void set_data(in DAObject new_data); - DAObject lookup(in DAObjectID id); - PID_DA get_pid(); - PID_DA get_object_pid(in DAObject dao); - DAObjectFactoryFinder data_factories(); - }; - - typedef sequence<string> AttributeNames; - interface DynamicAttributeAccess { - AttributeNames attribute_names(); - any attribute_get(in string name); - void attribute_set(in string name, in any value); - }; - - typedef string ClusterID; - typedef sequence<ClusterID> ClusterIDs; - interface PDS_ClusteredDA : PDS_DA{ - ClusterID cluster_id(); - string cluster_kind(); - ClusterIDs clusters_of(); - PDS_ClusteredDA create_cluster(in string kind); - PDS_ClusteredDA open_cluster(in ClusterID cluster); - PDS_ClusteredDA copy_cluster( - in PDS_DA source); - }; -}; - -// CosPersistenceDDO Module, p 5-32 CORBAservices, Persistent Object Service V1.0, 3/94 - -// #include "CosPersistencePID.idl" -module CosPersistenceDDO { - - interface DDO { - attribute string object_type; - attribute ::COSS::CosPersistencePID::PID p; - short add_data(); - short add_data_property (in short data_id); - short get_data_count(); - short get_data_property_count (in short data_id); - void get_data_property (in short data_id, - in short property_id, - out string property_name, - out any property_value); - void set_data_property (in short data_id, - in short property_id, - in string property_name, - in any property_value); - void get_data (in short data_id, - out string data_name, - out any data_value); - void set_data (in short data_id, - in string data_name, - in any data_value); - }; -}; - -// CosPersistenceDS_CLI module, p 5-34 CORBAservices, -// Persistent Object Service V1.0, 3/94 - -// #include "CosPersistenceDDO.idl" -// CosPersistenceDDO.idl // #includes CosPersistencePID.idl - -module CosPersistenceDS_CLI { - interface UserEnvironment { - void set_option (in long option,in any value); - void get_option (in long option,out any value); - void release(); - }; - - interface Connection { - void set_option (in long option,in any value); - void get_option (in long option,out any value); - }; - - interface ConnectionFactory { - Connection create_object ( - in UserEnvironment user_envir); - }; - - interface Cursor { - void set_position (in long position,in any value); - ::COSS::CosPersistenceDDO::DDO fetch_object(); - }; - - interface CursorFactory { - Cursor create_object ( - in Connection connection); - }; - - interface PID_CLI : ::COSS::CosPersistencePID::PID { - attribute string datastore_id; - attribute string id; - }; - - - - interface Datastore_CLI { - void connect (in Connection connection, - in string datastore_id, - in string user_name, - in string authentication); - void disconnect (in Connection connection); - Connection get_connection ( - in string datastore_id, - in string user_name); - void add_object (in Connection connection, - in ::COSS::CosPersistenceDDO::DDO data_obj); - void delete_object ( - in Connection connection, - in ::COSS::CosPersistenceDDO::DDO data_obj); - void update_object ( - in Connection connection, - in ::COSS::CosPersistenceDDO::DDO data_obj); - void retrieve_object( - in Connection connection, - in ::COSS::CosPersistenceDDO::DDO data_obj); - Cursor select_object( - in Connection connection, - in string key); - void transact (in UserEnvironment user_envir, - in short completion_type); - void assign_PID (in PID_CLI p); - void assign_PID_relative ( - in PID_CLI source_pid, - in PID_CLI target_pid); - boolean is_identical_PID ( - in PID_CLI pid_1, - in PID_CLI pid_2); - string get_object_type (in PID_CLI p); - void register_mapping_schema (in string schema_file); - Cursor execute (in Connection connection, - in string command); - }; - -}; - - -// CosLifeCycle Module, p 6-10 CORBAservices, LifeCycle Service V1.0, 3/94 - -// #include "Naming.idl" - -module CosLifeCycle -{ - typedef ::COSS::CosNaming::Name Key; - typedef Object Factory; - typedef sequence <Factory> Factories; - typedef struct NVP { - ::COSS::CosNaming::Istring name; - any value; - } NameValuePair; - typedef sequence <NameValuePair> Criteria; - - exception NoFactory { - Key search_key; - }; - exception NotCopyable { string reason; }; - exception NotMovable { string reason; }; - exception NotRemovable { string reason; }; - exception InvalidCriteria{ - Criteria invalid_criteria; - }; - exception CannotMeetCriteria { - Criteria unmet_criteria; - }; - - - interface FactoryFinder { - Factories find_factories(in Key factory_key) - raises(NoFactory); - }; - - interface LifeCycleObject { - LifeCycleObject copy(in FactoryFinder there, - in Criteria the_criteria) - raises(NoFactory, NotCopyable, InvalidCriteria, - CannotMeetCriteria); - void move(in FactoryFinder there, - in Criteria the_criteria) - raises(NoFactory, NotMovable, InvalidCriteria, - CannotMeetCriteria); - void remove() - raises(NotRemovable); - }; - - interface GenericFactory { - boolean supports(in Key k); - Object create_object( - in Key k, - in Criteria the_criteria) - raises (NoFactory, InvalidCriteria, - CannotMeetCriteria); - }; -}; - - - -// LifeCycleService Module, p 6- 55 CORBAservices, Life Cycle -// Service V1.0, 3/94 - -// #include "LifeCycle.idl" - -module LifeCycleService { - - typedef sequence <::COSS::CosLifeCycle::NameValuePair> PolicyList; - typedef sequence <::COSS::CosLifeCycle::Key> Keys; - typedef sequence <::COSS::CosLifeCycle::NameValuePair> PropertyList; - typedef sequence <::COSS::CosNaming::NameComponent> NameComponents; - - interface LifeCycleServiceAdmin { - - attribute PolicyList policies; - - void bind_generic_factory( - in ::COSS::CosLifeCycle::GenericFactory gf, - in ::COSS::CosNaming::NameComponent name, - in Keys key_set, - in PropertyList other_properties) - raises (::COSS::CosNaming::NamingContext::AlreadyBound, ::COSS::CosNaming::NamingContext::InvalidName); - - void unbind_generic_factory( - in ::COSS::CosNaming::NameComponent name) - raises (::COSS::CosNaming::NamingContext::NotFound, ::COSS::CosNaming::NamingContext::InvalidName); - - ::COSS::CosLifeCycle::GenericFactory resolve_generic_factory( - in ::COSS::CosNaming::NameComponent name) - raises (::COSS::CosNaming::NamingContext::NotFound, ::COSS::CosNaming::NamingContext::InvalidName); - - NameComponents list_generic_factories(); - - boolean match_service (in ::COSS::CosLifeCycle::GenericFactory f); - - string get_hint(); - - void get_link_properties( - in ::COSS::CosNaming::NameComponent name, - out Keys key_set, - out PropertyList other_properties) - raises (::COSS::CosNaming::NamingContext::NotFound, ::COSS::CosNaming::NamingContext::InvalidName); - }; -}; - -// CosTransactions Module, p 10-66 -// CORBAservices, Transaction Service V1.0, 3/94 - -module CosTransactions { -// DATATYPES -enum Status { - StatusActive, - StatusMarkedRollback, - StatusPrepared, - StatusCommitted, - StatusRolledBack, - StatusUnknown, - StatusNoTransaction -}; - -enum Vote { - VoteCommit, - VoteRollback, - VoteReadOnly -}; - -// Standard exceptions -exception TransactionRequired {}; -exception TransactionRolledBack {}; -exception InvalidTransaction {}; - -// Heuristic exceptions -exception HeuristicRollback {}; -exception HeuristicCommit {}; -exception HeuristicMixed {}; -exception HeuristicHazard {}; - -// Exception from Orb operations -exception WrongTransaction {}; - -// Other transaction-specific exceptions -exception SubtransactionsUnavailable {}; -exception NotSubtransaction {}; -exception Inactive {}; -exception NotPrepared {}; -exception NoTransaction {}; -exception InvalidControl {}; -exception Unavailable {}; - -// Forward references for interfaces defined later in module -interface Control; -interface Terminator; -interface Coordinator; -interface Resource; -interface RecoveryCoordinator; -interface SubtransactionAwareResource; -interface TransactionFactory; -interface TransactionalObject; -interface Current; - -// Current transaction pseudo object (PIDL) - interface Current { - void begin() - raises(SubtransactionsUnavailable); - void commit(in boolean report_heuristics) - raises( - NoTransaction, - HeuristicMixed, - HeuristicHazard - ); - void rollback() - raises(NoTransaction); - void rollback_only() - raises(NoTransaction); - - Status get_status(); - string get_transaction_name(); - void set_timeout(in unsigned long seconds); - - Control get_control(); - Control suspend(); - void resume(in Control which) - raises(InvalidControl); - }; - - interface TransactionFactory { - Control create(in unsigned long time_out); - }; - - interface Control { - Terminator get_terminator() - raises(Unavailable); - Coordinator get_coordinator() - raises(Unavailable); - }; - - interface Terminator { - void commit(in boolean report_heuristics) - raises( - HeuristicMixed, - HeuristicHazard - ); - void rollback(); - }; - - - interface Coordinator { - - Status get_status(); - Status get_parent_status(); - Status get_top_level_status(); - - boolean is_same_transaction(in Coordinator tc); - boolean is_related_transaction(in Coordinator tc); - boolean is_ancestor_transaction(in Coordinator tc); - boolean is_descendant_transaction(in Coordinator tc); - boolean is_top_level_transaction(); - - unsigned long hash_transaction(); - unsigned long hash_top_level_tran(); - - RecoveryCoordinator register_resource(in Resource r) - raises(Inactive); - - void register_subtran_aware(in SubtransactionAwareResource r) - raises(Inactive, NotSubtransaction); - - void rollback_only() - raises(Inactive); - - string get_transaction_name(); - - Control create_subtransaction() - raises(SubtransactionsUnavailable, Inactive); - }; - - interface RecoveryCoordinator { - Status replay_completion(in Resource r) - raises(NotPrepared); - }; - -}; // end module CosTransactions - - -// CosConcurrency Control Module, p 7-8 CORBAservices, -// Concurrency Control Service V1.0, 3/94 - -// #include <CosTransactions.idl> -module CosConcurrencyControl { - - enum lock_mode { - read, - write, - upgrade, - intention_read, - intention_write - }; - - exception LockNotHeld{}; - - interface LockCoordinator - { - void drop_locks(); - }; - - interface LockSet - { - void lock(in lock_mode mode); - boolean try_lock(in lock_mode mode); - - void unlock(in lock_mode mode) - raises(LockNotHeld); - void change_mode(in lock_mode held_mode, - in lock_mode new_mode) - raises(LockNotHeld); - LockCoordinator get_coordinator( - in ::COSS::CosTransactions::Coordinator which); - }; - - interface TransactionalLockSet - { - void lock(in ::COSS::CosTransactions::Coordinator current, - in lock_mode mode); - boolean try_lock(in ::COSS::CosTransactions::Coordinator current, - in lock_mode mode); - void unlock(in ::COSS::CosTransactions::Coordinator current, - in lock_mode mode) - raises(LockNotHeld); - void change_mode(in ::COSS::CosTransactions::Coordinator current, - in lock_mode held_mode, - in lock_mode new_mode) - raises(LockNotHeld); - LockCoordinator get_coordinator( - in ::COSS::CosTransactions::Coordinator which); - }; - - interface LockSetFactory - { - LockSet create(); - LockSet create_related(in LockSet which); - TransactionalLockSet create_transactional(); - TransactionalLockSet create_transactional_related(in - TransactionalLockSet which); - }; -}; - -// CosObjectIdentity Module, p 9-19 CORBAservices, Relationship -// Service V1.0, 3/94 - - -module CosObjectIdentity { - - typedef unsigned long ObjectIdentifier; - - interface IdentifiableObject { - readonly attribute ObjectIdentifier constant_random_id; - boolean is_identical ( - in IdentifiableObject other_object); - }; - -}; - - -// CosRelationships Module, p 9-21 CORBAservices, Relationship -// Service V1.0, 3/94 - -// #include <ObjectIdentity.idl> - -module CosRelationships { - - interface RoleFactory; - interface RelationshipFactory; - interface Relationship; - interface Role; - interface RelationshipIterator; - - typedef Object RelatedObject; - typedef sequence<Role> Roles; - typedef string RoleName; - typedef sequence<RoleName> RoleNames; - - struct NamedRole {RoleName name; Role aRole;}; - typedef sequence<NamedRole> NamedRoles; - - struct RelationshipHandle { - Relationship the_relationship; - ::COSS::CosObjectIdentity::ObjectIdentifier constant_random_id; - }; - typedef sequence<RelationshipHandle> RelationshipHandles; - - interface RelationshipFactory { - struct NamedRoleType { - RoleName name; - ::CORBA::InterfaceDef named_role_type; - }; - typedef sequence<NamedRoleType> NamedRoleTypes; - readonly attribute ::CORBA::InterfaceDef relationship_type; - readonly attribute unsigned short degree; - readonly attribute NamedRoleTypes named_role_types; - exception RoleTypeError {NamedRoles culprits;}; - exception MaxCardinalityExceeded { - NamedRoles culprits;}; - exception DegreeError {unsigned short required_degree;}; - exception DuplicateRoleName {NamedRoles culprits;}; - exception UnknownRoleName {NamedRoles culprits;}; - - Relationship create (in NamedRoles named_roles) - raises (RoleTypeError, - MaxCardinalityExceeded, - DegreeError, - DuplicateRoleName, - UnknownRoleName); - }; - - interface Relationship : - ::COSS::CosObjectIdentity::IdentifiableObject { - exception CannotUnlink { - Roles offending_roles; - }; - readonly attribute NamedRoles named_roles; - void destroy () raises(CannotUnlink); - }; - - interface Role { - exception UnknownRoleName {}; - exception UnknownRelationship {}; - exception RelationshipTypeError {}; - exception CannotDestroyRelationship { - RelationshipHandles offenders; - }; - exception ParticipatingInRelationship { - RelationshipHandles the_relationships; - }; - readonly attribute RelatedObject related_object; - RelatedObject get_other_related_object ( - in RelationshipHandle rel, - in RoleName target_name) - raises (UnknownRoleName, - UnknownRelationship); - Role get_other_role (in RelationshipHandle rel, - in RoleName target_name) - raises (UnknownRoleName, UnknownRelationship); - void get_relationships ( - in unsigned long how_many, - out RelationshipHandles rels, - out RelationshipIterator iterator); - void destroy_relationships() - raises(CannotDestroyRelationship); - void destroy() raises(ParticipatingInRelationship); - boolean check_minimum_cardinality (); - void link (in RelationshipHandle rel, - in NamedRoles named_roles) - raises(RelationshipFactory::MaxCardinalityExceeded, - RelationshipTypeError); - void unlink (in RelationshipHandle rel) - raises (UnknownRelationship); - }; - - interface RoleFactory { - exception NilRelatedObject {}; - exception RelatedObjectTypeError {}; - readonly attribute ::CORBA::InterfaceDef role_type; - readonly attribute unsigned long max_cardinality; - readonly attribute unsigned long min_cardinality; -// the following isn't allowed in IDL, -// readonly attribute sequence <::CORBA::InterfaceDef> related_object_types; - typedef sequence <::CORBA::InterfaceDef> InterfaceDefSeq; - readonly attribute InterfaceDefSeq related_object_types; - Role create_role (in RelatedObject related_object) - raises (NilRelatedObject, RelatedObjectTypeError); - }; - - interface RelationshipIterator { - boolean next_one (out RelationshipHandle rel); - boolean next_n (in unsigned long how_many, - out RelationshipHandles rels); - void destroy (); - }; - -}; - -// CosCompoundExternalization Module, p 8-20 CORBAservices, -// Externalization Service V1.0, 3/94 - -// #include <Graphs.idl> -// #include <Stream.idl> - -// CosGraphs Module, p 9-39 CORBAservices, Relationship Service -// V1.0, 3/94 - -// #include <Relationships.idl> -// #include <ObjectIdentity.idl> - -module CosGraphs { - - interface TraversalFactory; - interface Traversal; - interface TraversalCriteria; - interface Node; - interface NodeFactory; - interface Role; - interface EdgeIterator; - - struct NodeHandle { - Node the_node; - ::COSS::CosObjectIdentity::ObjectIdentifier constant_random_id; - }; - typedef sequence<NodeHandle> NodeHandles; - - struct NamedRole { - Role the_role; - ::COSS::CosRelationships::RoleName the_name; - }; - typedef sequence<NamedRole> NamedRoles; - - struct EndPoint { - NodeHandle the_node; - NamedRole the_role; - }; - typedef sequence<EndPoint> EndPoints; - - struct Edge { - EndPoint from; - ::COSS::CosRelationships::RelationshipHandle the_relationship; - EndPoints relatives; - }; - typedef sequence<Edge> Edges; - - enum PropagationValue {deep, shallow, none, inhibit}; - enum Mode {depthFirst, breadthFirst, bestFirst}; - - interface TraversalFactory { - Traversal create_traversal_on ( - in NodeHandle root_node, - in TraversalCriteria the_criteria, - in Mode how); - }; - - interface Traversal { - typedef unsigned long TraversalScopedId; - struct ScopedEndPoint { - EndPoint point; - TraversalScopedId id; - }; - typedef sequence<ScopedEndPoint> ScopedEndPoints; - struct ScopedRelationship { - ::COSS::CosRelationships::RelationshipHandle - scoped_relationship; - TraversalScopedId id; - }; - struct ScopedEdge { - ScopedEndPoint from; - ScopedRelationship the_relationship; - ScopedEndPoints relatives; - }; - typedef sequence<ScopedEdge> ScopedEdges; - boolean next_one (out ScopedEdge the_edge); - boolean next_n (in short how_many, - out ScopedEdges the_edges); - void destroy (); - }; - - interface TraversalCriteria { - struct WeightedEdge { - Edge the_edge; - unsigned long weight; - sequence<NodeHandle> next_nodes; - }; - typedef sequence<WeightedEdge> WeightedEdges; - void visit_node(in NodeHandle a_node, - in Mode search_mode); - boolean next_one (out WeightedEdge the_edge); - boolean next_n (in short how_many, - out WeightedEdges the_edges); - void destroy(); - }; - - interface Node: ::COSS::CosObjectIdentity::IdentifiableObject { - typedef sequence<Role> Roles; - exception NoSuchRole {}; - exception DuplicateRoleType {}; - - readonly attribute ::COSS::CosRelationships::RelatedObject - related_object; - readonly attribute Roles roles_of_node; - Roles roles_of_type ( - in ::CORBA::InterfaceDef role_type); - void add_role (in Role a_role) - raises (DuplicateRoleType); - void remove_role (in ::CORBA::InterfaceDef of_type) - raises (NoSuchRole); - }; - - interface NodeFactory { - Node create_node (in Object related_object); - }; - - interface Role : ::COSS::CosRelationships::Role { - void get_edges ( in long how_many, - out Edges the_edges, - out EdgeIterator the_rest); - }; - - interface EdgeIterator { - boolean next_one (out Edge the_edge); - boolean next_n ( in unsigned long how_many, - out Edges the_edges); - void destroy (); - }; - -}; - - - -// CosStream Module, 8-15 CORBAservices, -// Externalization Service V1.0, 3/94 - -// #include <LifeCycle.idl> -// #include <ObjectIdentity.idl> -// #include <CompoundExternalization.idl> -module CosStream { - exception ObjectCreationError{}; - exception StreamDataFormatError{}; - interface StreamIO; - - interface Streamable: ::COSS::CosObjectIdentity::IdentifiableObject - { - readonly attribute ::COSS::CosLifeCycle::Key external_form_id; - void externalize_to_stream( - in StreamIO targetStreamIO); - void internalize_from_stream( - in StreamIO sourceStreamIO, - in ::COSS::CosLifeCycle::FactoryFinder there) - raises( ::COSS::CosLifeCycle::NoFactory, - ObjectCreationError, - StreamDataFormatError ); - }; - - interface StreamableFactory { - Streamable create_uninitialized(); - }; - - - interface StreamIO { - void write_string(in string aString); - void write_char(in char aChar); - void write_octet(in octet anOctet); - void write_unsigned_long( - in unsigned long anUnsignedLong); - void write_unsigned_short( - in unsigned short anUnsignedShort); - void write_long(in long aLong); - void write_short(in short aShort); - void write_float(in float aFloat); - void write_double(in double aDouble); - void write_boolean(in boolean aBoolean); - void write_object(in Streamable aStreamable); - // void write_graph(in ::COSS::CosCompoundExternalization::Node aNode); - string read_string() - raises(StreamDataFormatError); - char read_char() - raises(StreamDataFormatError ); - octet read_octet() - raises(StreamDataFormatError ); - unsigned long read_unsigned_long() - raises(StreamDataFormatError ); - unsigned short read_unsigned_short() - raises( StreamDataFormatError ); - long read_long() - raises(StreamDataFormatError ); - short read_short() - raises(StreamDataFormatError ); - float read_float() - raises(StreamDataFormatError ); - double read_double() - raises(StreamDataFormatError ); - boolean read_boolean() - raises(StreamDataFormatError ); - Streamable read_object( - in ::COSS::CosLifeCycle::FactoryFinder there, - in Streamable aStreamable) - raises(StreamDataFormatError ); -// void read_graph( -// in ::COSS::CosCompoundExternalization::Node starting_node, -// in ::COSS::CosLifeCycle::FactoryFinder there) -// raises(StreamDataFormatError ); - }; -}; - -module CosCompoundExternalization { - interface Node; - interface Role; - interface Relationship; - interface PropagationCriteriaFactory; - - struct RelationshipHandle { - Relationship theRelationship; - ::COSS::CosObjectIdentity::ObjectIdentifier constantRandomId; - }; - - interface Node : ::COSS::CosGraphs::Node, ::COSS::CosStream::Streamable{ - void externalize_node (in ::COSS::CosStream::StreamIO sio); - void internalize_node (in ::COSS::CosStream::StreamIO sio, - in ::COSS::CosLifeCycle::FactoryFinder there, - out ::COSS::CosGraphs::Node::Roles rolesOfNode) - raises (::COSS::CosLifeCycle::NoFactory); - }; - - interface Role : ::COSS::CosGraphs::Role { - void externalize_role (in ::COSS::CosStream::StreamIO sio); - void internalize_role (in ::COSS::CosStream::StreamIO sio); - ::COSS::CosGraphs::PropagationValue externalize_propagation ( - in RelationshipHandle rel, - in ::COSS::CosRelationships::RoleName toRoleName, - out boolean sameForAll); - }; - - interface Relationship : - ::COSS::CosRelationships::Relationship { - void externalize_relationship ( - in ::COSS::CosStream::StreamIO sio); - void internalize_relationship( - in ::COSS::CosStream::StreamIO sio, - in ::COSS::CosGraphs::NamedRoles newRoles); - ::COSS::CosGraphs::PropagationValue externalize_propagation ( - in ::COSS::CosRelationships::RoleName fromRoleName, - in ::COSS::CosRelationships::RoleName toRoleName, - out boolean sameForAll); - }; - - interface PropagationCriteriaFactory { - ::COSS::CosGraphs::TraversalCriteria create_for_externalize( ); - }; - -}; - -// CosExternalization Module, 8-12 CORBAservices, -// Externalization Service V1.0, 3/94 - - -// #include <LifeCycle.idl> -// #include <Stream.idl> -module CosExternalization { - exception InvalidFileNameError{}; - exception ContextAlreadyRegistered{}; - interface Stream: ::COSS::CosLifeCycle::LifeCycleObject{ - void externalize( - in ::COSS::CosStream::Streamable theObject); - ::COSS::CosStream::Streamable internalize( - in ::COSS::CosLifeCycle::FactoryFinder there) - raises( ::COSS::CosLifeCycle::NoFactory, - ::COSS::CosStream::StreamDataFormatError ); - void begin_context() - raises( ContextAlreadyRegistered); - void end_context(); - void flush(); - }; - interface StreamFactory { - Stream create(); - }; - interface FileStreamFactory { - Stream create( - in string theFileName) - raises( InvalidFileNameError ); - }; -}; - -// CosContainment Module, p 9- 48 CORBAservices, Relationship -// Service V1.0, 3/94 - -// #include <Graphs.idl> - -module CosContainment { - - interface Relationship : - ::COSS::CosRelationships::Relationship {}; - - interface ContainsRole : ::COSS::CosGraphs::Role {}; - - interface ContainedInRole : ::COSS::CosGraphs::Role {}; - -}; - -// CosExternalizationContainment Module, p 8-26 CORBAservices, -// Externalization Service V1.0, 3/94 - -// #include <Containment.idl> -// #include <CompoundExternalization.idl> - -module CosExternalizationContainment { - - interface Relationship : - ::COSS::CosCompoundExternalization::Relationship, - ::COSS::CosContainment::Relationship {}; - - interface ContainsRole : - ::COSS::CosCompoundExternalization::Role, - ::COSS::CosContainment::ContainsRole {}; - - interface ContainedInRole : - ::COSS::CosCompoundExternalization::Role, - ::COSS::CosContainment::ContainedInRole {}; -}; - -// CosReference Module, p 9-50 CORBAservices, -// Relationship Service V1.0, 3/94 - -// #include <Graphs.idl> - -module CosReference { - - interface Relationship : - ::COSS::CosRelationships::Relationship {}; - - interface ReferencesRole : ::COSS::CosGraphs::Role {}; - - interface ReferencedByRole : ::COSS::CosGraphs::Role {}; - -}; - -// CosExternalizationReference Module, p 8-28 CORBAservices, -// Externalization Service V1.0, 3/94 - -// #include <Reference.idl> -// #include <CompoundExternalization.idl> - -module CosExternalizationReference { - - interface Relationship : - ::COSS::CosCompoundExternalization::Relationship, - ::COSS::CosReference::Relationship {}; - - interface ReferencesRole : - ::COSS::CosCompoundExternalization::Role, - ::COSS::CosReference::ReferencesRole {}; - - interface ReferencedByRole : - ::COSS::CosCompoundExternalization::Role, - ::COSS::CosReference::ReferencedByRole {}; -}; - -// PIDL for CosTSInteroperation Module, p 10-59 -// CORBAservices, Transaction Service V1.0, 3/94 -module CosTSInteroperation { // PIDL - struct otid_t { - long formatID; /*format identifier. 0 is OSI TP */ - long bequal_length; - sequence <octet> tid; - }; - struct TransIdentity { - ::COSS::CosTransactions::Coordinator coordinator; - ::COSS::CosTransactions::Terminator terminator; - otid_t otid; - }; - struct PropagationContext { - unsigned long timeout; - TransIdentity current; - sequence <TransIdentity> parents; - any implementation_specific_data; - }; -}; - -// PIDL for CosTSPortability Module, p 10-63 -// CORBAservices, Transaction Service V1.0, 3/94 - -module CosTSPortability { // PIDL - typedef long ReqId; - - interface Sender { - void sending_request(in ReqId id, - out ::COSS::CosTSInteroperation::PropagationContext ctx); - void received_reply(in ReqId id, - in ::COSS::CosTSInteroperation::PropagationContext ctx, - in ::CORBA::Environment env); - }; - - interface Receiver { - void received_request(in ReqId id, - in ::COSS::CosTSInteroperation::PropagationContext ctx); - void sending_reply(in ReqId id, - out::COSS::CosTSInteroperation::PropagationContext ctx); - }; -}; - -// CosCompoundLifeCycle Module, p 6-30 CORBAservices, -// Life Cycle Service V1.0, 3/94 - -// #include <LifeCycle.idl> -// #include <Relationships.idl> -// #include <Graphs.idl> - -module CosCompoundLifeCycle { - interface OperationsFactory; - interface Operations; - interface Node; - interface Role; - interface Relationship; - interface PropagationCriteriaFactory; - - enum Operation {copy, move, remove}; - - struct RelationshipHandle { - Relationship the_relationship; - ::COSS::CosObjectIdentity::ObjectIdentifier constant_random_id; - }; - - interface OperationsFactory { - Operations create_compound_operations(); - }; - - interface Operations { - Node copy ( - in Node starting_node, - in ::COSS::CosLifeCycle::FactoryFinder there, - in ::COSS::CosLifeCycle::Criteria the_criteria) - raises (::COSS::CosLifeCycle::NoFactory, - ::COSS::CosLifeCycle::NotCopyable, - ::COSS::CosLifeCycle::InvalidCriteria, - ::COSS::CosLifeCycle::CannotMeetCriteria); - void move ( - in Node starting_node, - in ::COSS::CosLifeCycle::FactoryFinder there, - in ::COSS::CosLifeCycle::Criteria the_criteria) - raises (::COSS::CosLifeCycle::NoFactory, - ::COSS::CosLifeCycle::NotMovable, - ::COSS::CosLifeCycle::InvalidCriteria, - ::COSS::CosLifeCycle::CannotMeetCriteria); - void remove (in Node starting_node) - raises (::COSS::CosLifeCycle::NotRemovable); - void destroy(); - }; - - interface Node : ::COSS::CosGraphs::Node { - exception NotLifeCycleObject {}; - void copy_node ( in ::COSS::CosLifeCycle::FactoryFinder there, - in ::COSS::CosLifeCycle::Criteria the_criteria, - out Node new_node, - out ::COSS::CosGraphs::Node::Roles roles_of_new_node) - raises (::COSS::CosLifeCycle::NoFactory, - ::COSS::CosLifeCycle::NotCopyable, - ::COSS::CosLifeCycle::InvalidCriteria, - ::COSS::CosLifeCycle::CannotMeetCriteria); - void move_node (in ::COSS::CosLifeCycle::FactoryFinder there, - in ::COSS::CosLifeCycle::Criteria the_criteria) - raises (::COSS::CosLifeCycle::NoFactory, - ::COSS::CosLifeCycle::NotMovable, - ::COSS::CosLifeCycle::InvalidCriteria, - ::COSS::CosLifeCycle::CannotMeetCriteria); - void remove_node () - raises (::COSS::CosLifeCycle::NotRemovable); - ::COSS::CosLifeCycle::LifeCycleObject get_life_cycle_object() - raises (NotLifeCycleObject); - }; - - interface Role : ::COSS::CosGraphs::Role { - Role copy_role (in ::COSS::CosLifeCycle::FactoryFinder there, - in ::COSS::CosLifeCycle::Criteria the_criteria) - raises (::COSS::CosLifeCycle::NoFactory, - ::COSS::CosLifeCycle::NotCopyable, - ::COSS::CosLifeCycle::InvalidCriteria, - ::COSS::CosLifeCycle::CannotMeetCriteria); - void move_role (in ::COSS::CosLifeCycle::FactoryFinder there, - in ::COSS::CosLifeCycle::Criteria the_criteria) - raises (::COSS::CosLifeCycle::NoFactory, - ::COSS::CosLifeCycle::NotMovable, - ::COSS::CosLifeCycle::InvalidCriteria, - ::COSS::CosLifeCycle::CannotMeetCriteria); - ::COSS::CosGraphs::PropagationValue life_cycle_propagation ( - in Operation op, - in RelationshipHandle rel, - in ::COSS::CosRelationships::RoleName to_role_name, - out boolean same_for_all); - }; - - interface Relationship : - ::COSS::CosRelationships::Relationship { - Relationship copy_relationship ( - in ::COSS::CosLifeCycle::FactoryFinder there, - in ::COSS::CosLifeCycle::Criteria the_criteria, - in ::COSS::CosGraphs::NamedRoles new_roles) - raises (::COSS::CosLifeCycle::NoFactory, - ::COSS::CosLifeCycle::NotCopyable, - ::COSS::CosLifeCycle::InvalidCriteria, - ::COSS::CosLifeCycle::CannotMeetCriteria); - void move_relationship ( - in ::COSS::CosLifeCycle::FactoryFinder there, - in ::COSS::CosLifeCycle::Criteria the_criteria) - raises (::COSS::CosLifeCycle::NoFactory, - ::COSS::CosLifeCycle::NotMovable, - ::COSS::CosLifeCycle::InvalidCriteria, - ::COSS::CosLifeCycle::CannotMeetCriteria); - ::COSS::CosGraphs::PropagationValue life_cycle_propagation ( - in Operation op, - in ::COSS::CosRelationships::RoleName from_role_name, - in ::COSS::CosRelationships::RoleName to_role_name, - out boolean same_for_all); - }; - - interface PropagationCriteriaFactory { - ::COSS::CosGraphs::TraversalCriteria create(in Operation op); - }; - -}; - -// CosLifeCycleContainment Module, p 6-42 CORBAservices, -// Life Cycle Service V1.0, 3/94 - -// #include <Containment.idl> -// #include <CompoundLifeCycle.idl> - -module CosLifeCycleContainment { - - interface Relationship : - ::COSS::CosCompoundLifeCycle::Relationship, - ::COSS::CosContainment::Relationship {}; - - interface ContainsRole : - ::COSS::CosCompoundLifeCycle::Role, - ::COSS::CosContainment::ContainsRole {}; - - interface ContainedInRole : - ::COSS::CosCompoundLifeCycle::Role, - ::COSS::CosContainment::ContainedInRole {}; -}; - -// CosLifeCycleReference Module, p 6-44 CORBAservices, -// Life Cycle Service V1.0, 3/94 - -// #include <Reference.idl> -// #include <CompoundLifeCycle.idl> - -module CosLifeCycleReference { - - interface Relationship : - ::COSS::CosCompoundLifeCycle::Relationship, - ::COSS::CosReference::Relationship {}; - - interface ReferencesRole : - ::COSS::CosCompoundLifeCycle::Role, - ::COSS::CosReference::ReferencesRole {}; - - interface ReferencedByRole : - ::COSS::CosCompoundLifeCycle::Role, - ::COSS::CosReference::ReferencedByRole {}; -}; - - -}; // end module COSS diff --git a/lib/ic/test/ic_SUITE_data/attr.idl b/lib/ic/test/ic_SUITE_data/attr.idl deleted file mode 100644 index 0a1edc787c..0000000000 --- a/lib/ic/test/ic_SUITE_data/attr.idl +++ /dev/null @@ -1,30 +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% - -interface I1 { - attribute long a1, a2; - attribute char a3; -}; - -interface I2 : I1 { - attribute short a4; - readonly attribute char a5; -}; - diff --git a/lib/ic/test/ic_SUITE_data/c_err1.idl b/lib/ic/test/ic_SUITE_data/c_err1.idl deleted file mode 100644 index d50c51c807..0000000000 --- a/lib/ic/test/ic_SUITE_data/c_err1.idl +++ /dev/null @@ -1,64 +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% - -// -// This file forces the bad_tk_match. This triggers when the type of -// the expression does not match the declared type of the constant -// - -const long c1 = TRUE; -const unsigned short c1b= TRUE; -const boolean c2 = +5; -const long c3 = 'c'; -const float c5 = 3; -const unsigned long c6 = -2; // Maybe not checked in compiler or suite - -const boolean c4 = 1 | 2; - - -// Now define some correct constants for use in reference checking - -const long longC = -9; -const short shortC = -9; -const unsigned long ulongC = 1; -const unsigned short ushortC = 0; - -const float floatC = 5.1; -const double doubleC = -2.111; - -const boolean boolC = TRUE; - -const char charC = 'f'; -const string stringC = "hej"; -const string<9> stringCb = "hejdu"; - -// Check the reference errors - -const long c19 = floatC; -const short c20 = doubleC; -const unsigned long c21 = charC; -const unsigned short c22 = stringC; -const float c23 = stringCb; -const double c24 = boolC; -const boolean c25 = longC; -const char c26 = shortC; -const string c27 = ushortC; -const string<9> c28 = ulongC; -const long c29 = 3+floatC; diff --git a/lib/ic/test/ic_SUITE_data/c_err2.idl b/lib/ic/test/ic_SUITE_data/c_err2.idl deleted file mode 100644 index 84c12421ef..0000000000 --- a/lib/ic/test/ic_SUITE_data/c_err2.idl +++ /dev/null @@ -1,31 +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% - -// -// Checks bad type of operands -// - - -const long c1 = 1 + TRUE; -const boolean c3 = TRUE | FALSE | 19.8; -const long c4 = 1 << TRUE; -const long c5 = TRUE >> TRUE; - - diff --git a/lib/ic/test/ic_SUITE_data/c_err3.idl b/lib/ic/test/ic_SUITE_data/c_err3.idl deleted file mode 100644 index 910f7abcf1..0000000000 --- a/lib/ic/test/ic_SUITE_data/c_err3.idl +++ /dev/null @@ -1,29 +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% - -// -// Checks ill-formed expressions (type conflict in operands) -// - - -const long c1 = 5|TRUE; -const long c2 = 5&TRUE; -const long c3 = 5^TRUE; - diff --git a/lib/ic/test/ic_SUITE_data/c_norm.idl b/lib/ic/test/ic_SUITE_data/c_norm.idl deleted file mode 100644 index b573ac3f3d..0000000000 --- a/lib/ic/test/ic_SUITE_data/c_norm.idl +++ /dev/null @@ -1,164 +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% - -// -// Check normal values and expressions for constants -// - -// Integer types -const long co1 = 077; -const long ch1 = 0xf1; -const long ch2 = 0XAB; -const long c1 = 1; -const short c2 = 3; -const unsigned long c3 = 1; -const unsigned short c4 = 3; - -// Unary ops -const long c1hb = -0x1; -const long c1b = -1; -const short c2b = -3; -const long c1c = +1; -const short c2c = +3; -// ~ not supported - -// Check binary ops -const long c1d = 9+1-3; -const long c1hd = 9+1-0xf3; -const short c2d = 7+3; -const short c2e = 7*3; -const long c1e = 1 | 7; -const long c1f = 7 & 9; -const long c1g = (1 | 7) & 9; -const long c1h = 1^7; - -//floats -const float c5 = 1.9; -const double c6 = 1.9; -const float c5b = -1.9; -const double c6b = -1.9; - -// Check type operand casting -const float c5c = 1/(9+2) * 2; -const double c6c = 1.9-1; -//const double c6d = 1; // Does not work yet - -// Booleans and expressions -const boolean c7 = TRUE; -const boolean c7b = FALSE; -const boolean c7c = TRUE | FALSE; -const boolean c7d = TRUE & FALSE; -const boolean c7e = TRUE&TRUE | FALSE&TRUE; -const boolean c7f = TRUE&TRUE ^ FALSE&TRUE; - -// Character and string -const char c8 = 'c'; -const char c8b = '\n'; -const string c9 = "hej"; -const string<9> c9b = "hejdu"; - - -// -// Check that value references work -// - -const long rc1 = c1g; -const long rc1h = c1h + 9; -const short rc2 = c2; -const unsigned long rc3 = c3; -const unsigned short rc4 = c4; - - -const float rc5c = c5c; -const double rc6c = c6c; -const double rc6d = c6c+1.3; - -const boolean rc7 = c7; -const boolean rc7c = c7c | TRUE; - -const char rc8 = c8; -const char rc8b = c8b; -const string rc9 = c9; -const string<9> rc9b = c9b; - - - - -// -// Now check that all typerefs work -// - -typedef long longT; -typedef short shortT; -typedef unsigned long ulongT; -typedef unsigned short ushortT; - -typedef float floatT; -typedef double doubleT; - -typedef char charT; -typedef string stringT; - -typedef boolean booleanT; - -const longT cc1 = 1; -const shortT cc2 = 3; -const ::longT cc1b = -1; -const ::shortT cc2b = -3; - -const floatT cc5 = 1.9; -const doubleT cc6 = 1.9; -const floatT cc5b = -1.9; -const doubleT cc6b = -1.9; -const floatT cc5c = 1/(9+2) * 2; -const doubleT cc6c = 1.9-1; - -const booleanT cc7 = TRUE; -const booleanT cc7b = TRUE; -const booleanT cc7c = TRUE | FALSE; -const booleanT cc7d = TRUE & FALSE; -const booleanT cc7e = TRUE&TRUE | FALSE&TRUE; - - -const charT cc8 = 'c'; -const charT cc8b = '\n'; -const stringT cc9 = "hej"; -const stringT cc9b = "hejdu"; - - -// -// Check value casting -// -const long longC = -9; -const short shortC = -9; -const unsigned long ulongC = 1; -const unsigned short ushortC = 0; - -const float floatC = 5.1; -const double doubleC = -2.111; - -const long c20 = shortC; -const long c21 = ulongC; -const long c22 = ushortC; -const short c23 = ushortC; -const double c34 = floatC; - - - diff --git a/lib/ic/test/ic_SUITE_data/enum.idl b/lib/ic/test/ic_SUITE_data/enum.idl deleted file mode 100644 index 397212baf8..0000000000 --- a/lib/ic/test/ic_SUITE_data/enum.idl +++ /dev/null @@ -1,33 +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% - - -enum E1 {kalle, sune}; - -enum E2 { el0, el1, el2, el3, el4, el5, el6, el7, el8, el9, el10, el11, el12, el13, -el14, el15, el16, el17, el18, el19, el20, el21, el22, el23, el24, el25, el26, el27, -el28, el29, el30, el31, el32, el33, el34, el35, el36, el37, el38, el39, el40, el41, -el42, el43, el44, el45, el46, el47, el48, el49, el50, el51, el52, el53, el54, el55, -el56, el57, el58, el59}; - - - - - diff --git a/lib/ic/test/ic_SUITE_data/forward.idl b/lib/ic/test/ic_SUITE_data/forward.idl deleted file mode 100644 index e9e8edb89e..0000000000 --- a/lib/ic/test/ic_SUITE_data/forward.idl +++ /dev/null @@ -1,35 +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% - -// -// Check that forward declarations are handled correctly -// - - -interface i1; - - -interface i1 { - typedef long T; -}; - - -interface i1; - diff --git a/lib/ic/test/ic_SUITE_data/include.idl b/lib/ic/test/ic_SUITE_data/include.idl deleted file mode 100644 index 292de177c2..0000000000 --- a/lib/ic/test/ic_SUITE_data/include.idl +++ /dev/null @@ -1,31 +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% - -// Check that errors are given with the correct file name reference - -#include "include2.idl" - - -typedef T1 T7; -typedef long T7; -typedef long T111; - - - diff --git a/lib/ic/test/ic_SUITE_data/include2.idl b/lib/ic/test/ic_SUITE_data/include2.idl deleted file mode 100644 index 37caa0bf54..0000000000 --- a/lib/ic/test/ic_SUITE_data/include2.idl +++ /dev/null @@ -1,27 +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% - -// Check that errors are given with the correct file name reference - -#include "include3.idl" - - -typedef T7 T1; - diff --git a/lib/ic/test/ic_SUITE_data/include3.idl b/lib/ic/test/ic_SUITE_data/include3.idl deleted file mode 100644 index 18424b3318..0000000000 --- a/lib/ic/test/ic_SUITE_data/include3.idl +++ /dev/null @@ -1,26 +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% - -// Check that errors are given with the correct file name reference - -typedef T7 T1; - - - diff --git a/lib/ic/test/ic_SUITE_data/inherit.idl b/lib/ic/test/ic_SUITE_data/inherit.idl deleted file mode 100644 index 93fd4b42ba..0000000000 --- a/lib/ic/test/ic_SUITE_data/inherit.idl +++ /dev/null @@ -1,69 +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% - - -interface I1 { - typedef long T1; - typedef struct S1 {long a; boolean b;} T2; - typedef string StringT, StringT_arr[10]; - - T1 op1( in StringT a, inout char b, out StringT_arr c ); - T2 op2( in char a, inout char b, out StringT_arr c ); - - const T1 LongC = 10; - const StringT StringC = "Hola bambino"; - -}; - - -interface I2 : I1 { - T1 op3( in long a); - - const long c1 = LongC; - const string c2 = StringC; -}; - -interface I3 : I1 {}; - -interface I4 : I3, I2 {}; // Check that branced inherit works - - - -// Now use cnstants to check that inheritance works as expected - -module m1 { - interface I1 { - typedef long T1; - - const T1 c1 = 9; - }; - - interface I2 : I1 { - const T1 c2 = c1+5; // c2 = 14 - const long c3 = c2+c1+4; // c3 = 27 - }; - - interface I3 : I2, I1 { - const long c1 = 50; // Overrides I1::c1 - const T1 c4 = c1+c2+c3; // c4=91 - const T1 c5 = I1::c1+c1+c2+c3; // 100 - }; -}; - diff --git a/lib/ic/test/ic_SUITE_data/inherit_err.idl b/lib/ic/test/ic_SUITE_data/inherit_err.idl deleted file mode 100644 index 3b4989dd8b..0000000000 --- a/lib/ic/test/ic_SUITE_data/inherit_err.idl +++ /dev/null @@ -1,72 +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% - -// -// Ops and attributes must not be redefined (shadowed) - -interface I1 { - long op1( in long a, inout char b, out boolean c ); - long op2( in char a, inout char b, out boolean c ); - attribute long a1, a2; - readonly attribute char a3; -}; - -interface I2 : I1 { - long op1( in float a, inout char b, out boolean c ); - long op2( in char a, inout char b, out boolean c ); - attribute long a1, a2; - readonly attribute char a3; -}; - -interface I3 : I1 { - long op3 (in string<19> b); -}; - - -interface I4 : I3 { - long op1( in float a, inout char b, out boolean c ); - long op2( in char a, inout char b, out boolean c ); - attribute long a1, a2; - readonly attribute char a3; - - long op3 (in string<19> b); -}; - - -interface I11 { - long op1( in float a, inout char b, out boolean c ); - long op2( in char a, inout char b, out boolean c ); - attribute long a1, a2; - readonly attribute char a3; -}; - - - -interface I5 : I1, I11 {}; - -interface I6 : I1 { - const long op1=0; - const long op2=0; - const long a1=0; - const long a2=0; - const long a3=0; -}; - - diff --git a/lib/ic/test/ic_SUITE_data/inherit_warn.idl b/lib/ic/test/ic_SUITE_data/inherit_warn.idl deleted file mode 100644 index 07f57f1a7d..0000000000 --- a/lib/ic/test/ic_SUITE_data/inherit_warn.idl +++ /dev/null @@ -1,65 +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% - -// -// Checks that shadow warnings comes out as expected -// - - -interface I1 { - typedef long T1; - typedef struct S1 {long a; boolean b;} T2; - typedef string StringT, StringT_arr[10]; - - T1 op1( in StringT a, inout char b, out StringT_arr c ); - T2 op2( in char a, inout char b, out StringT_arr c ); - - const T1 LongC = 10; - const StringT StringC = "Hola bambino"; - -}; - - -interface I2 : I1 { - typedef char T1; // Shadows I1::T1 - const boolean StringC = FALSE; // shadows I1::StringC - - T1 op3( in long a); - - const long c1 = LongC; - const boolean c2 = StringC; -}; - -interface I3 : I2 {}; // More shadows - -interface I4 : I1 { - T1 op4(); - const T1 c2 = 66; -}; - -interface I5 : I4 { - typedef string T1; // Shadows I1::T1 - const char LongC = 'a'; // Shadows I1::LongC -}; - - -interface I6 : I4, I3 { -}; - diff --git a/lib/ic/test/ic_SUITE_data/mult_ids.idl b/lib/ic/test/ic_SUITE_data/mult_ids.idl deleted file mode 100644 index 577e1031fb..0000000000 --- a/lib/ic/test/ic_SUITE_data/mult_ids.idl +++ /dev/null @@ -1,93 +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% -// -// Check that multiply defined identifiers are detected -// - -typedef long T1; -typedef long T1; -typedef long T2; -exception T2 {}; - - -//Exceptions -exception Exc1 {}; -exception Exc1 {}; - - -// Enums -enum E1 {kalle}; -enum E1 {kalle}; -enum E2 {kalle, sune, kalle}; - - -// Structs -struct S1 {long a;}; -struct S1 {long a;}; -struct S2 {long a; short a;}; -struct S3 {long a,b; short a;}; -struct S4 {long a,a; short a;}; - - -// Constants -const long c1 = 0; -const long c1 = 0; - - -// Interfaces - -interface i1 {}; -interface i1 {}; - -interface i2 { - attribute long a1; - attribute long a1; -}; - -interface i3 { - attribute long a1, a2; - attribute long a2; -}; - -interface i4 { - attribute long a1, a1; -}; - -interface i5 { - long op1(); - long op1(); - - long op2(in long a, inout char a); -}; - - -// Unions - -union U1 switch (long) {case 1: long a;}; -union U1 switch (long) {case 1: long a;}; - -union U2 switch (long) { -case 1: long a; -default: char a; -}; - - - - - diff --git a/lib/ic/test/ic_SUITE_data/nasty.idl b/lib/ic/test/ic_SUITE_data/nasty.idl deleted file mode 100644 index e55060f762..0000000000 --- a/lib/ic/test/ic_SUITE_data/nasty.idl +++ /dev/null @@ -1,61 +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% - -// -// Checks nasty name collisions -// - -typedef string T; - - -#define nasty01 version -#define nasty02 preproc -#define nasty03 pragma -#define nasty04 compile -#define nasty05 if -#define nasty06 receive -#define nasty07 foldr -#define nasty08 length -#define nasty09 ID - -interface I1 { - attribute T nasty01; - attribute T nasty02; - attribute T nasty03; - attribute T nasty04; - attribute T nasty05; - attribute T nasty06; - attribute T nasty07; - attribute T nasty08; - attribute T nasty09; -}; - -interface I2 { - T nasty01(); - T nasty02(); - T nasty03(); - T nasty04(); - T nasty05(); - T nasty06(); - T nasty07(); - T nasty08(); - T nasty09(); -}; - diff --git a/lib/ic/test/ic_SUITE_data/one.idl b/lib/ic/test/ic_SUITE_data/one.idl deleted file mode 100644 index 7fb9808767..0000000000 --- a/lib/ic/test/ic_SUITE_data/one.idl +++ /dev/null @@ -1,30 +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% - -// Test oneway operations - -interface I1 { - long op1(in char a, inout boolean b, out string c); - oneway void op2(in char a, in boolean b, in string c); - oneway void op3(); -}; - - - diff --git a/lib/ic/test/ic_SUITE_data/one_followed.idl b/lib/ic/test/ic_SUITE_data/one_followed.idl deleted file mode 100644 index 17074f7e55..0000000000 --- a/lib/ic/test/ic_SUITE_data/one_followed.idl +++ /dev/null @@ -1,55 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% - -// Test oneway operations followed by other operations - -interface I1 { - oneway void op1(); - oneway void op2(in char a, in boolean b, in string c); - long op3(in char a, inout boolean b, out string c); -}; - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/lib/ic/test/ic_SUITE_data/one_out.idl b/lib/ic/test/ic_SUITE_data/one_out.idl deleted file mode 100644 index 1e75c2d962..0000000000 --- a/lib/ic/test/ic_SUITE_data/one_out.idl +++ /dev/null @@ -1,29 +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% - -// Test oneway operations not using in out params - -interface I1 { - oneway void op1(in char a, inout boolean b, in string c); - oneway void op2(in char a, out boolean b, in string c); -}; - - - diff --git a/lib/ic/test/ic_SUITE_data/one_raises.idl b/lib/ic/test/ic_SUITE_data/one_raises.idl deleted file mode 100644 index 4cd7ae00bb..0000000000 --- a/lib/ic/test/ic_SUITE_data/one_raises.idl +++ /dev/null @@ -1,33 +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% - -// Test oneway operations not using in out params - -exception hell {boolean burn; unsigned long for_how_long;}; -exception high_water {long mark;}; - -interface I1 { - oneway void op1(in char a) raises (hell); - oneway void op2(in char a) raises (hell); - oneway void op3() raises (hell, high_water); -}; - - - diff --git a/lib/ic/test/ic_SUITE_data/one_void.idl b/lib/ic/test/ic_SUITE_data/one_void.idl deleted file mode 100644 index 6e8c39197c..0000000000 --- a/lib/ic/test/ic_SUITE_data/one_void.idl +++ /dev/null @@ -1,31 +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% - -// Test oneway operations not using in out params - -typedef long T; - -interface I1 { - oneway char op1(in char a); - oneway T op2(in char a); -}; - - - diff --git a/lib/ic/test/ic_SUITE_data/raises_reg.idl b/lib/ic/test/ic_SUITE_data/raises_reg.idl deleted file mode 100644 index 52aba10b8d..0000000000 --- a/lib/ic/test/ic_SUITE_data/raises_reg.idl +++ /dev/null @@ -1,53 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#ifndef _RAISES_REG_IDL -#define _RAISES_REG_IDL - -module Raises_RegModule { - - exception Exception_1 {}; - - exception Exception_2 {}; - - interface R_R { - - void op() - raises(Raises_RegModule::Exception_1,Raises_RegModule::Exception_2); - - }; - -}; - -#endif - - - - - - - - - - - - - - - diff --git a/lib/ic/test/ic_SUITE_data/struct.idl b/lib/ic/test/ic_SUITE_data/struct.idl deleted file mode 100644 index 011c2404d9..0000000000 --- a/lib/ic/test/ic_SUITE_data/struct.idl +++ /dev/null @@ -1,54 +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% - - -struct S1 { - long a; - char b; - string<9> s; -}; - -struct S2 { - long a; - struct S3 { - long a; - short b, b1; - char c; - } b; - sequence <S1> c, c2, c3, c4, c5, c6, c7; -}; - - -// Check that structs are detected down in other types - - -typedef struct s4 {long a;} T1; -union U1 switch (long) { -case 1: - struct S5 {unsigned short a;} a; -case 2: - union U2 switch (char) { - case 'a': - boolean a; - case 'b': - struct s6 {long a; boolean b;} c; - } b; -}; - diff --git a/lib/ic/test/ic_SUITE_data/syntax1.idl b/lib/ic/test/ic_SUITE_data/syntax1.idl deleted file mode 100644 index 2de35a6ddf..0000000000 --- a/lib/ic/test/ic_SUITE_data/syntax1.idl +++ /dev/null @@ -1,29 +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% - -// -// Check syntax errors -// - - -typedef long T1 _; - - - diff --git a/lib/ic/test/ic_SUITE_data/syntax2.idl b/lib/ic/test/ic_SUITE_data/syntax2.idl deleted file mode 100644 index 39f28392e6..0000000000 --- a/lib/ic/test/ic_SUITE_data/syntax2.idl +++ /dev/null @@ -1,28 +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% -struct S2 { - long a_arr[99]; - struct S3 { - long a;_arr[99] - boolean b_arr[99]; - } b; -}; - - diff --git a/lib/ic/test/ic_SUITE_data/syntax3.idl b/lib/ic/test/ic_SUITE_data/syntax3.idl deleted file mode 100644 index 2bb9ac7229..0000000000 --- a/lib/ic/test/ic_SUITE_data/syntax3.idl +++ /dev/null @@ -1,21 +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% -typdef long T1; - diff --git a/lib/ic/test/ic_SUITE_data/syntax4.idl b/lib/ic/test/ic_SUITE_data/syntax4.idl deleted file mode 100644 index e41ad60ed6..0000000000 --- a/lib/ic/test/ic_SUITE_data/syntax4.idl +++ /dev/null @@ -1,24 +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% -union U1 switch (long) { -case 1: long a; -2: short b; -}; - diff --git a/lib/ic/test/ic_SUITE_data/syntax5.idl b/lib/ic/test/ic_SUITE_data/syntax5.idl deleted file mode 100644 index 6468f0adc0..0000000000 --- a/lib/ic/test/ic_SUITE_data/syntax5.idl +++ /dev/null @@ -1,23 +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% -union U1 switch (enum E1 {kalle, sune}) { -case kalle: long a; -sune: short b; -}; diff --git a/lib/ic/test/ic_SUITE_data/syntax6.idl b/lib/ic/test/ic_SUITE_data/syntax6.idl deleted file mode 100644 index 6012cc868c..0000000000 --- a/lib/ic/test/ic_SUITE_data/syntax6.idl +++ /dev/null @@ -1,21 +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% - -constant long c1 = 0; diff --git a/lib/ic/test/ic_SUITE_data/type.idl b/lib/ic/test/ic_SUITE_data/type.idl deleted file mode 100644 index 6109661c4f..0000000000 --- a/lib/ic/test/ic_SUITE_data/type.idl +++ /dev/null @@ -1,191 +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% - -// -// Check all types in IDL -// - -typedef long T01; -typedef unsigned long T02; -typedef short T03; -typedef unsigned short T04; -typedef float T05; -typedef double T06; -typedef char T07; -typedef boolean T08; -typedef octet T09; -typedef any T10; -typedef Object T11; -typedef T01 T12; - -// Template types -typedef sequence <long> T21; -typedef sequence <unsigned long> T22; -typedef sequence <short, 2> T23; -typedef sequence <unsigned short, 6> T24; -typedef sequence <float, 12> T25; -typedef sequence <double> T26; -typedef sequence <char, 1> T27; -typedef sequence <boolean> T28; -typedef sequence <octet, 9> T29; -typedef sequence <any> T30; -typedef sequence <Object,2 > T31; -typedef sequence <T01> T32; -typedef sequence <sequence <sequence <T32> > > T33; - -struct S1 { - long a; - boolean b; -}; - -struct S2 { - long a; - struct S3 { - long a; - boolean b; - } b; -}; - -union U1 switch (enum E1 {kalle1, sune1}) { -case kalle1: long a; -default: boolean b; -case sune1: octet c; -}; - -union U2 switch (enum E2 {kalle2, sune2}) { -case kalle2: long a; -default: struct S4 { long a; short b;} b; -case sune2: octet c; -}; - -// Typedefs of above types - -typedef struct S11 { - long a; - boolean b; -} T41; - -typedef struct S21 { - long a; - struct S3 { - long a; - boolean b; - } b; -} T42; - -typedef union U11 switch (enum E3 {kalle3, sune3}) { -case kalle3: long a; -default: boolean b; -case sune3: octet c; -} T43; - -typedef union U21 switch (enum E4 {kalle4, sune4}) { -case kalle4: long a; -default: struct S4 { long a; short b;} b; -case sune4: octet c; -} T44; - - - - -// Array versions - -typedef long T01_arr[99]; -typedef unsigned long T02_arr[99]; -typedef short T03_arr[99]; -typedef unsigned short T04_arr[99]; -typedef float T05_arr[99]; -typedef double T06_arr[99]; -typedef char T07_arr[99]; -typedef boolean T08_arr[99]; -typedef octet T09_arr[99]; -typedef any T10_arr[99]; -typedef Object T11_arr[99]; -typedef T01 T12_arr[99]; - -typedef sequence <long> T21_arr[99]; -typedef sequence <unsigned long> T22_arr[99]; -typedef sequence <short, 2> T23_arr[99]; -typedef sequence <unsigned short, 6> T24_arr[99]; -typedef sequence <float, 12> T25_arr[99]; -typedef sequence <double> T26_arr[99]; -typedef sequence <char, 1> T27_arr[99]; -typedef sequence <boolean> T28_arr[99]; -typedef sequence <octet, 9> T29_arr[99]; -typedef sequence <any> T30_arr[99]; -typedef sequence <Object,2 > T31_arr[99]; -typedef sequence <T01> T32_arr[99]; -typedef sequence <sequence <sequence <T32> > > T33_arr[99]; - -struct S12 { - long a; - boolean b_arr[99]; -}; - -struct S22 { - long a_arr[99]; - struct S3 { - long a_arr[99]; - boolean b_arr[99]; - } b; -}; - -union U12 switch (enum E12 {kalle12, sune12}) { -case kalle12: long a_arr[99]; -default: boolean b; -case sune12: octet c; -}; - -union U22 switch (enum E22 {kalle22, sune22}) { -case kalle22: long a; -default: struct S4 { long a; short b;} b_arr[99]; -case sune22: octet c; -}; - -// Typedefs of above types - -typedef struct S13 { - long a_arr[99]; - boolean b; -} T41_arr[99]; - -typedef struct S23 { - long a; - struct S3 { - long a; - boolean b_arr[99]; - char c; - } b; -} T42_arr[99]; - -typedef union U13 switch (enum E13 {kalle13, sune13}) { -case kalle13: long a; -default: boolean b_arr[99]; -case sune13: octet c; -} T43_arr[99]; - -typedef union U23 switch (enum E23 {kalle23, sune23}) { -case kalle23: long a_arr[99]; -default: struct S4 { long a; short b;} b_arr[99]; -case sune23: octet c_arr[99]; -} T44_arr[99]; - - - diff --git a/lib/ic/test/ic_SUITE_data/typeid.idl b/lib/ic/test/ic_SUITE_data/typeid.idl deleted file mode 100644 index 9a5ce28bdf..0000000000 --- a/lib/ic/test/ic_SUITE_data/typeid.idl +++ /dev/null @@ -1,29 +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% - -interface I1 {}; - -module M1 { interface I1 {};}; - -module M2 { module M1 { interface I1 {};};}; - -module M3 { module M2 { module M1 { interface I1 {};};};}; - - diff --git a/lib/ic/test/ic_SUITE_data/u_case_mult.idl b/lib/ic/test/ic_SUITE_data/u_case_mult.idl deleted file mode 100644 index 3d1523b5f5..0000000000 --- a/lib/ic/test/ic_SUITE_data/u_case_mult.idl +++ /dev/null @@ -1,55 +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% - -// Check that case labels are not duplicated - -union U1 switch (long) { -case 1 : long a; -case 1 : short b; -}; - -union U2 switch (char) { -case 'c' : long a; -case 'c' : short b; -}; - -union U2b switch (char) { -case 'c' : -case 'c' : long a; -case 'e': long b; -case 'c': long c; -}; - -union U3 switch (enum E1 {kalle, kula}) { -case kula : long a; -case kula : short b; -}; - -union U4 switch (boolean) { -case TRUE : long a; -case TRUE : short b; -}; - -union U5 switch (boolean) { -case TRUE : long a; -default: short p; -default: short pp; -}; - diff --git a/lib/ic/test/ic_SUITE_data/u_default.idl b/lib/ic/test/ic_SUITE_data/u_default.idl deleted file mode 100644 index 050b876aad..0000000000 --- a/lib/ic/test/ic_SUITE_data/u_default.idl +++ /dev/null @@ -1,52 +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% - -// -// Checking that default labels are correct in TK -// - -interface i1 { - union U1 switch (long) { - default: long a; - case 1: case 2: long b; - }; - - union U2 switch (long) { - case 0: default: long a; - case 1: case 2: long b; - }; - - union U3 switch (long) { - case -1: long aa; - case 0: default: long a; - case 1: case 2: long b; - }; - - union U4 switch (long) { - case -1: long aa; - case 0: long a; - case 1: case 2: long b; - }; - - U1 op0(); - U2 op1(); - U3 op2(); - U4 op3(); -}; diff --git a/lib/ic/test/ic_SUITE_data/u_mult.idl b/lib/ic/test/ic_SUITE_data/u_mult.idl deleted file mode 100644 index 3ab47c40a5..0000000000 --- a/lib/ic/test/ic_SUITE_data/u_mult.idl +++ /dev/null @@ -1,62 +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% - - -// Check multiply defined declarators - -enum E2 {kal, kula, E1}; // legal, but used below - -// Now check that declarator a is multiply defined in all unions below -union U0 switch (long) { -case 0: long a; -case 1: short a; -}; -union U00 switch (char) { -case 'c' : long a; -case 'f' : char c; -case 'b' : short a; -}; -union U000 switch (boolean) { -case TRUE: long a; -case FALSE: short a; -}; -union U0000 switch (E2) { -case kal: long a; -case kula: short a; -}; - - - - -// Check that enum name duplication is found. - -union U1 switch (enum E1 {kalle, kula, E1}) { -case E1 : long a; // legal -case kalle : short E1; // illegal -}; - - -// This is legal, but ended up here anyway - -union U2 switch(::E2) { -case kal : long a; -case kula : short b; -default : boolean E1; -}; diff --git a/lib/ic/test/ic_SUITE_data/u_norm.idl b/lib/ic/test/ic_SUITE_data/u_norm.idl deleted file mode 100644 index b2f146f45a..0000000000 --- a/lib/ic/test/ic_SUITE_data/u_norm.idl +++ /dev/null @@ -1,64 +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% - - -union U1 switch (long) { -case 1: long a; -case 2: case 3: short b; -}; - - -union U2 switch (unsigned short) { -case 10: boolean a; -case 188: char b; -default: string c; -}; - - -union U3 switch (enum E1 {kalle, kula, boll}) { -case kalle: long a; -case kula: U2 b; -}; - -enum E2 {Cissi, Anders}; - -union U4 switch (::E2) { -case Cissi: U1 a; -default: case Anders: unsigned long b; -}; - -union U5 switch(char) { -case 'e': long a; -case 'b': case 'f': char b; -default: struct S {long a; boolean b;} c; -}; - - -// Now check that references can be used as case values - -const long c1 = 9; -const long c2 = 10; - -union U6 switch (long) { -case c1: boolean a; -case ::c2: boolean b; -}; - - diff --git a/lib/ic/test/ic_SUITE_data/u_type.idl b/lib/ic/test/ic_SUITE_data/u_type.idl deleted file mode 100644 index 8a46b9375f..0000000000 --- a/lib/ic/test/ic_SUITE_data/u_type.idl +++ /dev/null @@ -1,83 +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% - - -// -// Check that case values match declared discriminator type -// - - -const long longC = 0; -const short shortC = 0; -const char charC = 'c'; -const string stringC = "Yacht"; - -enum E1 {kalle, kula}; - -union U1 switch (long) { -case 'c' : long a; -case TRUE : long b; -case stringC : long d; -case kalle : long f; -}; - -union U2 switch (unsigned long) { -case 'c' : long a; -case TRUE : long b; -case stringC : long d; -case kalle : long f; -}; - -union U3 switch (short) { -case 'c' : long a; -case TRUE : long b; -case stringC : long d; -case kalle : long f; -}; - -union U4 switch (unsigned short) { -case 'c' : long a; -case TRUE : long b; -case stringC : long d; -case kalle : long f; -}; - -union U5 switch (char) { -case TRUE : long b; -case stringC : long d; -case shortC : long e; -case kalle : long f; -}; - - -union U6 switch (E1) { -case 'c' : long a; -case TRUE : long b; -case stringC : long d; -case shortC : long e; -}; - -union U7 switch (enum E2 {ja, nej, kanske}) { -case 'c' : long a; -case TRUE : long b; -case stringC : long d; -case shortC : long e; -}; - diff --git a/lib/ic/test/ic_SUITE_data/undef_id.idl b/lib/ic/test/ic_SUITE_data/undef_id.idl deleted file mode 100644 index a09598f0a7..0000000000 --- a/lib/ic/test/ic_SUITE_data/undef_id.idl +++ /dev/null @@ -1,64 +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% - -// -// Check that undefined ids are detected -// - -typedef T7 T1; - -const char c1 = ::c0; -const T01 c2 = 'h'; -const T7 c3 = 9; - -interface i1 { - T17 op(); - long op2( in T7 a); - attribute T7 a1, a2; - readonly attribute T17 a3; -}; - -union U1 switch (long) { -case 1: long a; -case ::g : short b; -}; - -union U2 switch (enum E1 {kalle, kula}) { -case kula1: long a; -case kalle : short b; -}; - -union U3 switch (long) { -case kula2: long a; -case ::E3::kalle : short b; -case ::E4::kalle : short c; -}; - -enum E2 {kalle2, kula2}; - -union U4 switch (E2) { -case kula1: long a; -case kula1: long b; -case c3: short c; -}; - - - - diff --git a/lib/ic/test/ic_be_SUITE.erl b/lib/ic/test/ic_be_SUITE.erl deleted file mode 100644 index d5d3038a6e..0000000000 --- a/lib/ic/test/ic_be_SUITE.erl +++ /dev/null @@ -1,75 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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 backends of the IDL compiler -%%%---------------------------------------------------------------------- - --module(ic_be_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,plain/1]). - - --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() -> - [plain]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%% Checking code for the plain backend. -plain(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(slask), - File = filename:join(DataDir, plain), - ok = ic:gen(File,stdopts(OutDir)++[{be,erl_plain}]), - ok. - -%%-------------------------------------------------------------------- -%% -%% Utilities -stdopts(OutDir) -> - [{outdir, OutDir}, {maxerrs, infinity}]. - -to_list(X) when is_atom(X) -> atom_to_list(X); -to_list(X) -> X. - diff --git a/lib/ic/test/ic_be_SUITE_data/plain.idl b/lib/ic/test/ic_be_SUITE_data/plain.idl deleted file mode 100644 index 1ee20eeb1f..0000000000 --- a/lib/ic/test/ic_be_SUITE_data/plain.idl +++ /dev/null @@ -1,34 +0,0 @@ - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% - -module m { - - struct s { - long x; - long y; - }; - - interface i { - - void foo( in s a, out short b ); - - }; - -}; - diff --git a/lib/ic/test/ic_pp_SUITE.erl b/lib/ic/test/ic_pp_SUITE.erl deleted file mode 100644 index be37953126..0000000000 --- a/lib/ic/test/ic_pp_SUITE.erl +++ /dev/null @@ -1,569 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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 preprocessor -%%---------------------------------------------------------------------- - --module(ic_pp_SUITE). --include_lib("common_test/include/ct.hrl"). - - - -%% 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)])). --define(GCC, "g++"). --define(GCC_VER, "2.95.3"). - --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). --export([arg_norm/1]). --export([cascade_norm/1]). --export([comment_norm/1]). --export([concat_norm/1]). --export([define_norm/1]). --export([if_norm/1]). --export([if_zero/1]). --export([misc_norm/1]). --export([improp_nest_constr_norm/1]). --export([inc_norm/1]). --export([line_norm/1]). --export([nopara_norm/1]). --export([predef_norm/1]). --export([predef_time_norm/1]). --export([self_ref_norm/1]). --export([separate_norm/1]). --export([swallow_sc_norm/1]). --export([unintended_grp_norm/1]). --export([cases/0, init_per_suite/1, end_per_suite/1]). - - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - cases(). - -groups() -> - [{arg, [], [arg_norm]}, {cascade, [], [cascade_norm]}, - {comment, [], [comment_norm]}, - {concat, [], [concat_norm]}, - {define, [], [define_norm]}, {inc, [], [inc_norm]}, - {improp_nest_constr, [], [improp_nest_constr_norm]}, - {misc, [], [misc_norm]}, {line, [], [line_norm]}, - {nopara, [], [nopara_norm]}, - {predef, [], [predef_norm]}, - {predef_time, [], [predef_time_norm]}, - {self_ref, [], [self_ref_norm]}, - {separate, [], [separate_norm]}, - {swallow_sc, [], [swallow_sc_norm]}, - {unintended_grp, [], [unintended_grp_norm]}, - {'if', [],[if_norm, if_zero]}]. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(Config) -> - if - is_list(Config) -> - case os:type() of - {win32, _} -> - {skipped, "Very unplesent to run on windows"}; - _ -> - check_gcc(Config) - end; - true -> - exit("Config not a list") - end. - -check_gcc(Config) -> - case os:find_executable(?GCC) of - false -> - {skipped, - lists:flatten(io_lib:format("Can not run without ~s in path", - [?GCC]))}; - _ -> - case trim(os:cmd(?GCC++" --version")) of - ?GCC_VER++[] -> - Config; - ?GCC_VER++[D|_] when is_integer(D), D>=$0, D=<$9 -> - fail_gcc(?GCC_VER++[D]); - ?GCC_VER++_ -> - Config; - Ver -> - fail_gcc(Ver) - end - end. - -fail_gcc(Ver) -> - {skipped, lists:flatten(io_lib:format("Need ~s v~s, not ~s", - [?GCC, ?GCC_VER, Ver]))}. - -trim(S) -> lists:reverse(skip_white(lists:reverse(skip_white(S)))). - -skip_white([$\s|T]) -> skip_white(T); -skip_white([$\n|T]) -> skip_white(T); -skip_white([$\r|T]) -> skip_white(T); -skip_white([$\t|T]) -> skip_white(T); -skip_white(L) -> L. - - -end_per_suite(Config) -> - Config. - - -cases() -> - [{group, arg}, {group, cascade}, {group, comment}, - {group, concat}, {group, define}, {group, misc}, {group, 'if'}, - {group, improp_nest_constr}, {group, inc}, - {group, line}, {group, nopara}, {group, predef}, - {group, predef_time}, {group, self_ref}, - {group, separate}, {group, swallow_sc}, - {group, unintended_grp}]. - - - -%%-------------------------------------------------------------------- -%% arg -%%-------------------------------------------------------------------- -%% Checks arguments for #define. -arg_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(arg_norm), - File = filename:join(DataDir, arg), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% cascade -%%-------------------------------------------------------------------- -%% Check cascade #define. -cascade_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(cascade_norm), - File = filename:join(DataDir, cascade), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% comment -%%-------------------------------------------------------------------- -%% Check comments. -comment_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(comment_norm), - File = filename:join(DataDir, comment), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% concat -%%-------------------------------------------------------------------- -%% Check concatinations, i.e ## . -concat_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(concat_norm), - File = filename:join(DataDir, concat), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% define -%%-------------------------------------------------------------------- -%% Check misceleaneous #define. -define_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(define_norm), - File = filename:join(DataDir, define), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% if -%%-------------------------------------------------------------------- -%% Check #if, #elif, and #endif. -if_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(if_norm), - File = filename:join(DataDir, 'if'), - - ok = test_file(File, DataDir), - ok. - -%% Check #if 0 -if_zero(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(if_zero), - File = filename:join(DataDir, if_zero), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% inc -%%-------------------------------------------------------------------- -%% Check #include. -inc_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(inc_norm), - File = filename:join(DataDir, inc), - - ok = test_file(File, DataDir), - ok. - - - -%%-------------------------------------------------------------------- -%% improp_nest_constr -%%-------------------------------------------------------------------- -%% Check improperly nested constructs. -improp_nest_constr_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(improp_nest_constr_norm), - File = filename:join(DataDir, improp_nest_constr), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% misc -%%-------------------------------------------------------------------- -%% Misceleaneous checks. -misc_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(misc_norm), - File = filename:join(DataDir, misc), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% line -%%-------------------------------------------------------------------- -%% Checks #line. -line_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(line_norm), - File = filename:join(DataDir, line), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% nopara -%%-------------------------------------------------------------------- -%% Checks #define with no parameters. -nopara_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(nopara_norm), - File = filename:join(DataDir, nopara), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% predef -%%-------------------------------------------------------------------- -%% Checks predefined macros. Note: not __TIME__ and __DATE__. -predef_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(predef_norm), - File = filename:join(DataDir, predef), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% predef_time -%%-------------------------------------------------------------------- -%% Checks the predefined macros __TIME__ and __DATE__. -predef_time_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(predef_time_norm), - File = filename:join(DataDir, predef_time), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% self_ref -%%-------------------------------------------------------------------- -%% Checks self referring macros. -self_ref_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(self_ref_norm), - File = filename:join(DataDir, self_ref), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% separate -%%-------------------------------------------------------------------- -%% Checks separete expansion of macro arguments. -separate_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(separate_norm), - File = filename:join(DataDir, separate), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% swallow_sc -%%-------------------------------------------------------------------- -%% Checks swallowing an undesirable semicolon. -swallow_sc_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(swallow_sc_norm), - File = filename:join(DataDir, swallow_sc), - - ok = test_file(File, DataDir), - ok. - - -%%-------------------------------------------------------------------- -%% unintended_grp -%%-------------------------------------------------------------------- -%% Checks unintended grouping of arithmetic. -unintended_grp_norm(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - _OutDir = ?OUT(unintended_grp_norm), - File = filename:join(DataDir, unintended_grp), - - ok = test_file(File, DataDir), - ok. - - -test_file(FileT, DataDir) -> - case test_file_1(FileT, DataDir) of - ok -> ok; - Chars -> - io:put_chars(Chars), - {error,{FileT,DataDir}} - end. - -test_file_1(FileT, DataDir) -> - Tok = string:tokens(FileT, "/"), - FileName = lists:last(Tok), - File = FileT++".idl", - - test_server:format("File ~p~n",[File]), - test_server:format("FileName ~p~n",[FileName]), - - Flags = "-I"++DataDir, - - test_server:format("Flags ~p~n",[Flags]), - - Erl = pp_erl(File, Flags), - Gcc = pp_gcc(File, Flags), - - case Erl of - {error,_ErlError} -> - test_server:format("Internal_pp Result ~n==================~n~p~n~n",[Erl]); - {warning, _ErlWar} -> - test_server:format("Internal_pp Result ~n==================~n~p~n~n",[Erl]); - _ -> - test_server:format("Internal_pp Result ~n==================~n~s~n~n",[Erl]) - end, - - case Gcc of - {error,GccError} -> - Error = string:tokens(GccError, "\n"), - test_server:format(?GCC" Result ~n==========~n~p~n~n", - [Error]); - _ -> - test_server:format(?GCC" Result ~n==========~n~s~n~n",[Gcc]) - end, - - - - case {Erl,Gcc} of - {{warning,W}, {error,X}} -> - case is_ok(W,X) of - yes -> - ok; - no -> - io_lib:format("Internal_pp found Warning = ~p ~n" - ?GCC" found Error = ~p~n",[W,X]) - end; - - - {{warning,W}, _} -> - io_lib:format(?GCC" did not find warnings while ~n" - "Internal_pp found the following Warning = ~p~n",[W]); - - {{error,E}, {error,X}} -> - case is_ok(E,X) of - yes -> - ok; - no -> - io_lib:format("Internal_pp found Error = ~p ~n" - ?GCC" found Error = ~p~n",[E,X]) - end; - - {{error,E}, _} -> - case FileName of - "if" -> - case if_res(E) of - ok -> - ok; - _ -> - io_lib:format(?GCC" did not find errors while ~n" - "Internal_pp found the following Error = ~p~n",[E]) - end; - _ -> - io_lib:format(?GCC" did not find errors while ~n" - "Internal_pp found the following Error = ~p~n",[lists:flatten(E)]) - end; - - {_, {error,X}} -> - io_lib:format("Internal_pp did not find errors while ~n" - ?GCC" found the following Error = ~p~n",[X]); - - _ -> - - file:write_file("/tmp/Erl.pp",list_to_binary(Erl)), - file:write_file("/tmp/Gcc.pp",list_to_binary(Gcc)), - - Res = os:cmd("diff -b -w /tmp/Erl.pp /tmp/Gcc.pp"), - test_server:format("///////////{error,E} E ~p FileName~p~n",[Res,FileName]), - case {Res, FileName} of - {[], _} -> - test_server:format("Diff = [] OK!!!!!!~n"), - ok; - {_, "predef_time"} -> - Tokens = string:tokens(Res,"\n"), - test_server:format("///////////{error,E} Tokens~p~n",[Tokens]), - case Tokens of - ["3c3",_,"---",_,"5c5",_,"---",_,"9c9",_,"---",_] -> - ok; - _ -> - io_lib:format("Diff Result = ~p~n",[Res]) - end; - _ -> - io_lib:format("Diff Result = ~p~n",[Res]) - end - end. - - - - - -pp_erl(File, Flags) -> - case ic_pp:run(File,Flags) of - {ok, [$#, $ , $1 | Rest], []} -> - [$#, $ , $1 | Rest]; - {ok, [$#, $ , $1 | _Rest], Warning} -> - {warning,Warning}; - {error,Error} -> - {error,Error} - end. - -pp_gcc(File, Flags) -> - Cmd = ?GCC" -x c++ -E", - Line = Cmd++" "++Flags++" "++File, - - case os:cmd(Line) of - [$#, $ , $1 | Rest] -> - [$#, $ , $1 | Rest]; - Res -> - - case string:str(Res,"# 1 \"") of - 0 -> - {error,Res}; - X -> - {error, string:sub_string(Res, 1, X-1)} - end - end. - - -is_ok([],_Gcc) -> - yes; -is_ok([{FileName,Line,Text}|T],Gcc) -> - Str = FileName++":"++integer_to_list(Line)++": "++Text, - case string:str(Gcc,Str) of - 0 -> - io:format("~n is_ok Internal_pp missed Error = ~s~n",[Str]), - no; - _X -> - is_ok(T,Gcc) - end; -is_ok([Str|T],Gcc) -> - case string:str(Gcc,Str) of - 0 -> - io:format("~n is_ok Internal_pp missed Error = ~s~n",[Str]), - no; - _X -> - is_ok(T,Gcc) - end. - - -to_list(X) when is_atom(X) -> atom_to_list(X); -to_list(X) -> X. - - - -if_res(E) -> - if_res(E,1). - -if_res([H|T],Nr) -> - %% Dir = "/clearcase/otp/libraries/ic/test/ic_pp_SUITE_data/if.idl", - case {Nr, H} of - {1, {_Dir, 2, "only '#if 0' is implemented at present"}} -> - if_res(T,Nr+1); - {2, {_Dir, 3, "only '#if 0' is implemented at present"}} -> - if_res(T,Nr+1); - {3, {_Dir, 5, "`else' command is not implemented at present"}} -> - if_res(T,Nr+1); - {4, {_Dir, 9, "`elif' command is not implemented at present"}} -> - if_res(T,Nr+1); - {5, {_Dir, 11, "`else' command is not implemented at present"}} -> - ok; - _ -> - error - end; -if_res(_, _) -> - error. - - - diff --git a/lib/ic/test/ic_pp_SUITE_data/arg.idl b/lib/ic/test/ic_pp_SUITE_data/arg.idl deleted file mode 100644 index 42d8457f2c..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/arg.idl +++ /dev/null @@ -1,39 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define xstr (s) str(s) -#define str(s) #s -#define foo 4 - -xstr(foo); - -#define x(kalle)stina -x(kurt) -x - -#define y(kalle) stina -y(kurt) -y - -#define a(kalle) stina -a(kurt) -a - -#define b (kalle) stina -b(kurt) diff --git a/lib/ic/test/ic_pp_SUITE_data/cascade.idl b/lib/ic/test/ic_pp_SUITE_data/cascade.idl deleted file mode 100644 index f96f2a0bd7..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/cascade.idl +++ /dev/null @@ -1,30 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define BUFS 1020 -#define TABS BUFS -#undef BUFS -#define BUFS 37 - - -main() -{ - TABS; - -} diff --git a/lib/ic/test/ic_pp_SUITE_data/comment.idl b/lib/ic/test/ic_pp_SUITE_data/comment.idl deleted file mode 100644 index 9b5e310e6c..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/comment.idl +++ /dev/null @@ -1,73 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define T 12 -#define F T - -//comment -/*exception except {};*/ - -// comment - // comment -/* another */ - /* another */ -/* still -another */ - /* still - another */ -__LINE__ -/* yet \ - another */ -// yet \ - another -__LINE__ - -#include "all.c" -#include <all.c> -#include /* comment */ "all.c" -#include /* comment */ <all.c> -#include "all.c" /* comment */ -#include <all.c> /* comment */ -#include // "all.c" -#include // <all.c> -#include "all.c" // comment -#include <all.c> // comment -#include "all/*cc*/.c" -#include <all/*cc*/.c> - -main() -{ - printf(" %d \n",F); - a(); - -} -//comment -/*exception hell {};*/ -#undef T -#define T "3/*com\ -ment*/4" -a() -{ - printf(" %d \n",F); - printf(" %d \n",T); -} - -b() -{} - diff --git a/lib/ic/test/ic_pp_SUITE_data/concat.idl b/lib/ic/test/ic_pp_SUITE_data/concat.idl deleted file mode 100644 index eb1f6aa1ad..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/concat.idl +++ /dev/null @@ -1,61 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define sune kurt -#define a(name) a #name name##_command -#define b(name) b #name name## _command -#define c(name) c #name name ##_command -#define d(name) d #name name ## _command -#define e(name) e #name command ## _command -#define f(name) f #name command ## %_command -#define g(name) g #name name ## %_command -#define h(name) h #name %_command ## name -#define i(name) i #name name ## _ ## name -#define j(name) j #name name ## name -#define k(name) k #name name ## name -#define l(name) l #name !name ## name -#define m(name) m #name name ## !name -#define n(name) n #name !name ## !name -#define o(name) stina -#define p(name) name -#define q1(name) q1 #name j(name) ## j(name) -#define q2(name) q2 #name j(name) -#define q3(name) q3 #name !! ## j(name) -#define q4(name) q4 #name ## j(name) - -a(quit) -b(quit) -c(quit) -d(quit) -e(quit) -f(quit) -g(sune) -h(sune) -i(sune) -j(sune) -l(sune) -m(sune) -n(sune) -k(j(sune)) -k(o(sune)) -k(p(sune)) -q1(sune) -q2(sune) -q3(sune) -q4(sune) diff --git a/lib/ic/test/ic_pp_SUITE_data/define.idl b/lib/ic/test/ic_pp_SUITE_data/define.idl deleted file mode 100644 index 76a3b5ec22..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/define.idl +++ /dev/null @@ -1,42 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define 8 -#define -#define a -#define _a -#define b dfs -#define 9 fdas -#define a8 -#define A -#define (c) fadfas -#define )c) fadfas -#define % c) fadfas -#define d(p) kfdsa -#define e(p) sinus(p) -#warning warning line -#define w%er percent -#define q() no_para -#warning warning line -#undef -#undef 8 -#undef a -#undef b -#undef _a d(kk) - diff --git a/lib/ic/test/ic_pp_SUITE_data/if.idl b/lib/ic/test/ic_pp_SUITE_data/if.idl deleted file mode 100644 index 437ea7c2e1..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/if.idl +++ /dev/null @@ -1,33 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define kurt 12 -#if !true -#if X == 1 -ett -#else -else -#endif -true -#elif kurt -trueelif -#else -trueelse -#endif -end diff --git a/lib/ic/test/ic_pp_SUITE_data/if_zero.idl b/lib/ic/test/ic_pp_SUITE_data/if_zero.idl deleted file mode 100644 index a0184f8bff..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/if_zero.idl +++ /dev/null @@ -1,32 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#if 0 -pelle = mallan -#endif -pelle = stina -#if 0 -kalle = stina -#endif -kalle = mallan -#if 0 -kurt = fia -#endif -fia = kurt - diff --git a/lib/ic/test/ic_pp_SUITE_data/improp_nest_constr.idl b/lib/ic/test/ic_pp_SUITE_data/improp_nest_constr.idl deleted file mode 100644 index b658811277..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/improp_nest_constr.idl +++ /dev/null @@ -1,31 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define double(x) (2*(x)) -#define call_with_1(x) x(1) - -#define strange(file) fprintf (file, "%s %d", - -main() -{ - call_with_1(double); - strange(stderr) p, 35) - -} - diff --git a/lib/ic/test/ic_pp_SUITE_data/inc.idl b/lib/ic/test/ic_pp_SUITE_data/inc.idl deleted file mode 100644 index e13875b10c..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/inc.idl +++ /dev/null @@ -1,69 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% - -int x; - -#include "head.h" -#warning line nr -main() -{ - printf(test()); -} - - - - - - - - -#define C false -#define Z on -#include "inc2.h" -#undef Z -"Ca" C -"Za" Z -#include "inc2.h" -"Cb" C -"Zb" Z - -main() -{ -#define Q(a,b) sinus(a,b kurt ## b) - if (Q(34,56)=='NULL') printf(" T AAA%sEEEE \n",Q); - printf(" %d \n",F); - a(); -} -//comment -/*exception -hell {};*/ -#undef T -#define T "3/*com\ment*/4" -#define T 33 -#define F again -a () -{ - printf(" %d \n",F); - printf(" %d \n",T); -} - -b() -{} - diff --git a/lib/ic/test/ic_pp_SUITE_data/included1.idl b/lib/ic/test/ic_pp_SUITE_data/included1.idl deleted file mode 100644 index f3cc40f549..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/included1.idl +++ /dev/null @@ -1,36 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2000-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% -#ifndef INCLUDED1_IDL -#define INCLUDED1_IDL - - -#ifndef SOMETHING -#endif - - -struct s { - - long l; - -}; - - - -#endif diff --git a/lib/ic/test/ic_pp_SUITE_data/included2.idl b/lib/ic/test/ic_pp_SUITE_data/included2.idl deleted file mode 100644 index 6a718ce021..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/included2.idl +++ /dev/null @@ -1,42 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2000-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% -#ifndef INCLUDED2_IDL -#define INCLUDED2_IDL - -#include "included1.idl" - - -#ifdef SOMETHING -#endif - - -module m { - - struct t { - - s st; - - }; - - -}; - - -#endif diff --git a/lib/ic/test/ic_pp_SUITE_data/includer.idl b/lib/ic/test/ic_pp_SUITE_data/includer.idl deleted file mode 100644 index d4fabd024a..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/includer.idl +++ /dev/null @@ -1,46 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2000-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% -#ifndef INCLUDER_IDL -#define INCLUDER_IDL - -#include "included1.idl" -#include "included2.idl" - -#ifdef SOMETHING -#endif - - - -module n { - - interface j { - - s op(in m::t inpar); - - }; - -}; - - - - -#endif - - diff --git a/lib/ic/test/ic_pp_SUITE_data/line.idl b/lib/ic/test/ic_pp_SUITE_data/line.idl deleted file mode 100644 index 83783dff03..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/line.idl +++ /dev/null @@ -1,46 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#line -#line 8 -#line 8a -#line 12 abc.c -#line 12 "kurt.c" -#warning fdafdsaf - - -#define T 12 -#define F T -#define Q(a) sinus(a) -#undef Q -# -#line 12 -#warning test of warning -#warning second of warning -#warning third of warning -#pragma kurt -#ident kurt -#kurt fdsafd -#line 20 -main() -{ - if (Q(34,56)=='NULL') printf(" T AAA%sEEEE \n",Q); - printf(" %d \n",F); -} -sune diff --git a/lib/ic/test/ic_pp_SUITE_data/misc.idl b/lib/ic/test/ic_pp_SUITE_data/misc.idl deleted file mode 100644 index 512ccb16b1..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/misc.idl +++ /dev/null @@ -1,45 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define str(s) #s -str(fool); -str(foo); -str(kurt); -#define xstr(s) str(s) -#define foo 4 -#define kurt sune -#define sune 17 - -xstr(fool); -xstr(foo); -xstr(kurt); - -#define a(b) b #8b -#define r(b) b # -#define t(b) b ## a -a(sinus) - -#define ww #www -ww - -#define x 14 + y -#define y 12 + #x -x - -#define e(a) cosinus(a) diff --git a/lib/ic/test/ic_pp_SUITE_data/nopara.idl b/lib/ic/test/ic_pp_SUITE_data/nopara.idl deleted file mode 100644 index 9d5253bf38..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/nopara.idl +++ /dev/null @@ -1,36 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#11a -#define xstr str(s) + kurt*2; -#define asdf pragma -#asdf -#define asd #pragma asd - -#10 -#12 8kurt - -#define sss "stringing in the rain" -#define ddd "string -ing in the rain" asd -#line 20 -#include "head.h" qqqq -#include %!# -#include <sys.h> - diff --git a/lib/ic/test/ic_pp_SUITE_data/predef.idl b/lib/ic/test/ic_pp_SUITE_data/predef.idl deleted file mode 100644 index 8805501d66..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/predef.idl +++ /dev/null @@ -1,34 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define b(q,w) kurt q w - - -b(__LINE__, __FILE__) -__LINE__ -__FILE__ - - - -b(__INCLUDE_LEVEL__, __BASE_FILE__) -__INCLUDE_LEVEL__ -__BASE_FILE__ - -Line __LINE__ -#include "predef.h" diff --git a/lib/ic/test/ic_pp_SUITE_data/predef_time.idl b/lib/ic/test/ic_pp_SUITE_data/predef_time.idl deleted file mode 100644 index 7ce8d2a313..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/predef_time.idl +++ /dev/null @@ -1,25 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define b(q,w) kurt q w -b(__DATE__, __TIME__) -__DATE__ -__TIME__ - -#include "predef_time.h" diff --git a/lib/ic/test/ic_pp_SUITE_data/self_ref.idl b/lib/ic/test/ic_pp_SUITE_data/self_ref.idl deleted file mode 100644 index 50f8a04e69..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/self_ref.idl +++ /dev/null @@ -1,27 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define foo (4 + foo) - - -main() -{ - foo; - -} diff --git a/lib/ic/test/ic_pp_SUITE_data/separate.idl b/lib/ic/test/ic_pp_SUITE_data/separate.idl deleted file mode 100644 index 6151a41709..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/separate.idl +++ /dev/null @@ -1,38 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define xstr(s) str(s) -#define str(s) #s -#define foo 4 -#define str1(s) #s lose(s) -#define foo1 4 - -main() -{ - str(foo); - str1(foo1); - xstr(foo); - -#define qxstr(s) qstr(s) - qxstr(qfoo); -#define qstr(s) #s - qstr( 4 ) ; -#define qfoo 4 - qstr(qfoo); -} diff --git a/lib/ic/test/ic_pp_SUITE_data/swallow_sc.idl b/lib/ic/test/ic_pp_SUITE_data/swallow_sc.idl deleted file mode 100644 index a42fcc6295..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/swallow_sc.idl +++ /dev/null @@ -1,38 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -/* comment \ - ends */ -// comment\ -ends -Line __LINE__ -#define SKIP_SPACES(p, limit) \ -{register char *lim = (limit); \ - while (p != lim) { \ - if (*p++ != ' ') { \ - p--; break; }}} - - -main() -{ - if (*p != 0) - SKIP_SPACES (ppp, lim); - else - a = 17; -} diff --git a/lib/ic/test/ic_pp_SUITE_data/unintended_grp.idl b/lib/ic/test/ic_pp_SUITE_data/unintended_grp.idl deleted file mode 100644 index ba744ac938..0000000000 --- a/lib/ic/test/ic_pp_SUITE_data/unintended_grp.idl +++ /dev/null @@ -1,30 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -#define ceil_div( xz, yz) (xz + yz - 1) / yz -#define ceil_div2(xz, yz) ((xz) + (yz) - 1) / (yz) - -#define b kurt - -main() -{ - ceil_div(b & c, sizeof(int)); - ceil_div2(b & c, sizeof(int)); - -} diff --git a/lib/ic/test/ic_pragma_SUITE.erl b/lib/ic/test/ic_pragma_SUITE.erl deleted file mode 100644 index bb95e59109..0000000000 --- a/lib/ic/test/ic_pragma_SUITE.erl +++ /dev/null @@ -1,301 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% -%%----------------------------------------------------------------- -%% File: ic_pragma_SUITE.erl -%% -%% Description: -%% Test suite for the IFR object registration when -%% pragmas are engaged -%% -%%----------------------------------------------------------------- --module(ic_pragma_SUITE). - --include_lib("common_test/include/ct.hrl"). --include_lib("orber/include/corba.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_suite/1, end_per_suite/1]). --export([ifr_pragma_reg/1, pragma_error/1, uggly_pragmas/1]). - - -%%----------------------------------------------------------------- -%% Macros -%%----------------------------------------------------------------- --define(REMAP_EXCEPT(F), case catch F of - {'EXCEPTION', E} -> exit(E); - R -> R - end). -%% 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)])). - - -%%----------------------------------------------------------------- -%% Func: all/1 -%% Args: -%% Returns: -%%----------------------------------------------------------------- -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - cases(). - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -cases() -> - [ifr_pragma_reg, pragma_error, uggly_pragmas]. - -%%----------------------------------------------------------------- -%% Init and cleanup functions. -%%----------------------------------------------------------------- -init_per_suite(Config) -> - io:format("Setting up.....~n"), - mnesia:stop(), - mnesia:delete_schema([node()]), - mnesia:create_schema([node()]), - mnesia:start(), - orber:install([node()]), - orber:start(), - if - is_list(Config) -> - Config; - true -> - exit("Config not a list") - end. - -end_per_suite(Config) -> - io:format("Setting down.....~n"), - orber:stop(), - orber:uninstall(), - mnesia:stop(), - mnesia:delete_schema([node()]), - Config. - - - - -%%----------------------------------------------------------------- -%% Test Case: IFR registration with pragmas -%%----------------------------------------------------------------- -%% Checks that IFR object is correctly registered under pragma engagement. -ifr_pragma_reg(Config) when is_list(Config) -> - ?REMAP_EXCEPT(ifr_pragma_reg_run(Config)). - -ifr_pragma_reg_run(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(ifr_pragma_reg), - File0 = filename:join(DataDir, reg_m0), - ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}]), - ok = compile(OutDir, ifr_pragma_files()), - code:add_pathz(OutDir), - - %% OE_register for all files - ok = 'oe_reg_m0':'oe_register'(), - - %% Pragma registration test - OE_IFR = orber_ifr:find_repository(), - io:format("~n##### Starting the test case #####~n"), - check_pragma_effect(OE_IFR,"IDL:M1/T1:1.0"), - check_pragma_effect(OE_IFR,"DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3"), - check_pragma_effect(OE_IFR,"IDL:P2/T3:1.0"), - check_pragma_effect(OE_IFR,"IDL:P1/M2/T4:2.4"), - - %% OE_unregister for all files - ok = 'oe_reg_m0':'oe_unregister'(), - code:del_path(OutDir), - ok. - - -ifr_pragma_files() -> ['oe_reg_m0']. - - -check_pragma_effect(OE_IFR,ID) -> - io:format("Checking for existance of : ~s~n",[ID]), - case orber_ifr:lookup_id(OE_IFR,ID) of - [] -> - test_server:fail(ID ++ " does not exist"), - false; - {Def,_} -> - io:format("Id refers to = {~p,#Bin}~n",[Def]), - true - end. - - - - -%%----------------------------------------------------------------- -%% Test Case: Syntactical / Semantical error pragma definitions -%%----------------------------------------------------------------- -%% Finds errornous pragma definitions under compilation. -pragma_error(Config) when is_list(Config) -> - ?REMAP_EXCEPT(pragma_error_run(Config)). - -pragma_error_run(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(pragma_error), - File1 = filename:join(DataDir, reg_m1), - File2 = filename:join(DataDir, reg_m2), - File3 = filename:join(DataDir, reg_m3), - File4 = filename:join(DataDir, reg_m4), - File5 = filename:join(DataDir, reg_m5), - File6 = filename:join(DataDir, reg_m6), - - error = ic:gen(File1, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - - error = ic:gen(File2, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - - error = ic:gen(File3, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - - ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - - error = ic:gen(File5, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - - error = ic:gen(File6, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - ok. - - - - -%%----------------------------------------------------------------- -%% Test Case: IFR registration with realy uggly placed pragmas -%%----------------------------------------------------------------- -%% Checks that IFR object is correctly registered under really uggly pragma engagement. -uggly_pragmas(Config) when is_list(Config) -> - ?REMAP_EXCEPT(uggly_pragmas_run(Config)). - -uggly_pragmas_run(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(ifr_pragma_reg), - File0 = filename:join(DataDir, uggly), - - ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}]), - - ok = compile(OutDir, uggly_pragma_files()), - code:add_pathz(OutDir), - - %% OE_register for all files - ok = 'oe_uggly':'oe_register'(), - - %% Pragma registration test - OE_IFR = orber_ifr:find_repository(), - io:format("~n##### Starting the test case #####~n"), - - check_pragma_effect(OE_IFR, "IDL:M:1.0"), - check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:10"), - check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:11"), - check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:17"), - check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:34"), - check_pragma_effect(OE_IFR, "IDL:Exc1:2.2"), - check_pragma_effect(OE_IFR, "IDL:Exc2:2.2"), - check_pragma_effect(OE_IFR, "IDL:S:1.0"), - check_pragma_effect(OE_IFR, "IDL:U:1.0"), - check_pragma_effect(OE_IFR, "LOCAL:SomeLocalId:23"), - - %% OE_unregister for all files - ok = 'oe_uggly':'oe_unregister'(), - - code:del_path(OutDir), - ok. - - -uggly_pragma_files() -> ['oe_uggly']. - - - - -%%---------------------------- - - -stdopts(OutDir) -> - [{outdir, OutDir}, {maxerrs, infinity}]. - - -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. - - -to_list(X) when is_atom(X) -> atom_to_list(X); -to_list(X) -> X. - - - diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m0.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m0.idl deleted file mode 100644 index a7a90edc92..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/reg_m0.idl +++ /dev/null @@ -1,78 +0,0 @@ - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% - -// Normal pragmas - -module M1 { - - typedef long T1; - - typedef long T2; - -#pragma ID T2 "DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3" - -}; - - -#pragma prefix "P1" - -module M2 { - - module M3 { - -#pragma prefix "P2" - - interface I1 { - void Op( in short b, - out short c); - }; - typedef long T3; - }; - - - typedef long T4; - -#pragma version T4 2.4 - -}; - - - -/* - - Specified types with the following scoped names - and RepositoryIds - - ::M1::T1 IDL:M1/T1:1.0 - - ::M1::T2 DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3 - - ::M2::M3::T3 IDL:P2/T3:1.0 - - ::M2::T4 IDL:P1/M2/T4:2.4 - -*/ - - - - - - - - diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m1.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m1.idl deleted file mode 100644 index e222dcddc7..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/reg_m1.idl +++ /dev/null @@ -1,76 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// Bad pragma IDs - -// Completelly bad id -module M1 { - - typedef long T1; - - typedef long T2; - -#pragma ID T2 "CompletelyBadId" - -}; - - -// Bad id, should start with DCE -module M2 { - - typedef long T1; - - typedef long T2; - -#pragma ID T2 "BAD:d62207a2-011e-11ce-88b4-0800090b5d3e:3" - -}; - - -// Bad version in ID : not a short number -module M3 { - - typedef long T1; - - typedef long T2; - -#pragma ID T2 "DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:ABCD" - -}; - - - - - - - - - - - - - - - - - - - - - diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m2.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m2.idl deleted file mode 100644 index 351e662ac7..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/reg_m2.idl +++ /dev/null @@ -1,41 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// Bad pragma versions - - -// Bad major version : not a short number -module M1 { - - typedef long T4; - -#pragma version T4 2000000000.4 - -}; - -// Bad minor version : not a short number -module M2 { - - typedef long T4; - -#pragma version T4 2.4000000000000 - -}; - - diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m3.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m3.idl deleted file mode 100644 index 4f876da8bc..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/reg_m3.idl +++ /dev/null @@ -1,39 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// Bad pragma prefixs - -module M2 { - - module M3 { - -#pragma prefix P2 // Should be "P2" - - interface I1 { - void foo( in short b, - out short c); - }; - typedef long T3; - }; - - - typedef long T4; -}; - - diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m4.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m4.idl deleted file mode 100644 index 9de19b645b..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/reg_m4.idl +++ /dev/null @@ -1,65 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// Unrecognmizable pragmas - -module M1 { - - typedef long T1; - - typedef long T2; - - - // Should be ID directive - -#pragma ShouldBeId T2 "DCE:d62207a2-011e-11ce-88b4-0800090b5d3e:3" - -}; - - // Should be prefix directive - -#pragma ShouldBePrefix "P1" - -module M2 { - - module M3 { - - // Should be prefix directive - -#pragma ShouldBePrefix "P2" - - interface I1 { - void foo( in short b, - out short c); - }; - typedef long T3; - }; - - - typedef long T4; - - - // Should be version - -#pragma ShouldBeVersion T4 2.4 - -}; - - - diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m5.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m5.idl deleted file mode 100644 index 85ff419689..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/reg_m5.idl +++ /dev/null @@ -1,29 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% - -// Version not in valid form : major.ninor - -module M1 { - - typedef long T4; - - #pragma version T4 2 - -}; diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m6.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m6.idl deleted file mode 100644 index 4f876da8bc..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/reg_m6.idl +++ /dev/null @@ -1,39 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// Bad pragma prefixs - -module M2 { - - module M3 { - -#pragma prefix P2 // Should be "P2" - - interface I1 { - void foo( in short b, - out short c); - }; - typedef long T3; - }; - - - typedef long T4; -}; - - diff --git a/lib/ic/test/ic_pragma_SUITE_data/reg_m7.idl b/lib/ic/test/ic_pragma_SUITE_data/reg_m7.idl deleted file mode 100644 index 038b670dd9..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/reg_m7.idl +++ /dev/null @@ -1,63 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% - -// Very uggly pragmas - - -#pragma prefix "P1" // Normal pragma - -module M4 { - - module M5 { - -#pragma prefix "P2" // Inside a parameter list - - interface I1 { - void Op( - #pragma prefix "P2" // Inside a parameter list - in short b, - #pragma prefix "P2" // Inside a parameter list - out short c - #pragma prefix "P2" // Inside a parameter list - ); - }; - typedef long T3; - }; - -}; - - - -/* - - Specified types with the following scoped names - and RepositoryIds - - ::M4::M5::T3 IDL:P2/T3:1.0 - -*/ - - - - - - - - diff --git a/lib/ic/test/ic_pragma_SUITE_data/uggly.idl b/lib/ic/test/ic_pragma_SUITE_data/uggly.idl deleted file mode 100644 index d12909c00e..0000000000 --- a/lib/ic/test/ic_pragma_SUITE_data/uggly.idl +++ /dev/null @@ -1,205 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// Really uggly pragmas - - -struct S { - -#pragma ID TDL1 "LOCAL:SomeLocalId:1" -#pragma ID TDL1 "LOCAL:SomeLocalId:2" - -long a - -#pragma ID TDL1 "LOCAL:SomeLocalId:3" -#pragma ID TDL1 "LOCAL:SomeLocalId:4" - -; - -#pragma ID TDL1 "LOCAL:SomeLocalId:5" -#pragma ID TDL1 "LOCAL:SomeLocalId:6" - -long b - -#pragma ID TDL1 "LOCAL:SomeLocalId:7" -#pragma ID TDL1 "LOCAL:SomeLocalId:8" - -; - - -#pragma ID TDL1 "LOCAL:SomeLocalId:9" -#pragma ID TDL1 "LOCAL:SomeLocalId:10" - -}; - - -typedef long TDL1; - - -exception Exc1{ - -#pragma version Exc1 2.2 -#pragma ID TDL2 "LOCAL:SomeLocalId:11" - -}; - - -typedef long TDL2; - - -exception Exc2 { - -#pragma version Exc2 2.2 -#pragma ID TDL3 "LOCAL:SomeLocalId:11" - - long a - -#pragma ID TDL3 "LOCAL:SomeLocalId:12" -#pragma ID TDL3 "LOCAL:SomeLocalId:13" - - ; - -#pragma ID TDL3 "LOCAL:SomeLocalId:14" -#pragma ID TDL3 "LOCAL:SomeLocalId:15" - - long b - -#pragma ID TDL3 "LOCAL:SomeLocalId:16" - - ; - -#pragma ID TDL3 "LOCAL:SomeLocalId:17" - - -}; - -typedef long TDL3; - -enum E { -#pragma ID E "LOCAL:SomeLocalId:18" - a -#pragma ID E "LOCAL:SomeLocalId:19" - , -#pragma ID E "LOCAL:SomeLocalId:20" - b -#pragma ID E "LOCAL:SomeLocalId:21" -, -#pragma ID E "LOCAL:SomeLocalId:22" - c -#pragma ID E "LOCAL:SomeLocalId:23" -}; - - - -union U switch (long) { - -#pragma ID TDL4 "LOCAL:SomeLocalId:24" - - case 1: - -#pragma ID TDL4 "LOCAL:SomeLocalId:25" - - long a - -#pragma ID TDL4 "LOCAL:SomeLocalId:26" - -; - -#pragma ID TDL4 "LOCAL:SomeLocalId:27" - - case 2: - -#pragma ID TDL4 "LOCAL:SomeLocalId:28" - - case 3: - -#pragma ID TDL4 "LOCAL:SomeLocalId:29" - -long b - -#pragma ID TDL4 "LOCAL:SomeLocalId:30" - -; - -#pragma ID TDL4 "LOCAL:SomeLocalId:31" - - default : - -#pragma ID TDL4 "LOCAL:SomeLocalId:32" - -long c - -#pragma ID TDL4 "LOCAL:SomeLocalId:33" - -; - -#pragma ID TDL4 "LOCAL:SomeLocalId:34" - -}; - - -typedef long TDL4; - - - -module M { - - interface I { - - void fun1( - -#pragma version fun1 3.0 -#pragma ID TDL5 "LOCAL:SomeLocalId:35" - - in short b - -#pragma ID TDL5 "LOCAL:SomeLocalId:36" -#pragma ID TDL5 "LOCAL:SomeLocalId:37" - - , - -#pragma ID TDL5 "LOCAL:SomeLocalId:38" -#pragma ID TDL5 "LOCAL:SomeLocalId:39" - - out short c - -#pragma ID TDL5 "LOCAL:SomeLocalId:40" -#pragma ID TDL5 "LOCAL:SomeLocalId:41" - - ); - - - typedef long TDL5; - - - void fun2( - -#pragma ID TDL6 "LOCAL:SomeLocalId:42" -#pragma ID TDL6 "LOCAL:SomeLocalId:43" - - ); - - typedef long TDL6; - - }; - - - -}; - diff --git a/lib/ic/test/ic_register_SUITE.erl b/lib/ic/test/ic_register_SUITE.erl deleted file mode 100644 index 69eb923f85..0000000000 --- a/lib/ic/test/ic_register_SUITE.erl +++ /dev/null @@ -1,422 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% -%% -%%----------------------------------------------------------------- -%% File: ic_register_SUITE.erl -%% -%% Description: -%% Test suite for the IFR object registration -%% -%%----------------------------------------------------------------- --module(ic_register_SUITE). - --include_lib("common_test/include/ct.hrl"). --include_lib("orber/include/corba.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_suite/1, end_per_suite/1, ifr_reg_unreg/1]). --export([ifr_inheritence_reg/1,ifr_reg_unreg_with_inheritence/1]). --export([ifr_reg_unreg_with_inheritence_bad_order/1]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% Macros -%%----------------------------------------------------------------- --define(REMAP_EXCEPT(F), case catch F of - {'EXCEPTION', E} -> exit(E); - R -> R - end). -%% 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)])). - - -%%----------------------------------------------------------------- -%% Func: all/1 -%% Args: -%% Returns: -%%----------------------------------------------------------------- -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - cases(). - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -cases() -> - [ifr_reg_unreg, ifr_reg_unreg_with_inheritence, - ifr_reg_unreg_with_inheritence_bad_order, - ifr_inheritence_reg]. - -%%----------------------------------------------------------------- -%% Init and cleanup functions. -%%----------------------------------------------------------------- - -init_per_suite(Config) -> - io:format("Setting up.....~n"), - mnesia:stop(), - mnesia:delete_schema([node()]), - mnesia:create_schema([node()]), - mnesia:start(), - orber:install([node()]), - orber:start(), - if - is_list(Config) -> - Config; - true -> - exit("Config not a list") - end. - -end_per_suite(Config) -> - io:format("Setting down.....~n"), - orber:stop(), - orber:uninstall(), - mnesia:stop(), - mnesia:delete_schema([node()]), - Config. - - - -%%----------------------------------------------------------------- -%% Test Case: IFR type registration -%%----------------------------------------------------------------- -%% Checks that the generated register/unregister -%% code for the IFR is correct. -ifr_reg_unreg(Config) when is_list(Config) -> - ?REMAP_EXCEPT(ifr_reg_unregt_run(Config)). - -ifr_reg_unregt_run(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(ifr_reg_unreg), - File0 = filename:join(DataDir, reg_m8), - File1 = filename:join(DataDir, reg_m9), - File2 = filename:join(DataDir, reg_m10), - ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File0, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File1, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File1, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File2, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File2, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = compile(OutDir, ifr_reg_unreg_files()), - code:add_pathz(OutDir), - ok = 'oe_reg_m8':'oe_register'(), - ok = 'oe_reg_m9':'oe_register'(), - ok = 'oe_reg_m10':'oe_register'(), - ok = 'oe_reg_m10':'oe_unregister'(), - ok = 'oe_reg_m9':'oe_unregister'(), - ok = 'oe_reg_m8':'oe_unregister'(), - code:del_path(OutDir), - ok. - -ifr_reg_unreg_files() -> ['oe_reg_m8', 'oe_reg_m9', 'oe_reg_m10']. - - - -%%----------------------------------------------------------------- -%% Test Case: IFR registration when object inheritence -%% is applied and registered. -%%----------------------------------------------------------------- -%% Checks that the generated register/unregister -%% code for the IFR is correct, and works even when -%% the object inheritence is registered. This fixes -%% two bugs in ifr that caused crash when trying to -%% use OE_register/OE_unregister in a sequence of -%% compiled files that contained interfaces who -%% inherited others in sequence. -ifr_reg_unreg_with_inheritence(Config) when is_list(Config) -> - ?REMAP_EXCEPT(ifr_reg_unreg_with_inheritence_run(Config)). - -ifr_reg_unreg_with_inheritence_run(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(ifr_reg_unreg), - File0 = filename:join(DataDir, reg_m8), - File1 = filename:join(DataDir, reg_m9), - File2 = filename:join(DataDir, reg_m10), - File3 = filename:join(DataDir, reg_m11), - File4 = filename:join(DataDir, reg_m12), - ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File0, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File1, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File1, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File2, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File2, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File3, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File3, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File4, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = compile(OutDir, ifr_reg_unreg_with_inheritence_files()), - code:add_pathz(OutDir), - ok = 'oe_reg_m8':'oe_register'(), - ok = 'oe_reg_m9':'oe_register'(), - ok = 'oe_reg_m10':'oe_register'(), - ok = 'oe_reg_m11':'oe_register'(), - ok = 'oe_reg_m12':'oe_register'(), - ok = 'oe_reg_m8':'oe_unregister'(), - ok = 'oe_reg_m9':'oe_unregister'(), - ok = 'oe_reg_m10':'oe_unregister'(), - ok = 'oe_reg_m11':'oe_unregister'(), - ok = 'oe_reg_m12':'oe_unregister'(), - code:del_path(OutDir), - ok. - -ifr_reg_unreg_with_inheritence_files() -> - ['oe_reg_m8', 'oe_reg_m9', 'oe_reg_m10', 'oe_reg_m11', 'oe_reg_m12']. - - - - - -%%----------------------------------------------------------------- -%% Test Case: IFR registration when object inheritence -%% is applied and registered in a bad order. -%% Modules included and used from an ifr object -%% are not allready registered when the current -%% object is getting registered. -%%----------------------------------------------------------------- -ifr_reg_unreg_with_inheritence_bad_order(Config) when is_list(Config) -> - ?REMAP_EXCEPT(ifr_reg_unreg_with_inheritence_bad_order_run(Config)). - -ifr_reg_unreg_with_inheritence_bad_order_run(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(ifr_reg_unreg), - File1 = filename:join(DataDir, reg_m9), - File2 = filename:join(DataDir, reg_m10), - File4 = filename:join(DataDir, reg_m12), - ok = ic:gen(File1, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File1, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File2, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File2, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File4, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = compile(OutDir, ifr_reg_unreg_with_inheritence_files()), - code:add_pathz(OutDir), - case catch 'oe_reg_m12':'oe_register'() of - {'EXIT',Reason1} -> - io:format("IFR object missing detected : ~p~n",[Reason1]), - true; - _ -> - test_server:fail("Failed to detect object missing : IDL:M1:1.0~n") - end, - ok = 'oe_reg_m9':'oe_register'(), - case catch 'oe_reg_m10':'oe_register'() of - {'EXIT',Reason2} -> - io:format("IFR object missing detected : ~p~n",[Reason2]), - true; - _ -> - test_server:fail("Failed to detect object missing : IDL:M0:1.0~n") - end, - ok = 'oe_reg_m9':'oe_unregister'(), - code:del_path(OutDir), - ok. - -%%----------------------------------------------------------------- -%% Test Case: IFR registration with inheritence is correctly registered -%%----------------------------------------------------------------- -ifr_inheritence_reg(Config) when is_list(Config) -> - ?REMAP_EXCEPT(ifr_inh_reg_run(Config)). - -ifr_inh_reg_run(Config) -> - DataDir = proplists:get_value(data_dir, Config), - OutDir = ?OUT(ifr_reg_unreg), - File0 = filename:join(DataDir, reg_m8), - File1 = filename:join(DataDir, reg_m9), - File2 = filename:join(DataDir, reg_m10), - File3 = filename:join(DataDir, reg_m11), - File4 = filename:join(DataDir, reg_m12), - ok = ic:gen(File0, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File0, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File1, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File1, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File2, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File2, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File3, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File3, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = ic:gen(File4, stdopts(OutDir)++[{preproc_flags, - "-I" ++ DataDir}] ), - {ok, []} = ic:gen(File4, stdopts(OutDir)++[silent2, {preproc_flags, - "-I" ++ DataDir}]), - ok = compile(OutDir, ifr_reg_unreg_with_inheritence_files()), - code:add_pathz(OutDir), - %% OE_register for all files - ok = 'oe_reg_m8':'oe_register'(), - ok = 'oe_reg_m9':'oe_register'(), - ok = 'oe_reg_m10':'oe_register'(), - ok = 'oe_reg_m11':'oe_register'(), - ok = 'oe_reg_m12':'oe_register'(), - - %% Inheritence registration test - OE_IFR = orber_ifr:find_repository(), - %% Interfaces that not inherit from other interfaces - [] = get_inh(OE_IFR, "IDL:m0/i0:1.0"), - [] = get_inh(OE_IFR, "IDL:m1/i1:1.0"), - [] = get_inh(OE_IFR, "IDL:m3/i3:1.0"), - %% Interfaces that inherit from other interfaces - ["IDL:m1/i1:1.0"] = get_inh(OE_IFR, "IDL:m2/i2:1.0"), - ["IDL:m1/i1:1.0","IDL:m2/i2:1.0"] = get_inh(OE_IFR, "IDL:m4/i4:1.0"), - ["IDL:m3/i3:1.0"] = get_inh(OE_IFR, "IDL:m4/i5:1.0"), - - %% OE_unregister for all files - ok = 'oe_reg_m8':'oe_unregister'(), - ok = 'oe_reg_m9':'oe_unregister'(), - ok = 'oe_reg_m10':'oe_unregister'(), - ok = 'oe_reg_m11':'oe_unregister'(), - ok = 'oe_reg_m12':'oe_unregister'(), - code:del_path(OutDir), - ok. - - -get_inh(OE_IFR,ID) -> - OE_CURRENT = orber_ifr:lookup_id(OE_IFR,ID), - INH_LIST = orber_ifr:get_base_interfaces(OE_CURRENT), - case INH_LIST of - [] -> - io:format("~nInterface ~p inherits from nobody.~n",[ID]), - []; - _ -> - print_inh_list_ids(ID, INH_LIST, []) - end. - -print_inh_list_ids(_ID, [], Acc) -> - lists:reverse(Acc); -print_inh_list_ids(ID, [H|T], Acc) -> - io:format("~n"), - Parent = orber_ifr:get_id(H), - io:format("Interface ~p inherits from ~p.~n", [ID, Parent]), - print_inh_list_ids(ID, T, [Parent|Acc]). - - - - -stdopts(OutDir) -> - [{outdir, OutDir}, {maxerrs, infinity}]. - - -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. - - -to_list(X) when is_atom(X) -> atom_to_list(X); -to_list(X) -> X. - - - - - - - - - - - - - - - - - - diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m10.idl b/lib/ic/test/ic_register_SUITE_data/reg_m10.idl deleted file mode 100644 index cc9156ae0c..0000000000 --- a/lib/ic/test/ic_register_SUITE_data/reg_m10.idl +++ /dev/null @@ -1,38 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// -// IDL for testing register/unregister in the IFR when using included specs -// -#include "reg_m9.idl" - -typedef sequence<long> Sequence1; - -#include "reg_m8.idl" - -module m2 { - - interface i2 : m1::i1 - { - short op3( in long a, inout char b, out long c ); - }; - - -}; - diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m11.idl b/lib/ic/test/ic_register_SUITE_data/reg_m11.idl deleted file mode 100644 index 6a6c49a48e..0000000000 --- a/lib/ic/test/ic_register_SUITE_data/reg_m11.idl +++ /dev/null @@ -1,33 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// -// IDL for testing register/unregister in the IFR when using included specs -// - -module m3 { - - interface i3 - { - short op4( in long a, inout char b, out long c ); - }; - - -}; - diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m12.idl b/lib/ic/test/ic_register_SUITE_data/reg_m12.idl deleted file mode 100644 index 0c5f8083b5..0000000000 --- a/lib/ic/test/ic_register_SUITE_data/reg_m12.idl +++ /dev/null @@ -1,41 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// -// IDL for testing register/unregister in the IFR when using included specs -// Special case with multiple inheritence. -// -#include "reg_m10.idl" -#include "reg_m11.idl" - -module m4 { - - interface i4 : m2::i2 - { - short op5( in long a, inout char b, out long c ); - }; - - interface i5 : m3::i3 - { - short op6( in long a, inout char b, out long c ); - }; - - -}; - diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m8.idl b/lib/ic/test/ic_register_SUITE_data/reg_m8.idl deleted file mode 100644 index 5129b6b636..0000000000 --- a/lib/ic/test/ic_register_SUITE_data/reg_m8.idl +++ /dev/null @@ -1,33 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// -// IDL for testing register/unregister in the IFR when using included specs -// -module m0 { - - interface i0 { - void op1( in short c ); - float op2( in char a); - - }; - - -}; - diff --git a/lib/ic/test/ic_register_SUITE_data/reg_m9.idl b/lib/ic/test/ic_register_SUITE_data/reg_m9.idl deleted file mode 100644 index c077d289b6..0000000000 --- a/lib/ic/test/ic_register_SUITE_data/reg_m9.idl +++ /dev/null @@ -1,33 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 1998-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% -// -// IDL for testing register/unregister in the IFR when using included specs -// -module m1 { - - interface i1 { - void op1( in short c ); - float op2( in char a); - - }; - - -}; - diff --git a/lib/ic/test/ic_smoke.spec b/lib/ic/test/ic_smoke.spec deleted file mode 100644 index ec3b5758b1..0000000000 --- a/lib/ic/test/ic_smoke.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../ic_test",[ic_SUITE]}. diff --git a/lib/ic/test/java_client_erl_server_SUITE.erl b/lib/ic/test/java_client_erl_server_SUITE.erl deleted file mode 100644 index 9fe52249ba..0000000000 --- a/lib/ic/test/java_client_erl_server_SUITE.erl +++ /dev/null @@ -1,319 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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 backends of the IDL compiler -%%%---------------------------------------------------------------------- - --module(java_client_erl_server_SUITE). --include_lib("common_test/include/ct.hrl"). - - --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_suite/1,end_per_suite/1, - init_per_testcase/2,end_per_testcase/2]). --export([marshal_ll/1,marshal_ull/1, - marshal_l/1,marshal_ul/1, - marshal_s/1,marshal_us/1, - marshal_c/1,marshal_wc/1, - marshal_str/1, - marshal_any_3/1,marshal_any_2/1]). - - -%% Top of cases - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - cases(). - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -cases() -> - [marshal_ll, marshal_ull, marshal_l, marshal_ul, - marshal_s, marshal_us, marshal_c, marshal_wc, - marshal_str, marshal_any_3, marshal_any_2]. - -init_per_suite(Config) when is_list(Config) -> - case case code:priv_dir(jinterface) of - {error,bad_name} -> - false; - P -> - case filelib:wildcard(filename:join(P, "*.jar")) of - [_|_] -> - true; - [] -> - false - end - end - of - true -> - case find_executable(["java"]) of - false -> - {skip,"Found no Java VM"}; - Path -> - [{java,Path}|Config] - end; - false -> - {skip,"No jinterface application"} - end. - - -find_executable([]) -> - false; -find_executable([E|T]) -> - case os:find_executable(E) of - false -> find_executable(T); - Path -> Path - end. - -end_per_suite(Config) -> Config. - - - -%% Add/remove code path and watchdog before/after each test case. -%% -init_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:add_patha(DataDir), - - %% Since other test suites use the module m_i et,al, we have - %% to make sure we are using the right modules. - code:purge(m_i), - code:purge(m_i_impl), - code:purge(oe_java_erl_test), - code:load_file(m_i), - code:load_file(m_i_impl), - code:load_file(oe_java_erl_test), - - WatchDog = test_server:timetrap(test_server:seconds(20)), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - DataDir = proplists:get_value(data_dir, Config), - code:del_path(DataDir), - WatchDog = proplists:get_value(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - - - -%%-------------------------------------------------------------------- -%% -%% Test cases - -%% Testing marshalling of IDL long long -marshal_ll(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_ll}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_ll]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL unsigned long long -marshal_ull(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_ull}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_ull]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL long -marshal_l(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_l}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_l]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL unsigned long -marshal_ul(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_ul}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_ul]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL short -marshal_s(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_s}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_s]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL unsigned short -marshal_us(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_us}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_us]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL char -marshal_c(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_c}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_c]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL char -marshal_wc(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_wc}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_wc]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL string -marshal_str(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_str}), - ok = java(proplists:get_value(java, Config), DataDir, -%%% "-DOtpConnection.trace=4 " - "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_str]), - ok = m_i:stop(Server), - ok. - -%% Testing marshalling of IDL any -marshal_any_3(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_any_3}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_any_3]), - ok = m_i:stop(Server), - ok. - -marshal_any_2(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - {ok,Server} = m_i:oe_create_link([], {local,marshal_any_2}), - ok = java(proplists:get_value(java, Config), DataDir, "JavaClient", - ["JavaClient",node(),erlang:get_cookie(),marshal_any_2]), - ok = m_i:stop(Server), - ok. - -%%-------------------------------------------------------------------- -%% -%% Utilities - - -java(Java, Dir, ClassAndArgs) -> - cmd(Java++" -classpath \""++classpath(Dir)++"\" "++ClassAndArgs). - -java(Java, Dir, Class, Args) -> - java(Java, Dir, Class++" "++to_string(Args)). - -to_string([H|T]) when is_integer(H) -> - integer_to_list(H)++" "++to_string(T); -to_string([H|T]) when is_atom(H) -> - atom_to_list(H)++" "++to_string(T); -to_string([H|T]) when is_list(H) -> - lists:flatten(H)++" "++to_string(T); -to_string([]) -> []. - -% javac(Dir, File) -> -% cmd("javac -d "++Dir++" -classpath "++classpath(Dir)++" "++ -% filename:join(Dir, File)). - -classpath(Dir) -> - PS = - case os:type() of - {win32, _} -> ";"; - _ -> ":" - end, - Dir++PS++ - filename:join([code:lib_dir(ic),"priv","ic.jar"])++PS++ - filename:join([code:lib_dir(jinterface),"priv","OtpErlang.jar"])++PS++ - os:getenv("CLASSPATH", ""). - -cmd(Cmd) -> - PortOpts = [{line,80},eof,exit_status,stderr_to_stdout], - io:format("<cmd> ~ts~n", [Cmd]), - case catch open_port({spawn,Cmd}, PortOpts) of - Port when is_port(Port) -> - Result = cmd_loop(Port, []), - io:format("<cmd=~w>~n", [Result]), - case Result of - 0 -> ok; - ExitCode when is_integer(ExitCode) -> {error,ExitCode}; - Error -> Error - end; - {'EXIT',Reason} -> - {error,Reason} - end. - -cmd_loop(Port, Line) -> - receive - {Port,eof} -> - receive - {Port,{exit_status,ExitStatus}} -> - ExitStatus - after 1 -> - undefined - end; - {Port,{exit_status,ExitStatus}} -> - receive - {Port,eof} -> - ok after 1 -> ok end, - ExitStatus; - {Port,{data,{Tag,Data}}} -> - case Tag of - eol -> - io:put_chars([Line|cr_to_nl(Data)]), - io:nl(), - cmd_loop(Port, []); - noeol -> - cmd_loop(Port, [Line|cr_to_nl(Data)]) - end; - {'EXIT',Port,Reason} -> - {error,Reason}; - Other -> - io:format("WARNING: Unexpected at ~s:~p: ~p~n", - [?MODULE_STRING,?LINE,Other]), - cmd_loop(Port, Line) - end. - -%% Convert lonely CR to NL, and CRLF to NL -%% -cr_to_nl([$\r,$\n|T]) -> - [$\n|cr_to_nl(T)]; -cr_to_nl([$\r|T]) -> - [$\n|cr_to_nl(T)]; -cr_to_nl([C|T]) -> - [C|cr_to_nl(T)]; -cr_to_nl([]) -> - []. diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/JavaClient.java b/lib/ic/test/java_client_erl_server_SUITE_data/JavaClient.java deleted file mode 100644 index 8092d7c627..0000000000 --- a/lib/ic/test/java_client_erl_server_SUITE_data/JavaClient.java +++ /dev/null @@ -1,760 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2003-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% - * - */ -public class JavaClient { - - public static void main(String[] argv) - { - System.out.println("Hello World!"); - if (argv.length < 4) { - System.out.println("Too few arguments!"); - System.exit(1); - } - // for (int j = 0; j < argv.length; j++) - // System.out.println(argv[j]); - try { - if (argv[3].equals("marshal_ll")) { - System.out.println("marshal_ll"); - marshal_ll(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_ull")) { - marshal_ull(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_l")) { - marshal_l(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_ul")) { - marshal_ul(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_s")) { - marshal_s(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_us")) { - marshal_us(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_c")) { - marshal_c(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_wc")) { - marshal_wc(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_str")) { - marshal_str(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_any_3")) { - marshal_any_3(argv[0], argv[1], argv[2], argv[3]); - } - else if (argv[3].equals("marshal_any_2")) { - marshal_any_2(argv[0], argv[1], argv[2], argv[3]); - } - else { - System.out.println("Unknown test: "+argv[3]); - System.exit(2); - } - } catch (java.lang.Exception e) { - System.out.println("Exception!: "+e); - System.exit(3); - } - System.exit(0); - } - - - - static void marshal_ll(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - System.out.println("Just warming up.."+i); - verify_ll(i, 3, 2, 1); - verify_ll(i, 5, 4, 3); - verify_ll(i, -128, 0, 1); - // The small integer border - verify_ll(i, 255, 0, 1); - verify_ll(i, 256, 0, 1); - // The integer border - verify_ll(i, (1L<<26)-1L, 0L, 1); - verify_ll(i, 1L<<26, 0L, 1); - verify_ll(i, -(1L<<26), 0L, 1); - verify_ll(i, (1L<<27)-1L, 0L, 1); - verify_ll(i, 1L<<27, 0L, 1); - verify_ll(i, -(1L<<27), 0L, 1); - // Bignum byte borders - verify_ll(i, (1L<<32)-1L, 0L, 1); - verify_ll(i, 1L<<32, 0L, 1); - verify_ll(i, -(1L<<32)+1L, 0L, 1); - verify_ll(i, -(1L<<32), 0L, 1); - verify_ll(i, (1L<<40)-1L, 0L, 1); - verify_ll(i, 1L<<40, 0L, 1); - verify_ll(i, -(1L<<40)+1L, 0L, 1); - verify_ll(i, -(1L<<40), 0L, 1); - verify_ll(i, (1L<<48)-1L, 0L, 1); - verify_ll(i, 1L<<48, 0L, 1); - verify_ll(i, -(1L<<48)+1L, 0L, 1); - verify_ll(i, -(1L<<48), 0L, 1); - // Java long border - verify_ll(i, java.lang.Long.MAX_VALUE, 0L, 1); - verify_ll(i, java.lang.Long.MIN_VALUE, 0L, 1); - verify_ll(i, -1L, 0L, 1); - // Impossible decodes - verify_ll_bad(i, java.lang.Long.MAX_VALUE, -1L, 1); - verify_ll_bad(i, java.lang.Long.MIN_VALUE, 1L, 1); - verify_ll_bad(i, java.lang.Long.MIN_VALUE, 0L, -1); - verify_ll_bad(i, java.lang.Long.MAX_VALUE, -1L, 2); - verify_ll_bad(i, java.lang.Long.MIN_VALUE, 0L, 2); - } - - static void marshal_ull(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - verify_ull(i, 3, 2, 1); - verify_ull(i, 5, 4, 3); - // The small integer border - verify_ull(i, 255, 0, 1); - verify_ull(i, 256, 0, 1); - // The integer border - verify_ull(i, (1L<<26)-1L, 0L, 1); - verify_ull(i, 1L<<26, 0L, 1); - verify_ull(i, (1L<<27)-1L, 0L, 1); - verify_ull(i, 1L<<27, 0L, 1); - // Bignum byte borders - verify_ull(i, (1L<<32)-1L, 0L, 1); - verify_ull(i, 1L<<32, 0L, 1); - verify_ull(i, (1L<<40)-1L, 0L, 1); - verify_ull(i, 1L<<40, 0L, 1); - verify_ull(i, (1L<<48)-1L, 0L, 1); - verify_ull(i, 1L<<48, 0L, 1); - // Java long border - verify_ull(i, java.lang.Long.MAX_VALUE, 0L, 1); - verify_ull(i, java.lang.Long.MIN_VALUE, 0L, 1); - verify_ull(i, -1L, 0L, 1); - verify_ull(i, java.lang.Long.MAX_VALUE, - java.lang.Long.MIN_VALUE, 1); - // Impossible decodes - verify_ull_bad(i, -1L, -1L, 1); - verify_ull_bad(i, java.lang.Long.MAX_VALUE, -1L, 2); - } - - static void marshal_l(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - verify_l(i, 3, 2, 1); - verify_l(i, 5, 4, 3); - verify_l(i, -128, 0, 1); - // The small integer border - verify_l(i, 255, 0, 1); - verify_l(i, 256, 0, 1); - // The integer border - verify_l(i, (1<<26)-1, 0, 1); - verify_l(i, 1<<26, 0, 1); - verify_l(i, -(1<<26), 0, 1); - verify_l(i, (1<<27)-1, 0, 1); - verify_l(i, 1<<27, 0, 1); - verify_l(i, -(1<<27), 0, 1); - // Java int border - verify_l(i, java.lang.Integer.MAX_VALUE, 0, 1); - verify_l(i, java.lang.Integer.MIN_VALUE, 0, 1); - // Impossible decodes - verify_l_bad(i, java.lang.Integer.MAX_VALUE, -1, 1); - verify_l_bad(i, java.lang.Integer.MIN_VALUE, 1, 1); - verify_l_bad(i, java.lang.Integer.MIN_VALUE, 0, -1); - } - - static void marshal_ul(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - verify_ul(i, 3, 2, 1); - verify_ul(i, 5, 4, 3); - // The small integer border - verify_ul(i, 255, 0, 1); - verify_ul(i, 256, 0, 1); - // The integer border - verify_ul(i, (1<<26)-1, 0, 1); - verify_ul(i, 1<<26, 0, 1); - verify_ul(i, (1<<27)-1, 0, 1); - verify_ul(i, 1<<27, 0, 1); - // Java int border - verify_ul(i, java.lang.Integer.MAX_VALUE, 0, 1); - verify_ul(i, java.lang.Integer.MIN_VALUE, 0, 1); - verify_ul(i, -1, 0, 1); - verify_ul(i, java.lang.Integer.MAX_VALUE, - java.lang.Integer.MIN_VALUE, 1); - // Impossible decodes - verify_ul_bad(i, -1, -1, 1); - } - - static void marshal_s(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - verify_s(i, 3, 2, 1); - verify_s(i, 5, 4, 3); - verify_s(i, -128, 0, 1); - // The small integer border - verify_s(i, 255, 0, 1); - verify_s(i, 256, 0, 1); - // Java short border - verify_s(i, java.lang.Short.MAX_VALUE, 0, 1); - verify_s(i, java.lang.Short.MIN_VALUE, 0, 1); - // Impossible decodes - verify_s_bad(i, java.lang.Short.MAX_VALUE, -1, 1); - verify_s_bad(i, java.lang.Short.MIN_VALUE, 1, 1); - verify_s_bad(i, java.lang.Short.MIN_VALUE, 0, -1); - } - - static void marshal_us(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - verify_us(i, 3, 2, 1); - verify_us(i, 5, 4, 3); - // The small integer border - verify_us(i, 255, 0, 1); - verify_us(i, 256, 0, 1); - // Java short border - verify_us(i, java.lang.Short.MAX_VALUE, 0, 1); - verify_us(i, java.lang.Short.MIN_VALUE, 0, 1); - verify_us(i, -1, 0, 1); - verify_us(i, java.lang.Short.MAX_VALUE, - java.lang.Short.MIN_VALUE, 1); - // Impossible decodes - verify_us_bad(i, -1, -1, 1); - } - - static void marshal_c(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - verify_c(i, '\3', '\2', 1); - verify_c(i, '\5', '\4', 3); - // The small integer border - verify_c(i, '\u00FF', '\0', 1); - verify_c(i, '\u0100', '\0', 1); - // Java char border - verify_c(i, java.lang.Character.MAX_VALUE, '\0', 1); - verify_c(i, java.lang.Character.MIN_VALUE, '\0', 1); - verify_c(i, java.lang.Character.MAX_VALUE, - java.lang.Character.MIN_VALUE, 1); - // Impossible decodes - verify_c_bad(i, '\u8000', '\0', 2); - } - - static void marshal_wc(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - verify_wc(i, '\3', '\2', 1); - verify_wc(i, '\5', '\4', 3); - // The small integer border - verify_wc(i, '\u00FF', '\0', 1); - verify_wc(i, '\u0100', '\0', 1); - // Java char border - verify_wc(i, java.lang.Character.MAX_VALUE, '\0', 1); - verify_wc(i, java.lang.Character.MIN_VALUE, '\0', 1); - verify_wc(i, java.lang.Character.MAX_VALUE, - java.lang.Character.MIN_VALUE, 1); - // Impossible decodes - verify_c_bad(i, '\u8000', '\0', 2); - } - - static void marshal_str(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - // Just warming up.. - verify_str(i, 100, 100); - verify_str(i, 100, 1); - // Erlang string border - verify_str(i, 65535, 1); - verify_str(i, 2, 65535); - // Erlang string border out - verify_str(i, 65536, 1); - verify_str(i, 65536, 65536); - } - - static void marshal_any_3(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - com.ericsson.otp.ic.Any x = new com.ericsson.otp.ic.Any(); - com.ericsson.otp.ic.Any y = new com.ericsson.otp.ic.Any(); - com.ericsson.otp.ic.Any z = new com.ericsson.otp.ic.Any(); - - x.insert_longlong(java.lang.Long.MAX_VALUE); - y.insert_longlong(1L); - z.insert_longlong(java.lang.Long.MAX_VALUE-1L); - System.out.println("verify_any_3 longlong max"); - verify_any_3(i, x, y, 1, z); - - x.insert_longlong(java.lang.Long.MIN_VALUE); - y.insert_longlong(-1L); - z.insert_longlong(java.lang.Long.MIN_VALUE+1L); - System.out.println("verify_any_3 longlong min"); - verify_any_3(i, x, y, 1, z); - - x.insert_ulonglong(-1L); - y.insert_longlong(1L); - z.insert_ulonglong(-2L); - System.out.println("verify_any_3 ulonglong max"); - verify_any_3(i, x, y, 1, z); - - x.insert_ulonglong(0L); - y.insert_longlong(-1L); - z.insert_ulonglong(1L); - System.out.println("verify_any_3 ulonglong min"); - verify_any_3(i, x, y, 1, z); - - x.insert_long(java.lang.Integer.MAX_VALUE); - y.insert_long(1); - z.insert_long(java.lang.Integer.MAX_VALUE-1); - System.out.println("verify_any_3 long max"); - verify_any_3(i, x, y, 1, z); - - x.insert_long(java.lang.Integer.MIN_VALUE); - y.insert_long(-1); - z.insert_long(java.lang.Integer.MIN_VALUE+1); - System.out.println("verify_any_3 long min"); - verify_any_3(i, x, y, 1, z); - - x.insert_ulong(-1); - y.insert_long(1); - z.insert_ulong(-2); - System.out.println("verify_any_3 ulong max"); - verify_any_3(i, x, y, 1, z); - - x.insert_ulong(0); - y.insert_long(-1); - z.insert_ulong(1); - System.out.println("verify_any_3 ulong min"); - verify_any_3(i, x, y, 1, z); - - x.insert_short(java.lang.Short.MAX_VALUE); - y.insert_short((short)1); - z.insert_short((short)(java.lang.Short.MAX_VALUE-1)); - System.out.println("verify_any_3 short max"); - verify_any_3(i, x, y, 1, z); - - x.insert_short(java.lang.Short.MIN_VALUE); - y.insert_short((short)-1); - z.insert_short((short)(java.lang.Short.MIN_VALUE+1)); - System.out.println("verify_any_3 short min"); - verify_any_3(i, x, y, 1, z); - - x.insert_ushort((short)-1); - y.insert_short((short)1); - z.insert_ushort((short)-2); - System.out.println("verify_any_3 ushort max"); - verify_any_3(i, x, y, 1, z); - - x.insert_ushort((short)0); - y.insert_short((short)-1); - z.insert_ushort((short)1); - System.out.println("verify_any_3 ushort min"); - verify_any_3(i, x, y, 1, z); - - x.insert_char('\377'); - y.insert_char('\1'); - z.insert_char('\376'); - System.out.println("verify_any_3 char max"); - verify_any_3(i, x, y, 1, z); - - x.insert_wchar('\uFFFF'); - y.insert_wchar('\u0001'); - z.insert_wchar('\uFFFE'); - System.out.println("verify_any_3 char max"); - verify_any_3(i, x, y, 1, z); - } - - static void marshal_any_2(String selfNode, String peerNode, - String cookie, String serverName) - throws java.lang.Exception - { - m._iStub i = new m._iStub(selfNode, peerNode, cookie, serverName); - m.s s = new m.s(); - com.ericsson.otp.ic.Any a = new com.ericsson.otp.ic.Any(); - // - s.ull_x = -1L; - s.ll_x = java.lang.Long.MAX_VALUE; - s.ll_y = 1L; - s.ull_z = -2L; - s.ll_z = java.lang.Long.MAX_VALUE-1L; - // - s.ul_x = -1; - s.l_x = java.lang.Integer.MAX_VALUE; - s.l_y = 1; - s.ul_z = -2; - s.l_z = java.lang.Integer.MAX_VALUE-1; - // - s.us_x = (short)-1; - s.s_x = java.lang.Short.MAX_VALUE; - s.s_y = (short)1; - s.us_z = (short)-2; - s.s_z = (short)(java.lang.Short.MAX_VALUE-1); - // - s.c_x = '\377'; - s.c_y = '\1'; - s.c_z = '\376'; - s.wc_x = '\uFFFF'; - s.wc_y = '\u0001'; - s.wc_z = '\uFFFE'; - m.sHelper.insert(a, s); - verify_any_2(i, a, 1); - - s.ull_x = 0L; - s.ll_x = java.lang.Long.MIN_VALUE; - s.ll_y = -1L; - s.ull_z = 1L; - s.ll_z = java.lang.Long.MIN_VALUE+1L; - // - s.ul_x = 0; - s.l_x = java.lang.Integer.MIN_VALUE; - s.l_y = -1; - s.ul_z = 1; - s.l_z = java.lang.Integer.MIN_VALUE+1; - // - s.us_x = (short)0; - s.s_x = java.lang.Short.MIN_VALUE; - s.s_y = (short)-1; - s.us_z = (short)1; - s.s_z = (short)(java.lang.Short.MIN_VALUE+1); - // - s.c_x = '\0'; - s.c_y = '\0'; - s.c_z = '\0'; - s.wc_x = '\u0000'; - s.wc_y = '\u0000'; - s.wc_z = '\u0000'; - m.sHelper.insert(a, s); - verify_any_2(i, a, 1); - } - - - static void verify_ll(m._iStub i, long x, long y, int b) - throws java.lang.Exception - { - m.s a = new m.s(); - System.out.println("verify_ll "+a); - a.ll_x = x; - a.ll_y = y; - long expected = (x - y)*(short)b; - long result = i.marshal_ll(a, (short)b); - if (result == expected) { - System.out.println("verify_ll("+x+", "+y+", "+b+") => " - +result); - } else { - System.out.println("verify_ll("+x+", "+y+", "+b+") => " - +result+" != "+expected); - System.exit(4); - } - } - - static void verify_ull(m._iStub i, long x, long y, int b) - throws java.lang.Exception - { - m.s a = new m.s(); - a.ull_x = x; - a.ll_y = y; - long expected = (x - y)*(short)b; - long result = i.marshal_ull(a, (short)b); - if (result == expected) { - System.out.println("verify_ull("+x+", "+y+", "+b+") => " - +result); - } else { - System.out.println("verify_ull("+x+", "+y+", "+b+") => " - +result+" != "+expected); - System.exit(4); - } - } - - static void verify_l(m._iStub i, int x, int y, int b) - throws java.lang.Exception - { - m.s a = new m.s(); - a.l_x = x; - a.l_y = y; - int expected = (x - y)*(short)b; - int result = i.marshal_l(a, (short)b); - if (result == expected) { - System.out.println("verify_l("+x+", "+y+", "+b+") => " - +result); - } else { - System.out.println("verify_l("+x+", "+y+", "+b+") => " - +result+" != "+expected); - System.exit(4); - } - } - - static void verify_ul(m._iStub i, int x, int y, int b) - throws java.lang.Exception - { - m.s a = new m.s(); - a.ul_x = x; - a.l_y = y; - int expected = (x - y)*(short)b; - int result = i.marshal_ul(a, (short)b); - if (result == expected) { - System.out.println("verify_ul("+x+", "+y+", "+b+") => " - +result); - } else { - System.out.println("verify_ul("+x+", "+y+", "+b+") => " - +result+" != "+expected); - System.exit(4); - } - } - - static void verify_s(m._iStub i, int x, int y, int b) - throws java.lang.Exception - { - m.s a = new m.s(); - a.s_x = (short)x; - a.s_y = (short)y; - short expected = (short)((x - y)*(short)b); - short result = i.marshal_s(a, (short)b); - if (result == expected) { - System.out.println("verify_s("+x+", "+y+", "+b+") => " - +result); - } else { - System.out.println("verify_s("+x+", "+y+", "+b+") => " - +result+" != "+expected); - System.exit(4); - } - } - - static void verify_us(m._iStub i, int x, int y, int b) - throws java.lang.Exception - { - m.s a = new m.s(); - a.us_x = (short)x; - a.s_y = (short)y; - short expected = (short)((x - y)*(short)b); - short result = i.marshal_us(a, (short)b); - if (result == expected) { - System.out.println("verify_us("+x+", "+y+", "+b+") => " - +result); - } else { - System.out.println("verify_us("+x+", "+y+", "+b+") => " - +result+" != "+expected); - System.exit(4); - } - } - - static void verify_c(m._iStub i, char x, char y, int b) - throws java.lang.Exception - { - m.s a = new m.s(); - a.c_x = x; - a.c_y = y; - char expected = (char)(((int)x - (int)y)*(short)b); - char result = i.marshal_c(a, (short)b); - if (result == expected) { - System.out.println("verify_c("+x+", "+y+", "+b+") => " - +result); - } else { - System.out.println("verify_c("+x+", "+y+", "+b+") => " - +result+" != "+expected); - System.exit(4); - } - } - - static void verify_wc(m._iStub i, char x, char y, int b) - throws java.lang.Exception - { - m.s a = new m.s(); - a.wc_x = x; - a.wc_y = y; - char expected = (char)(((int)x - (int)y)*(short)b); - char result = i.marshal_wc(a, (short)b); - if (result == expected) { - System.out.println("verify_wc("+x+", "+y+", "+b+") => " - +result); - } else { - System.out.println("verify_wc("+x+", "+y+", "+b+") => " - +result+" != "+expected); - System.exit(4); - } - } - - static void verify_str(m._iStub i, int a_len, int b_len) - throws java.lang.Exception - { - String a = mk_str(a_len); - String b = mk_str(b_len); - String expected = a + b; - String result = i.strcat(a, b); - if (result.equals(expected)) { - System.out.println("verify_str(\""+a+"\", \""+b+"\") => \"" - +result+"\""); - } else { - System.out.println("verify_str(\""+a+"\", \""+b+"\") => \"" - +result+"\" != \""+expected.length()+"\""); - System.exit(4); - } - } - - static String mk_str(int len) - throws StringIndexOutOfBoundsException - { - StringBuffer s = new StringBuffer(); - // 17 characters is prime relative all bases of two - on purpose - do s.append("qwertyuiopasdfghj"); while (s.length() < len); - return s.substring(0, len); - } - - static void verify_any_3(m._iStub i, - com.ericsson.otp.ic.Any x, - com.ericsson.otp.ic.Any y, - int b, - com.ericsson.otp.ic.Any expected) - throws java.lang.Exception - { - com.ericsson.otp.ic.Any result = i.marshal_any_3(x, y, (short)b); - if (! expected.equal(result)) { - System.exit(4); - } - } - - static void verify_any_2(m._iStub i, com.ericsson.otp.ic.Any a, int b) - throws java.lang.Exception - { - com.ericsson.otp.ic.Any result = i.marshal_any_2(a, (short)b); - if (! a.equal(result)) { - System.exit(4); - } - } - - - - static void verify_ll_bad(m._iStub i, long x, long y, int b) - throws java.lang.Exception - { - try { - verify_ll(i, x, y, b); - System.out.println("Expected exception missing!"); - System.exit(5); - } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) { - System.out.println("Expected exception: "+e); - } - } - - static void verify_ull_bad(m._iStub i, long x, long y, int b) - throws java.lang.Exception - { - try { - verify_ull(i, x, y, b); - System.out.println("Expected exception missing!"); - System.exit(5); - } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) { - System.out.println("Expected exception: "+e); - } - } - - static void verify_l_bad(m._iStub i, int x, int y, int b) - throws java.lang.Exception - { - try { - verify_l(i, x, y, b); - System.out.println("Expected exception missing!"); - System.exit(5); - } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) { - System.out.println("Expected exception: "+e); - } - } - - static void verify_ul_bad(m._iStub i, int x, int y, int b) - throws java.lang.Exception - { - try { - verify_ul(i, x, y, b); - System.out.println("Expected exception missing!"); - System.exit(5); - } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) { - System.out.println("Expected exception: "+e); - } - } - - static void verify_s_bad(m._iStub i, int x, int y, int b) - throws java.lang.Exception - { - try { - verify_s(i, x, y, b); - System.out.println("Expected exception missing!"); - System.exit(5); - } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) { - System.out.println("Expected exception: "+e); - } - } - - static void verify_us_bad(m._iStub i, int x, int y, int b) - throws java.lang.Exception - { - try { - verify_us(i, x, y, b); - System.out.println("Expected exception missing!"); - System.exit(5); - } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) { - System.out.println("Expected exception: "+e); - } - } - - static void verify_c_bad(m._iStub i, char x, char y, int b) - throws java.lang.Exception - { - try { - verify_c(i, x, y, b); - System.out.println("Expected exception missing!"); - System.exit(5); - } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) { - System.out.println("Expected exception: "+e); - } - } - - static void verify_wc_bad(m._iStub i, char x, char y, int b) - throws java.lang.Exception - { - try { - verify_wc(i, x, y, b); - System.out.println("Expected exception missing!"); - System.exit(5); - } catch (com.ericsson.otp.erlang.OtpErlangDecodeException e) { - System.out.println("Expected exception: "+e); - } - } - -} diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src b/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src deleted file mode 100644 index bcc59e87db..0000000000 --- a/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src +++ /dev/null @@ -1,101 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2003-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% -# -# -# Makefile.src for java_client_erl_server test -# Note: This file *must* work for both Unix and Windows -# -# We use both `rm' (Unix) and `del' (Windows) for removing files, but -# with a `-' in front so that the error in not finding `rm' (`del') on -# Windows (Unix) is ignored. -# -# VxWorks? XXX -# - -.SUFFIXES: -.SUFFIXES: .erl .idl .@EMULATOR@ .java - - -JAVAC = @JAVAC@ -ERLC = erlc - -# ic variables available from ts: -# -# ic_libpath: @ic_libpath@ -# ic_include_path: @ic_include_path@ - -IC_INCLUDE_PATH = @ic_include_path@ -IC_CLASSPATH = @ic_classpath@ - -JINTERFACE_CLASSPATH = @jinterface_classpath@ - -CLASSPATH = .@PS@$(IC_CLASSPATH)@PS@$(JINTERFACE_CLASSPATH)@PS@ - -GEN_JAVA_FILES = \ - m@DS@_iImplBase.java \ - m@DS@_iStub.java \ - -GEN_HRL_FILES = \ - m.hrl \ - m_i.hrl \ - oe_java_erl_test.hrl - -GEN_ERL_FILES = \ - m_i.erl \ - oe_java_erl_test.erl - -JAVA_FILES = $(GEN_JAVA_FILES) JavaClient.java -CLASS_FILES = $(JAVA_FILES:.java=.class) -ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl -EBINS = $(ERL_FILES:.erl=.@EMULATOR@) - -@IFEQ@ (@jinterface@,not_found) -all: -@ELSE@ -all: $(CLASS_FILES) $(EBINS) -@ENDIF@ - -$(GEN_ERL_FILES) $(GEN_HRL_FILES): java_erl_test.built_erl -$(GEN_JAVA_FILES): java_erl_test.built_java -$(CLASS_FILES): $(GEN_JAVA_FILES) -$(EBINS): $(GEN_ERL_FILES) $(GEN_HRL_FILES) - -clean: - -rm -f $(GEN_JAVA_FILES) $(CLASS_FILES) \ - $(GEN_ERL_FILES) $(GEN_HRL_FILES) $(EBINS) \ - java_erl_test.built_erl java_erl_test.built_java - -del /F /Q $(GEN_JAVA_FILES) $(CLASS_FILES) \ - $(GEN_ERL_FILES) $(GEN_HRL_FILES) $(EBINS) \ - java_erl_test.built_erl java_erl_test.built_java - -java_erl_test.built_java: java_erl_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,java}" java_erl_test.idl - echo done > java_erl_test.built_java - -$(CLASS_FILES) : $(JAVA_FILES) - $(JAVAC) -classpath $(CLASSPATH) $(JAVA_FILES) - -java_erl_test.built_erl: java_erl_test.idl - $(ERLC) -I $(IC_INCLUDE_PATH) "+{be,erl_genserv}" java_erl_test.idl - echo done > java_erl_test.built_erl - -.erl.@EMULATOR@: - $(ERLC) -I $(IC_INCLUDE_PATH) $< diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/java_erl_test.idl b/lib/ic/test/java_client_erl_server_SUITE_data/java_erl_test.idl deleted file mode 100644 index 55194cf911..0000000000 --- a/lib/ic/test/java_client_erl_server_SUITE_data/java_erl_test.idl +++ /dev/null @@ -1,69 +0,0 @@ - - -// %CopyrightBegin% -// -// Copyright Ericsson AB 2003-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% -module m { - - struct s { - long long ll_x; - unsigned long long ull_x; - long long ll_y; - long long ll_z; - unsigned long long ull_z; - - long l_x; - unsigned long ul_x; - long l_y; - long l_z; - unsigned long ul_z; - - short s_x; - unsigned short us_x; - short s_y; - short s_z; - unsigned short us_z; - - char c_x; - char c_y; - char c_z; - - wchar wc_x; - wchar wc_y; - wchar wc_z; - }; - - interface i { - long long marshal_ll( in s a, in short b ); - unsigned long long marshal_ull( in s a, in short b ); - - long marshal_l( in s a, in short b ); - unsigned long marshal_ul( in s a, in short b ); - - short marshal_s( in s a, in short b ); - unsigned short marshal_us( in s a, in short b ); - - char marshal_c( in s a, in short b ); - wchar marshal_wc( in s a, in short b ); - - string strcat( in string a, in string b ); - - any marshal_any_3( in any x, in any y, in short b ); - any marshal_any_2( in any a, in short b ); - }; - -}; diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/m_i_impl.erl b/lib/ic/test/java_client_erl_server_SUITE_data/m_i_impl.erl deleted file mode 100644 index 31b4c1dd7a..0000000000 --- a/lib/ic/test/java_client_erl_server_SUITE_data/m_i_impl.erl +++ /dev/null @@ -1,170 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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% -%% -%%-------------------------------------------------------------------- --module(m_i_impl). - --export([marshal_ll/3,marshal_ull/3, - marshal_l/3,marshal_ul/3, - marshal_s/3,marshal_us/3, - marshal_c/3,marshal_wc/3, - strcat/3, - marshal_any_3/4,marshal_any_2/3]). --export([init/1,terminate/2,code_change/3]). - --include("m.hrl"). - --define(TK_M_S, {tk_struct, - "IDL:m/s:1.0", - "s", - [{"ll_x",tk_longlong}, - {"ull_x",tk_ulonglong}, - {"ll_y",tk_longlong}, - {"ll_z",tk_longlong}, - {"ull_z",tk_ulonglong}, - {"l_x",tk_long}, - {"ul_x",tk_ulong}, - {"l_y",tk_long}, - {"l_z",tk_long}, - {"ul_z",tk_ulong}, - {"s_x",tk_short}, - {"us_x",tk_ushort}, - {"s_y",tk_short}, - {"s_z",tk_short}, - {"us_z",tk_ushort}, - {"c_x",tk_char}, - {"c_y",tk_char}, - {"c_z",tk_char}, - {"wc_x",tk_wchar}, - {"wc_y",tk_wchar}, - {"wc_z",tk_wchar}|_]}). - - - -marshal_ll(State, #m_s{ll_x = X, ll_y = Y}=_A, B) when integer(B) -> - R = (X - Y)*B, - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - -marshal_ull(State, #m_s{ull_x = X, ll_y = Y}=_A, B) when integer(B) -> - R = (X - Y)*B, - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - - -marshal_l(State, #m_s{l_x = X, l_y = Y}=_A, B) when integer(B) -> - R = (X - Y)*B, - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - -marshal_ul(State, #m_s{ul_x = X, l_y = Y}=_A, B) when integer(B) -> - R = (X - Y)*B, - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - - -marshal_s(State, #m_s{s_x = X, s_y = Y}=_A, B) when integer(B) -> - R = (X - Y)*B, - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - -marshal_us(State, #m_s{us_x = X, s_y = Y}=_A, B) when integer(B) -> - R = (X - Y)*B, - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - - -marshal_c(State, #m_s{c_x = X, c_y = Y}=_A, B) when integer(B) -> - R = (X - Y)*B, - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - -marshal_wc(State, #m_s{wc_x = X, wc_y = Y}=_A, B) when integer(B) -> - R = (X - Y)*B, - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - -strcat(State, A, B) when list(A), list(B) -> - R = A++B, - io:format("~p", [{?MODULE,?LINE,[length(A),length(B),A,B,R]}]), - {reply, R, State}; -strcat(State, A, B) -> - io:format("~p", [{?MODULE,?LINE,[A,B]}]), - {reply, [], State}. - -marshal_any_3(State, {any,TkX,_}=X, {any,_,_}=Y, B) when integer(B) -> - R = any(mul(sub(any(X), any(Y)), B), TkX), - io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]), - {reply, R, State}. - -marshal_any_2(State, - {any,TkA,#m_s{ll_x=LL_X, ull_x=ULL_X, ll_y=LL_Y, - l_x=L_X, ul_x=UL_X, l_y=L_Y, - s_x=S_X, us_x=US_X, s_y=S_Y, - c_x=C_X, c_y=C_Y, - wc_x=WC_X, wc_y=WC_Y} = A}, - B) when integer(B) -> - {check_type_code,?TK_M_S} = {check_type_code,TkA}, - ULL_Z = (ULL_X - LL_Y) * B, - LL_Z = (LL_X - LL_Y) * B, - UL_Z = (UL_X - L_Y) * B, - L_Z = (L_X - L_Y) * B, - US_Z = (US_X - S_Y) * B, - S_Z = (S_X - S_Y) * B, - C_Z = (C_X - C_Y) * B, - WC_Z = (WC_X - WC_Y) * B, - R = A#m_s{ll_z=LL_Z, ull_z=ULL_Z, - l_z=L_Z, ul_z=UL_Z, - s_z=S_Z, us_z=US_Z, - c_z=C_Z, wc_z=WC_Z}, - io:format("~p", [{?MODULE,?LINE,[A,B,R]}]), - {reply, {any,TkA,R}, State}. - - - -init(_Env) -> - {ok, []}. - -terminate(_Reason, _State) -> - ok. - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - - -any({any,tk_longlong,X}) -> X; -any({any,tk_long,X}) -> X; -any({any,tk_short,X}) -> X; -any({any,tk_ulonglong,X}) -> X; -any({any,tk_ulong,X}) -> X; -any({any,tk_ushort,X}) -> X; -any({any,tk_char,X}) -> X; -any({any,tk_wchar,X}) -> X. - -any(X, Tk) when integer(X) -> {any,Tk,X}. - -sub(X, Y) when integer(X), integer(Y) -> - X - Y. - -mul(X, Y) when integer(X), integer(Y) -> - X * Y. - -napp(0, L) -> L; -napp(N, L) when integer(N), N >= 1 -> napp(N-1, L)++L. diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk deleted file mode 100644 index d35d1dce1e..0000000000 --- a/lib/ic/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -IC_VSN = 4.4.4 |